| 1 | #!/usr/bin/perl -w |
|---|
| 2 | # $Id$ |
|---|
| 3 | use strict; |
|---|
| 4 | use warnings; |
|---|
| 5 | |
|---|
| 6 | use lib 't/lib'; |
|---|
| 7 | use lib 'lib'; |
|---|
| 8 | use lib 'extlib'; |
|---|
| 9 | |
|---|
| 10 | use Test::More; |
|---|
| 11 | use File::Spec; |
|---|
| 12 | |
|---|
| 13 | use MT::Image; |
|---|
| 14 | use MT::ConfigMgr; |
|---|
| 15 | use MT; |
|---|
| 16 | |
|---|
| 17 | use vars qw( $BASE @Img @drivers ); |
|---|
| 18 | |
|---|
| 19 | require 't/test-common.pl'; |
|---|
| 20 | |
|---|
| 21 | BEGIN { |
|---|
| 22 | @Img = ( |
|---|
| 23 | [ 'test.gif', 233, 68 ], |
|---|
| 24 | [ 'test.jpg', 640, 480 ], |
|---|
| 25 | ); |
|---|
| 26 | @drivers = qw( ImageMagick NetPBM ); |
|---|
| 27 | plan tests => scalar @Img # file exists |
|---|
| 28 | + (scalar @Img * scalar @drivers * 18) # 18 tests each for every image and driver |
|---|
| 29 | ; |
|---|
| 30 | } |
|---|
| 31 | |
|---|
| 32 | MT->set_language('en-us'); |
|---|
| 33 | |
|---|
| 34 | my $File = "test.file"; |
|---|
| 35 | my $String = "testing"; |
|---|
| 36 | my $netpbm = '/usr/local/netpbm/bin'; |
|---|
| 37 | |
|---|
| 38 | my $cfg = MT::ConfigMgr->instance; |
|---|
| 39 | $cfg->NetPBMPath($netpbm) if -x $netpbm; |
|---|
| 40 | |
|---|
| 41 | for my $rec (@Img) { |
|---|
| 42 | my ($img_filename, $img_width, $img_height) = @$rec; |
|---|
| 43 | my $img_file = File::Spec->catfile($BASE, 't', 'images', $img_filename); |
|---|
| 44 | ok(-B $img_file, "$img_file looks like a binary file"); |
|---|
| 45 | |
|---|
| 46 | for my $driver (@drivers) { |
|---|
| 47 | $cfg->ImageDriver($driver); |
|---|
| 48 | my $img = MT::Image->new( Filename => $img_file ); |
|---|
| 49 | SKIP : { |
|---|
| 50 | skip("no $driver image", 17) unless $img; |
|---|
| 51 | isa_ok($img, 'MT::Image::' . $driver, "driver $driver with image $img_file is an MT::Image::$driver"); |
|---|
| 52 | # diag( MT::Image->errstr ) if MT::Image->errstr; |
|---|
| 53 | |
|---|
| 54 | is($img->{width}, $img_width, "$driver says $img_filename is $img_width px wide"); |
|---|
| 55 | is($img->{height}, $img_height, "$driver says $img_filename is $img_height px high"); |
|---|
| 56 | my($w, $h) = $img->get_dimensions(); |
|---|
| 57 | is($w, $img_width, "${driver}'s get_dimensions says $img_filename is $img_width px wide"); |
|---|
| 58 | is($h, $img_height, "${driver}'s get_dimensions says $img_filename is $img_height px high"); |
|---|
| 59 | |
|---|
| 60 | ($w, $h) = $img->get_dimensions(Scale => 50); |
|---|
| 61 | my($x, $y) = (int($img_width / 2), int($img_height / 2)); |
|---|
| 62 | is($w, $x, "$driver says $img_filename at 50\% scale is $x px wide"); |
|---|
| 63 | is($h, $y, "$driver says $img_filename at 50\% scale is $y px high"); |
|---|
| 64 | |
|---|
| 65 | ($w, $h) = $img->get_dimensions(); |
|---|
| 66 | is($w, $img_width, "${driver}'s get_dimensions says $img_filename is still $img_width px wide after theoretical scaling"); |
|---|
| 67 | is($h, $img_height, "${driver}'s get_dimensions says $img_filename is still $img_height px high after theoretical scaling"); |
|---|
| 68 | |
|---|
| 69 | ($w, $h) = $img->get_dimensions(Width => 50); |
|---|
| 70 | is($w, 50, "$driver says $img_filename scaled to 50 px wide is 50 px wide"); |
|---|
| 71 | |
|---|
| 72 | ($w, $h) = $img->get_dimensions(Width => 50, Height => 100); |
|---|
| 73 | is($w, 50, "$driver says $img_filename scaled to 50x100 is 50 px wide"); |
|---|
| 74 | is($h, 100, "$driver says $img_filename scaled to 50x100 is 100 px high"); |
|---|
| 75 | |
|---|
| 76 | (my($blob), $w, $h) = $img->scale(Scale => 50); |
|---|
| 77 | ($x, $y) = (int($img_width / 2), int($img_height / 2)); |
|---|
| 78 | is($w, $x, "result of scaling $img_filename to 50\% with $driver is $x px wide"); |
|---|
| 79 | is($h, $y, "result of scaling $img_filename to 50\% with $driver is $y px high"); |
|---|
| 80 | |
|---|
| 81 | open FH, $img_file or die $!; |
|---|
| 82 | binmode FH; |
|---|
| 83 | my $data = do { local $/; <FH> }; |
|---|
| 84 | close FH; |
|---|
| 85 | (my $type = $img_file) =~ s/.*\.//; |
|---|
| 86 | $img = MT::Image->new( Data => $data, Type => $type ); |
|---|
| 87 | isa_ok($img, 'MT::Image::' . $driver); |
|---|
| 88 | # diag( MT::Image->errstr ) if MT::Image->errstr; |
|---|
| 89 | is($img->{width}, $img_width, "$driver says $img_filename from blob is $img_width px wide"); |
|---|
| 90 | is($img->{height}, $img_height, "$driver says $img_filename from blob is $img_height px high"); |
|---|
| 91 | ($w, $h) = $img->get_dimensions; |
|---|
| 92 | is($w, $img_width, "${driver}'s get_dimensions says $img_filename from blob is $img_width px wide"); |
|---|
| 93 | is($h, $img_height, "${driver}'s get_dimensions says $img_filename from blob is $img_height px high"); |
|---|
| 94 | } # END SKIP |
|---|
| 95 | } |
|---|
| 96 | } |
|---|