- added experimental EXIF decoding when reading JPEG files.
[imager.git] / t / t101jpeg.t
1 #!perl -w
2 use strict;
3 use lib 't';
4 use Imager qw(:all);
5 use Test::More tests => 34;
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", 5);
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   ok($imoo->write(file=>'testout/t101_oo.jpg'), "write jpeg OO");
59         Imager::log_entry("Starting 5\n", 1);
60   my $oocmp = Imager->new;
61   ok($oocmp->read(file=>'testout/t101_oo.jpg'), "read jpeg OO for comparison");
62
63   $diff = sqrt(i_img_diff($imoo->{IMG},$oocmp->{IMG}))/150*150;
64   print "# OO image difference $diff\n";
65   ok($diff < 10000, "difference between original and jpeg within bounds");
66
67   # write failure test
68   open FH, "< testout/t101.jpg" or die "Cannot open testout/t101.jpg: $!";
69   binmode FH;
70   ok(!$imoo->write(fd=>fileno(FH), type=>'jpeg'), 'failure handling');
71   close FH;
72   print "# ",$imoo->errstr,"\n";
73
74   # check that the i_format tag is set
75   my @fmt = $imoo->tags(name=>'i_format');
76   is($fmt[0], 'jpeg', 'i_format tag');
77
78   { # check file limits are checked
79     my $limit_file = "testout/t101.jpg";
80     ok(Imager->set_file_limits(reset=>1, width=>149), "set width limit 149");
81     my $im = Imager->new;
82     ok(!$im->read(file=>$limit_file),
83        "should fail read due to size limits");
84     print "# ",$im->errstr,"\n";
85     like($im->errstr, qr/image width/, "check message");
86     
87     ok(Imager->set_file_limits(reset=>1, height=>149), "set height limit 149");
88     ok(!$im->read(file=>$limit_file),
89        "should fail read due to size limits");
90     print "# ",$im->errstr,"\n";
91     like($im->errstr, qr/image height/, "check message");
92     
93     ok(Imager->set_file_limits(reset=>1, width=>150), "set width limit 150");
94     ok($im->read(file=>$limit_file),
95        "should succeed - just inside width limit");
96     ok(Imager->set_file_limits(reset=>1, height=>150), "set height limit 150");
97     ok($im->read(file=>$limit_file),
98        "should succeed - just inside height limit");
99     
100     # 150 x 150 x 3 channel image uses 67500 bytes
101     ok(Imager->set_file_limits(reset=>1, bytes=>67499),
102        "set bytes limit 67499");
103     ok(!$im->read(file=>$limit_file),
104        "should fail - too many bytes");
105     print "# ",$im->errstr,"\n";
106     like($im->errstr, qr/storage size/, "check error message");
107     ok(Imager->set_file_limits(reset=>1, bytes=>67500),
108        "set bytes limit 67500");
109     ok($im->read(file=>$limit_file),
110        "should succeed - just inside bytes limit");
111     Imager->set_file_limits(reset=>1);
112   }
113
114  SKIP:
115   {
116     # we don't test them all
117     my %expected_tags =
118       (
119        exif_date_time_original => "2005:11:25 00:00:00",
120        exif_flash => 0,
121        exif_image_description => "Imager Development Notes",
122        exif_make => "Canon",
123        exif_model => "CanoScan LiDE 35",
124        exif_resolution_unit => 2,
125        exif_resolution_unit_name => "inches",
126        exif_user_comment => "        Part of notes from reworking i_arc() and friends.",
127        exif_white_balance => 0,
128        exif_white_balance_name => "Auto white balance",
129       );
130
131     # exif tests
132     Imager::i_exif_enabled()
133         or skip("no exif support", scalar keys %expected_tags);
134
135     my $im = Imager->new;
136     $im->read(file=>"testimg/exiftest.jpg")
137       or skip("Could not read test image:".$im->errstr, scalar keys %expected_tags);
138
139     for my $key (keys %expected_tags) {
140       is($expected_tags{$key}, $im->tags(name => $key),
141          "test value of exif tag $key");
142     }
143   }
144 }
145