t/t101jpeg.t

   1 #!perl -w
   2 use strict;
   3 use lib 't';
   4 use Imager qw(:all);
   5 use Test::More tests => 49;
   6
   7 init_log("testout/t101jpeg.log",1);
   8
   9 my $green=i_color_new(0,255,0,255);
  10 my $blue=i_color_new(0,0,255,255);
  11 my $red=i_color_new(255,0,0,255);
  12
  13 my $img=Imager::ImgRaw::new(150,150,3);
  14 my $cmpimg=Imager::ImgRaw::new(150,150,3);
  15
  16 i_box_filled($img,70,25,130,125,$green);
  17 i_box_filled($img,20,25,80,125,$blue);
  18 i_arc($img,75,75,30,0,361,$red);
  19 i_conv($img,[0.1, 0.2, 0.4, 0.2, 0.1]);
  20
  21 i_has_format("jpeg") && print "# has jpeg\n";
  22 if (!i_has_format("jpeg")) {
  23   # previously we'd crash if we tried to save/read an image via the OO
  24   # interface when there was no jpeg support
  25  SKIP:
  26   {
  27     my $im = Imager->new;
  28     ok(!$im->read(file=>"testimg/base.jpg"), "should fail to read jpeg");
  29     cmp_ok($im->errstr, '=~', qr/format 'jpeg' not supported/, "check no jpeg message");
  30     $im = Imager->new(xsize=>2, ysize=>2);
  31     ok(!$im->write(file=>"testout/nojpeg.jpg"), "should fail to write jpeg");
  32     cmp_ok($im->errstr, '=~', qr/format not supported/, "check no jpeg message");
  33     skip("no jpeg support", 45);
  34   }
  35 } else {
  36   open(FH,">testout/t101.jpg") || die "cannot open testout/t101.jpg for writing\n";
  37   binmode(FH);
  38   my $IO = Imager::io_new_fd(fileno(FH));
  39   ok(i_writejpeg_wiol($img,$IO,30), "write jpeg low level");
  40   close(FH);
  41
  42   open(FH, "testout/t101.jpg") || die "cannot open testout/t101.jpg\n";
  43   binmode(FH);
  44   $IO = Imager::io_new_fd(fileno(FH));
  45   ($cmpimg,undef) = i_readjpeg_wiol($IO);
  46   close(FH);
  47
  48   print "$cmpimg\n";
  49   my $diff = sqrt(i_img_diff($img,$cmpimg))/150*150;
  50   print "# jpeg average mean square pixel difference: ",$diff,"\n";
  51   ok($cmpimg, "read jpeg low level");
  52
  53   ok($diff < 10000, "difference between original and jpeg within bounds");
  54
  55         Imager::log_entry("Starting 4\n", 1);
  56   my $imoo = Imager->new;
  57   ok($imoo->read(file=>'testout/t101.jpg'), "read jpeg OO");
  58
  59   ok($imoo->write(file=>'testout/t101_oo.jpg'), "write jpeg OO");
  60         Imager::log_entry("Starting 5\n", 1);
  61   my $oocmp = Imager->new;
  62   ok($oocmp->read(file=>'testout/t101_oo.jpg'), "read jpeg OO for comparison");
  63
  64   $diff = sqrt(i_img_diff($imoo->{IMG},$oocmp->{IMG}))/150*150;
  65   print "# OO image difference $diff\n";
  66   ok($diff < 10000, "difference between original and jpeg within bounds");
  67
  68   # write failure test
  69   open FH, "< testout/t101.jpg" or die "Cannot open testout/t101.jpg: $!";
  70   binmode FH;
  71   ok(!$imoo->write(fd=>fileno(FH), type=>'jpeg'), 'failure handling');
  72   close FH;
  73   print "# ",$imoo->errstr,"\n";
  74
  75   # check that the i_format tag is set
  76   my @fmt = $imoo->tags(name=>'i_format');
  77   is($fmt[0], 'jpeg', 'i_format tag');
  78
  79   { # check file limits are checked
  80     my $limit_file = "testout/t101.jpg";
  81     ok(Imager->set_file_limits(reset=>1, width=>149), "set width limit 149");
  82     my $im = Imager->new;
  83     ok(!$im->read(file=>$limit_file),
  84        "should fail read due to size limits");
  85     print "# ",$im->errstr,"\n";
  86     like($im->errstr, qr/image width/, "check message");
  87
  88     ok(Imager->set_file_limits(reset=>1, height=>149), "set height limit 149");
  89     ok(!$im->read(file=>$limit_file),
  90        "should fail read due to size limits");
  91     print "# ",$im->errstr,"\n";
  92     like($im->errstr, qr/image height/, "check message");
  93
  94     ok(Imager->set_file_limits(reset=>1, width=>150), "set width limit 150");
  95     ok($im->read(file=>$limit_file),
  96        "should succeed - just inside width limit");
  97     ok(Imager->set_file_limits(reset=>1, height=>150), "set height limit 150");
  98     ok($im->read(file=>$limit_file),
  99        "should succeed - just inside height limit");
 100
 101     # 150 x 150 x 3 channel image uses 67500 bytes
 102     ok(Imager->set_file_limits(reset=>1, bytes=>67499),
 103        "set bytes limit 67499");
 104     ok(!$im->read(file=>$limit_file),
 105        "should fail - too many bytes");
 106     print "# ",$im->errstr,"\n";
 107     like($im->errstr, qr/storage size/, "check error message");
 108     ok(Imager->set_file_limits(reset=>1, bytes=>67500),
 109        "set bytes limit 67500");
 110     ok($im->read(file=>$limit_file),
 111        "should succeed - just inside bytes limit");
 112     Imager->set_file_limits(reset=>1);
 113   }
 114
 115  SKIP:
 116   {
 117     # we don't test them all
 118     my %expected_tags =
 119       (
 120        exif_date_time_original => "2005:11:25 00:00:00",
 121        exif_flash => 0,
 122        exif_image_description => "Imager Development Notes",
 123        exif_make => "Canon",
 124        exif_model => "CanoScan LiDE 35",
 125        exif_resolution_unit => 2,
 126        exif_resolution_unit_name => "inches",
 127        exif_user_comment => "        Part of notes from reworking i_arc() and friends.",
 128        exif_white_balance => 0,
 129        exif_white_balance_name => "Auto white balance",
 130       );
 131
 132     # exif tests
 133     Imager::i_exif_enabled()
 134         or skip("no exif support", scalar keys %expected_tags);
 135
 136     my $im = Imager->new;
 137     $im->read(file=>"testimg/exiftest.jpg")
 138       or skip("Could not read test image:".$im->errstr, scalar keys %expected_tags);
 139
 140     for my $key (keys %expected_tags) {
 141       is($expected_tags{$key}, $im->tags(name => $key),
 142          "test value of exif tag $key");
 143     }
 144   }
 145
 146   {
 147     # tests that the density values are set and read correctly
 148     # tests jpeg_comment too
 149     my @density_tests =
 150       (
 151        [ 't101cm100.jpg',
 152          {
 153           jpeg_density_unit => 2,
 154           i_xres => 254,
 155           i_yres => 254
 156          },
 157          {
 158           jpeg_density_unit => 2,
 159           i_xres => 254,
 160           i_yres => 254,
 161           i_aspect_only => undef,
 162          },
 163        ],
 164        [
 165         't101xonly.jpg',
 166         {
 167          i_xres => 100,
 168         },
 169         {
 170          i_xres => 100,
 171          i_yres => 100,
 172          jpeg_density_unit => 1,
 173          i_aspect_only => undef,
 174         },
 175        ],
 176        [
 177         't101yonly.jpg',
 178         {
 179          i_yres => 100,
 180         },
 181         {
 182          i_xres => 100,
 183          i_yres => 100,
 184          jpeg_density_unit => 1,
 185          i_aspect_only => undef,
 186         },
 187        ],
 188        [
 189         't101asponly.jpg',
 190         {
 191          i_xres => 50,
 192          i_yres => 100,
 193          i_aspect_only => 1,
 194         },
 195         {
 196          i_xres => 50,
 197          i_yres => 100,
 198          i_aspect_only => 1,
 199          jpeg_density_unit => 0,
 200         },
 201        ],
 202        [
 203         't101com.jpg',
 204         {
 205          jpeg_comment => 'test comment'
 206         },
 207        ],
 208       );
 209
 210     print "# test density tags\n";
 211     # I don't care about the content
 212     my $base_im = Imager->new(xsize => 10, ysize => 10);
 213     for my $test (@density_tests) {
 214       my ($filename, $out_tags, $expect_tags) = @$test;
 215       $expect_tags ||= $out_tags;
 216
 217       my $work = $base_im->copy;
 218       for my $key (keys %$out_tags) {
 219         $work->addtag(name => $key, value => $out_tags->{$key});
 220       }
 221
 222       ok($work->write(file=>"testout/$filename", type=>'jpeg'),
 223          "save $filename");
 224
 225       my $check = Imager->new;
 226       ok($check->read(file=> "testout/$filename"),
 227          "read $filename");
 228
 229       my %tags;
 230       for my $key (keys %$expect_tags) {
 231         $tags{$key} = $check->tags(name=>$key);
 232       }
 233       is_deeply($expect_tags, \%tags, "check tags for $filename");
 234     }
 235   }
 236 }
 237