Test-Image-GD-0.03/0000755000076500007650000000000010346213266014522 5ustar stevanstevan00000000000000Test-Image-GD-0.03/Changes0000644000076500007650000000076010346213345016016 0ustar stevanstevan00000000000000Revision history for Perl extension Test-Image-GD. 0.03 Fri, Dec 9, 2005 - added size_ok() function - added tests for this - added height_ok() function - added tests for this - added width_ok() function - added tests for this 0.02 Wed, Dec 7, 2005 - removed GIF files from distro and now the test file itself generates them, this is (IMO) a more realistic use case. 0.01 Sat Dec 3 23:06:56 2005 - module created Test-Image-GD-0.03/lib/0000755000076500007650000000000010346213266015270 5ustar stevanstevan00000000000000Test-Image-GD-0.03/lib/Test/0000755000076500007650000000000010346213266016207 5ustar stevanstevan00000000000000Test-Image-GD-0.03/lib/Test/Image/0000755000076500007650000000000010346213266017231 5ustar stevanstevan00000000000000Test-Image-GD-0.03/lib/Test/Image/GD.pm0000644000076500007650000001342310346213345020062 0ustar stevanstevan00000000000000 package Test::Image::GD; use strict; use warnings; use Test::Builder (); use Scalar::Util 'blessed'; use GD ':cmp'; require Exporter; our $VERSION = '0.03'; our @ISA = ('Exporter'); our @EXPORT = qw( cmp_image size_ok height_ok width_ok ); my $Test = Test::Builder->new; sub cmp_image ($$;$) { my ($got, $expected, $message) = @_; _coerce_image($got); _coerce_image($expected); if ($got->compare($expected) & GD_CMP_IMAGE) { $Test->ok(0, $message); } else { $Test->ok(1, $message); } } sub size_ok ($$;$) { my ($got, $expected, $message) = @_; _coerce_image($got); (ref($expected) && ref($expected) eq 'ARRAY') || die "expected must be an ARRAY ref"; if ($got->width == $expected->[0] && $got->height == $expected->[1] ){ $Test->ok(1, $message); } else { $Test->diag("... (image => (width, height))\n" . " w: (" . $got->width . " => " . $expected->[0] . ")\n" . " h: (" . $got->height . " => " . $expected->[1] . ")"); $Test->ok(0, $message); } } sub height_ok ($$;$) { my ($got, $expected, $message) = @_; _coerce_image($got); if ($got->height == $expected){ $Test->ok(1, $message); } else { $Test->diag("... (image => (height))\n" . " h: (" . $got->height . " => " . $expected . ")"); $Test->ok(0, $message); } } sub width_ok ($$;$) { my ($got, $expected, $message) = @_; _coerce_image($got); if ($got->width == $expected){ $Test->ok(1, $message); } else { $Test->diag("... (image => (width))\n" . " w: (" . $got->width . " => " . $expected . ")"); $Test->ok(0, $message); } } ## Utility Methods sub _coerce_image { unless (blessed($_[0]) && $_[0]->isa('GD::Image')) { $_[0] = GD::Image->new($_[0]) || die "Could not create GD::Image instance with : " . $_[0]; } } 1; __END__ =head1 NAME Test::Image::GD - A module for testing images using GD =head1 SYNOPSIS use Test::More plan => 1; use Test::Image::GD; cmp_image('test.gif', 'control.gif', '... these images should match'); # or my $test = GD::Image->new('test.gif'); my $control = GD::Image->new('control.gif'); cmp_image($test, $control, '... these images should match'); # some other test functions ... size_ok('camel.gif', [ 100, 350 ], '... the image is 100 x 350"); height_ok('test.gif', 200, '... the image has a height of 200'); width_ok('test.gif', 200, '... the image has a width of 200'); =head1 DESCRIPTION This module is meant to be used for testing custom graphics, it attempts to "visually" compare the images, this means it ignores invisible differences like color palettes and metadata. It also provides some extra functions to check the size of the image. =head1 FUNCTIONS =over 4 =item B This function will tell you whether the two images will look different, ignoring differences in the order of colors in the color palette and other invisible changes. Both C<$got> and C<$expected> can be either instances of C or either a file handle or a file path (both are valid parameters to the C constructor). =item B This function will check if an image is a certain size. As with the C function, the C<$got> parameter can be either an instance of C or a file handle or a file path (all are valid parameters to the C constructor). =item B This function will check if an image is a certain height. As with the C function, the C<$got> parameter can be either an instance of C or a file handle or a file path (all are valid parameters to the C constructor). =item B This function will check if an image is a certain width. As with the C function, the C<$got> parameter can be either an instance of C or a file handle or a file path (all are valid parameters to the C constructor). =back =head1 TO DO =over 4 =item Add more functions This module currently serves a very basic need of mine, however, I am sure as I start writing more tests against images I will find a need for other testing functions. Any suggestions are welcome. =back =head1 BUGS None that I am aware of. Of course, if you find a bug, let me know, and I will be sure to fix it. =head1 CODE COVERAGE I use B to test the code coverage of my tests, below is the B report on this module test suite. ---------------------------- ------ ------ ------ ------ ------ ------ ------ File stmt bran cond sub pod time total ---------------------------- ------ ------ ------ ------ ------ ------ ------ Test/Image/GD.pm 100.0 91.7 63.6 100.0 100.0 100.0 93.7 ---------------------------- ------ ------ ------ ------ ------ ------ ------ Total 100.0 91.7 63.6 100.0 100.0 100.0 93.7 ---------------------------- ------ ------ ------ ------ ------ ------ ------ =head1 SEE ALSO The C function of C class, that is how this C is implemented. =head1 AUTHOR Stevan Little, Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE Copyright 2005 by Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Test-Image-GD-0.03/Makefile.PL0000644000076500007650000000074310344716253016502 0ustar stevanstevan00000000000000use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Test::Image::GD', VERSION_FROM => 'lib/Test/Image/GD.pm', PREREQ_PM => { # for the module itself 'Test::Builder' => 0, 'GD' => 0, 'Scalar::Util' => 0, # for testing the module 'Test::Builder::Tester' => 0, 'Test::More' => 0.47, 'File::Spec' => 0, } ); Test-Image-GD-0.03/MANIFEST0000644000076500007650000000025510345746143015661 0ustar stevanstevan00000000000000Changes Makefile.PL MANIFEST README lib/Test/Image/GD.pm t/10_Test_Image_GD_test.t t/20_cmp_image.t t/30_size_ok.t t/40_height_ok.t t/50_width_ok.t t/pod.t t/pod_coverage.t Test-Image-GD-0.03/README0000644000076500007650000000101410345746106015401 0ustar stevanstevan00000000000000Test::Image::GD version 0.03 =========================== See the individual module documentation for more information INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES This module requires these other modules and libraries: None COPYRIGHT AND LICENCE Copyright (C) 2005 Infinity Interactive, Inc. http://www.iinteractive.com This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Test-Image-GD-0.03/t/0000755000076500007650000000000010346213266014765 5ustar stevanstevan00000000000000Test-Image-GD-0.03/t/10_Test_Image_GD_test.t0000644000076500007650000000016310344716253021106 0ustar stevanstevan00000000000000#!/usr/bin/perl use strict; use warnings; use Test::More tests => 1; BEGIN { use_ok('Test::Image::GD'); } Test-Image-GD-0.03/t/20_cmp_image.t0000644000076500007650000000474010345607517017406 0ustar stevanstevan00000000000000#!/usr/bin/perl use strict; use warnings; use Test::Builder::Tester tests => 2; use Test::More; use File::Spec::Functions; BEGIN { use_ok('Test::Image::GD'); } my $path_to_cpan_gif = catdir('t', 'cpan.gif'); my $path_to_cpan2_gif = catdir('t', 'cpan2.gif'); my $path_to_perl_gif = catdir('t', 'download_perl.gif'); { my $cpan = GD::Image->new(200, 100); $cpan->colorAllocate(255, 255, 255); $cpan->string(GD::gdSmallFont(), (10 * $_), (10 * $_), "CPAN Rules", $cpan->colorAllocate(0, 0, 0)) foreach 1 .. 5; open GIF1, ">", $path_to_cpan_gif || die "Could not create test GIF file"; print GIF1 $cpan->gif; close GIF1; } { my $cpan2 = GD::Image->new(200, 100); $cpan2->colorAllocate(255, 255, 255); $cpan2->string(GD::gdSmallFont(), (10 * $_), (10 * $_), "CPAN Rules", $cpan2->colorAllocate(0, 0, 0)) foreach 1 .. 5; open GIF2, ">", $path_to_cpan2_gif || die "Could not create test GIF file"; print GIF2 $cpan2->gif; close GIF2; } { my $perl = GD::Image->new(200, 100); $perl->colorAllocate(255, 255, 255); $perl->string(GD::gdSmallFont(), (10 * $_), (10 * $_), "Perl Rules", $perl->colorAllocate(0, 0, 0)) foreach 1 .. 5; open GIF3, ">", $path_to_perl_gif || die "Could not create test GIF file"; print GIF3 $perl->gif; close GIF3; } test_out("ok 1 - ... these are the exact same images"); test_out("ok 2 - ... these are the same images visually"); test_out("not ok 3 - ... these are not the same images"); test_err("# Failed test (t/20_cmp_image.t at line 58)"); test_out("ok 4 - ... these are the exact same images"); test_out("ok 5 - ... these are the same images visually"); test_out("not ok 6 - ... these are not the same images"); test_err("# Failed test (t/20_cmp_image.t at line 66)"); cmp_image($path_to_cpan_gif, $path_to_cpan_gif, '... these are the exact same images'); cmp_image($path_to_cpan_gif, $path_to_cpan2_gif, '... these are the same images visually'); cmp_image($path_to_cpan_gif, $path_to_perl_gif, '... these are not the same images'); my $cpan = GD::Image->new($path_to_cpan_gif); my $cpan2 = GD::Image->new($path_to_cpan2_gif); my $perl = GD::Image->new($path_to_perl_gif); cmp_image($cpan, $cpan2, '... these are the exact same images'); cmp_image($cpan, $cpan2, '... these are the same images visually'); cmp_image($cpan, $perl, '... these are not the same images'); test_test("cmp_image works"); unlink $path_to_cpan_gif; unlink $path_to_cpan2_gif; unlink $path_to_perl_gif; Test-Image-GD-0.03/t/30_size_ok.t0000644000076500007650000000245310345746106017126 0ustar stevanstevan00000000000000#!/usr/bin/perl use strict; use warnings; use Test::Builder::Tester tests => 2; use Test::More; use File::Spec::Functions; BEGIN { use_ok('Test::Image::GD'); } my $image_path = catdir('t', 'temp.gif'); { my $img = GD::Image->new(400, 400); open GIF, ">", $image_path || die "Could not create test GIF file"; print GIF $img->gif; close GIF; } test_out("ok 1 - ... image is (200 x 100)"); test_out("not ok 2 - ... image is not (100 x 200)"); test_err("# ... (image => (width, height))"); test_err("# w: (100 => 100)"); test_err("# h: (100 => 200)"); test_err("# Failed test (t/30_size_ok.t at line 43)"); test_out("ok 3 - ... image is (400 x 400)"); test_out("not ok 4 - ... image is not (100 x 200)"); test_err("# ... (image => (width, height))"); test_err("# w: (400 => 100)"); test_err("# h: (400 => 200)"); test_err("# Failed test (t/30_size_ok.t at line 48)"); { my $img = GD::Image->new(200, 100); size_ok($img, [ 200, 100 ], '... image is (200 x 100)'); } { my $img = GD::Image->new(100, 100); size_ok($img, [ 100, 200 ], '... image is not (100 x 200)'); } { size_ok($image_path, [ 400, 400 ], '... image is (400 x 400)'); size_ok($image_path, [ 100, 200 ], '... image is not (100 x 200)'); } test_test("size_ok works"); unlink $image_path; Test-Image-GD-0.03/t/40_height_ok.t0000644000076500007650000000220010345746106017413 0ustar stevanstevan00000000000000#!/usr/bin/perl use strict; use warnings; use Test::Builder::Tester tests => 2; use Test::More; use File::Spec::Functions; BEGIN { use_ok('Test::Image::GD'); } my $image_path = catdir('t', 'temp.gif'); { my $img = GD::Image->new(400, 400); open GIF, ">", $image_path || die "Could not create test GIF file"; print GIF $img->gif; close GIF; } test_out("ok 1 - ... image is 200"); test_out("not ok 2 - ... image is not 100"); test_err("# ... (image => (height))"); test_err("# h: (10 => 100)"); test_err("# Failed test (t/40_height_ok.t at line 41)"); test_out("ok 3 - ... image is 400"); test_out("not ok 4 - ... image is not 200"); test_err("# ... (image => (height))"); test_err("# h: (400 => 200)"); test_err("# Failed test (t/40_height_ok.t at line 46)"); { my $img = GD::Image->new(100, 200); height_ok($img, 200, '... image is 200'); } { my $img = GD::Image->new(10, 10); height_ok($img, 100, '... image is not 100'); } { height_ok($image_path, 400, '... image is 400'); height_ok($image_path, 200, '... image is not 200'); } test_test("height_ok works"); unlink $image_path; Test-Image-GD-0.03/t/50_width_ok.t0000644000076500007650000000216710345746106017277 0ustar stevanstevan00000000000000#!/usr/bin/perl use strict; use warnings; use Test::Builder::Tester tests => 2; use Test::More; use File::Spec::Functions; BEGIN { use_ok('Test::Image::GD'); } my $image_path = catdir('t', 'temp.gif'); { my $img = GD::Image->new(400, 400); open GIF, ">", $image_path || die "Could not create test GIF file"; print GIF $img->gif; close GIF; } test_out("ok 1 - ... image is 200"); test_out("not ok 2 - ... image is not 100"); test_err("# ... (image => (width))"); test_err("# w: (10 => 100)"); test_err("# Failed test (t/50_width_ok.t at line 41)"); test_out("ok 3 - ... image is 400"); test_out("not ok 4 - ... image is not 200"); test_err("# ... (image => (width))"); test_err("# w: (400 => 200)"); test_err("# Failed test (t/50_width_ok.t at line 46)"); { my $img = GD::Image->new(200, 100); width_ok($img, 200, '... image is 200'); } { my $img = GD::Image->new(10, 10); width_ok($img, 100, '... image is not 100'); } { width_ok($image_path, 400, '... image is 400'); width_ok($image_path, 200, '... image is not 200'); } test_test("width_ok works"); unlink $image_path; Test-Image-GD-0.03/t/pod.t0000644000076500007650000000025710344663775015754 0ustar stevanstevan00000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); Test-Image-GD-0.03/t/pod_coverage.t0000644000076500007650000000031710344663775017624 0ustar stevanstevan00000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; all_pod_coverage_ok();