#!/usr/bin/perl -w
# Basic tests of the Image::Delivery classes
# To help separate test data from config data, all pre-built data used to run
# the tests will be lowercase, and all object created during the tests
# will Be This Case
use strict;
use lib ();
use UNIVERSAL 'isa';
BEGIN {
$| = 1;
$^W = 1;
}
use Test::More 'tests' => 49;
#####################################################################
# Preparation
# The test path to use
my $good_dir = catdir( 't', 'data', '04_good' );
ok( -d $good_dir, 'Good test directory exists' );
ok( -w $good_dir, 'Good test directory is writable' );
# ... and one not to.
my $bad_dir = catdir( 't', 'data', '04_bad' );
ok( ! -d $bad_dir, 'Bad test directory is not writable' );
# The derived location for the above
my $good_location = HTML::Location->new( $good_dir, 'http://good.site/path' );
isa_ok( $good_location, 'HTML::Location' );
my $bad_location = HTML::Location->new( $bad_dir, 'http://bad.site/path' );
isa_ok( $bad_location, 'HTML::Location' );
# Test images to use
my $image1 = catfile( 't', 'data', '03_image.gif' );
my $image2 = catfile( 't', 'data', '04_help.gif' );
ok( (-f $image1 and -r $image1), 'Found usable test image 1' );
ok( (-f $image2 and -r $image2), 'Found usable test image 2' );
# Create a provider that is in the cache
my $good_provider = Image::Delivery::Provider::File->new( $image1 );
isa_ok( $good_provider, 'Image::Delivery::Provider' );
# Create a provider not in the cache
my $new_provider = Image::Delivery::Provider::File->new( $image2 );
isa_ok( $new_provider, 'Image::Delivery::Provider' );
# Standalone Transform Path (in the cache)
my $good_path = $good_provider->TransformPath;
isa_ok( $good_path, 'Digest::TransformPath' );
# Standaline Transform Path (not in the cache)
my $new_path = $new_provider->TransformPath;
isa_ok( $new_path, 'Digest::TransformPath' );
#####################################################################
# Test the Constructor
# No params or stupid params
is( Image::Delivery->new(), undef, '->new with no params returns undef' );
is( Image::Delivery->new( Location => undef ), undef, '->new with bad params returns undef' );
is( Image::Delivery->new( Location => 'foo' ), undef, '->new with bad params returns undef' );
is( Image::Delivery->new( Location => 'HTML::Location' ), undef, '->new with bad params returns undef' );
# Bad directory
is( Image::Delivery->new( Location => $bad_location ), undef, '->new with bad location returns undef' );
# Good directory
my $Delivery = Image::Delivery->new( Location => $good_location );
isa_ok( $Delivery, 'Image::Delivery' );
# Test the basic Accessors
isa_ok( $Delivery->Location, 'HTML::Location' );
is( $Delivery->Location->path, $good_dir, '->Location returns original location' );
#####################################################################
# Testing the main methods
# ->filename needs only a TransformPath
is( $Delivery->filename( $good_path ), '3/377f84afe0', '->filename(TransformPath) returns correct filename' );
is( $Delivery->filename( $good_provider ), '3/377f84afe0', '->filename(Provider) returns correct filename' );
is( $Delivery->filename( $new_path ), 'e/ee2067f1d7', '->filename(TransformPath) returns correct filename' );
is( $Delivery->filename( $new_provider ), 'e/ee2067f1d7', '->filename(Provider) returns correct filename' );
{ # ->exists will check for all of the extensions
my $Location = $Delivery->exists( $good_path );
isa_ok( $Location, 'HTML::Location' );
is( $Location->uri, 'http://good.site/path/3/377f84afe0.gif', '->exists(TransformPath) finds the correct existing file' );
is( $Location->path, 't/data/04_good/3/377f84afe0.gif', '->exists(TransformPath) finds the correct existing file' );
$Location = $Delivery->exists( $good_provider );
isa_ok( $Location, 'HTML::Location' );
is( $Location->uri, 'http://good.site/path/3/377f84afe0.gif', '->exists(TransformPath) finds the correct existing file' );
is( $Location->path, 't/data/04_good/3/377f84afe0.gif', '->exists(TransformPath) finds the correct existing file' );
}
{ # ->exists returns false ('') when it can't find the existing file
my $Location = $Delivery->exists( $new_path );
ok( (defined $Location and ! ref $Location), '->exists(TransformPath) returns defined and non-reference' );
is( $Location, '', '->exists(TransformPath) correctly finds no file' );
$Location = $Delivery->exists( $new_provider );
ok( (defined $Location and ! ref $Location), '->exists(TransformPath) returns defined and non-reference' );
is( $Location, '', '->exists(TransformPath) correctly finds no file' );
}
{ # ->get returns the existing data
my $data1 = $Delivery->get( $good_path );
my $data2 = $Delivery->get( $good_provider );
ok( $data1, '->get(TransformPath) returns the data' );
ok( ref $data1 eq 'SCALAR', '->get returns a scalar reference' );
is_deeply( $data1, $data2, '->get returns same same for TransformPath or Provider args' );
# Check against the provider's original
is_deeply( $data1, $good_provider->image, '->get returns data matching the provider\'s original' );
}
{ # ->set adds something to the cache
is( $Delivery->set( $new_path ), undef, '->set(TransformPath) return undef' );
my $Location = $Delivery->set( $new_provider );
isa_ok( $Location, 'HTML::Location' );
is( $Location->uri, 'http://good.site/path/e/ee2067f1d7.gif', '->set returns the expected URI' );
is( $Location->path, 't/data/04_good/e/ee2067f1d7.gif', '->set returns the expected path' );
# Does the written data match the source data?
is( File::Slurp::read_file($image2), File::Slurp::read_file($Location->path),
'->set wrote data matching the source file' );
# Does it now returns as existing?
is_deeply( $Location, $Delivery->exists($new_provider), '->exists now returns true for the provider we ->set' );
# Can we read the data back in?
is_deeply( $Delivery->get($new_provider), $new_provider->image, '->get fetches image data that matches original data' );
}
END {
# Make sure that ->set gets cleaned up after if not below
foreach my $path (
catfile( $good_dir, 'e', 'ee2067f1d7.gif' ),
catdir( $good_dir, 'e' ),
) {
File::Remove::remove \1, $path;
}
}
{ # ->clear removes an image from the cache
# Remember where it was
my $Location = $Delivery->exists( $new_provider );
isa_ok( $Location, 'HTML::Location' );
ok( -f $Location->path, 'Double checking location exists' );
# Try to clear it
my $rv = $Delivery->clear( $new_provider );
is( $rv, 1, '->clear returns true' );
# Does ->exists return false now?
is_deeply( $Delivery->exists( $new_provider ), '', '->exists returns false after ->clear' );
# Confirm the file is actually gone
ok( ! -e $Location->path, 'File does appear to be actually gone' );
}
1;