- added experimental EXIF decoding when reading JPEG files.
[imager.git] / t / t101jpeg.t
CommitLineData
66614d6e
TC
1#!perl -w
2use strict;
3use lib 't';
20adc63d 4use Imager qw(:all);
f7450478 5use Test::More tests => 34;
20adc63d
TC
6
7init_log("testout/t101jpeg.log",1);
8
66614d6e
TC
9my $green=i_color_new(0,255,0,255);
10my $blue=i_color_new(0,0,255,255);
11my $red=i_color_new(255,0,0,255);
20adc63d 12
66614d6e
TC
13my $img=Imager::ImgRaw::new(150,150,3);
14my $cmpimg=Imager::ImgRaw::new(150,150,3);
20adc63d
TC
15
16i_box_filled($img,70,25,130,125,$green);
17i_box_filled($img,20,25,80,125,$blue);
18i_arc($img,75,75,30,0,361,$red);
19i_conv($img,[0.1, 0.2, 0.4, 0.2, 0.1]);
20
21i_has_format("jpeg") && print "# has jpeg\n";
22if (!i_has_format("jpeg")) {
66614d6e
TC
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);
cf692b64 34 }
20adc63d 35} else {
e2cb7e23 36 open(FH,">testout/t101.jpg") || die "cannot open testout/t101.jpg for writing\n";
20adc63d 37 binmode(FH);
66614d6e
TC
38 my $IO = Imager::io_new_fd(fileno(FH));
39 ok(i_writejpeg_wiol($img,$IO,30), "write jpeg low level");
20adc63d
TC
40 close(FH);
41
dd55acc8 42 open(FH, "testout/t101.jpg") || die "cannot open testout/t101.jpg\n";
20adc63d 43 binmode(FH);
dd55acc8
AMH
44 $IO = Imager::io_new_fd(fileno(FH));
45 ($cmpimg,undef) = i_readjpeg_wiol($IO);
20adc63d
TC
46 close(FH);
47
dd55acc8 48 print "$cmpimg\n";
cf692b64
TC
49 my $diff = sqrt(i_img_diff($img,$cmpimg))/150*150;
50 print "# jpeg average mean square pixel difference: ",$diff,"\n";
66614d6e 51 ok($cmpimg, "read jpeg low level");
cf692b64 52
66614d6e 53 ok($diff < 10000, "difference between original and jpeg within bounds");
cf692b64 54
84e51293 55 Imager::log_entry("Starting 4\n", 1);
cf692b64 56 my $imoo = Imager->new;
66614d6e
TC
57 ok($imoo->read(file=>'testout/t101.jpg'), "read jpeg OO");
58 ok($imoo->write(file=>'testout/t101_oo.jpg'), "write jpeg OO");
84e51293 59 Imager::log_entry("Starting 5\n", 1);
cf692b64 60 my $oocmp = Imager->new;
66614d6e 61 ok($oocmp->read(file=>'testout/t101_oo.jpg'), "read jpeg OO for comparison");
cf692b64
TC
62
63 $diff = sqrt(i_img_diff($imoo->{IMG},$oocmp->{IMG}))/150*150;
64 print "# OO image difference $diff\n";
66614d6e 65 ok($diff < 10000, "difference between original and jpeg within bounds");
f873cb01
TC
66
67 # write failure test
68 open FH, "< testout/t101.jpg" or die "Cannot open testout/t101.jpg: $!";
69 binmode FH;
66614d6e 70 ok(!$imoo->write(fd=>fileno(FH), type=>'jpeg'), 'failure handling');
f873cb01
TC
71 close FH;
72 print "# ",$imoo->errstr,"\n";
2c2c832a
TC
73
74 # check that the i_format tag is set
75 my @fmt = $imoo->tags(name=>'i_format');
66614d6e 76 is($fmt[0], 'jpeg', 'i_format tag');
77157728
TC
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 }
f7450478
TC
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 }
f873cb01
TC
144}
145