1package Image::Info::JPEG;
2
3# Copyright 1999-2000, Gisle Aas.
4#
5# This library is free software; you can redistribute it and/or
6# modify it under the same terms as Perl itself.
7
8=begin register
9
10MAGIC: /^\xFF\xD8/
11
12For JPEG files we extract information both from C<JFIF> and C<Exif>
13application chunks.
14
15C<Exif> is the file format written by most digital cameras.  This
16encode things like timestamp, camera model, focal length, exposure
17time, aperture, flash usage, GPS position, etc.  The following web
18page contain description of the fields that can be present:
19
20 http://www.ba.wakwak.com/~tsuruzoh/Computer/Digicams/exif-e.html
21
22The C<Exif> spec can be found at:
23
24 http://www.pima.net/standards/it10/PIMA15740/exif.htm
25
26=end register
27
28=cut
29
30use strict;
31
32my %sof = (
33   0xC0 => "Baseline",
34   0xC1 => "Extended sequential",
35   0xC2 => "Progressive",
36   0xC3 => "Lossless",
37   0xC5 => "Differential sequential",
38   0xC6 => "Differential progressive",
39   0xC7 => "Differential lossless",
40   0xC9 => "Extended sequential, arithmetic coding",
41   0xCA => "Progressive, arithmetic coding",
42   0xCB => "Lossless, arithmetic coding",
43   0xCD => "Differential sequential, arithmetic coding",
44   0xCE => "Differential progressive, arithmetic coding",
45   0xCF => "Differential lossless, arithmetic coding",
46);
47
48sub my_read
49{
50    my($source, $len) = @_;
51    my $buf;
52    my $n = read($source, $buf, $len);
53    die "read failed: $!" unless defined $n;
54    die "short read ($len/$n)" unless $n == $len;
55    $buf;
56}
57
58BEGIN {
59    my $f = ($] >= 5.008) ? <<'EOT' : <<'EOT';
60        sub with_io_string (&$) {
61	    open(my $fh, "<", \$_[1]);
62	    local $_ = $fh;
63	    &{$_[0]};
64	}
65EOT
66	sub with_io_string (&$) {
67	    require IO::String;
68	    local $_ = IO::String->new($_[1]);
69	    &{$_[0]};
70	    $_->close;
71	}
72EOT
73
74    #print $f;
75    eval $f;
76    die $@ if $@;
77}
78
79sub process_file
80{
81    my($info, $fh, $cnf) = @_;
82    _process_file($info, $fh, 0);
83}
84
85sub _process_file
86{
87    my($info, $fh, $img_no) = @_;
88
89    my $soi = my_read($fh, 2);
90    die "SOI missing" unless $soi eq "\xFF\xD8";
91
92    $info->push_info($img_no, "file_media_type" => "image/jpeg");
93    $info->push_info($img_no, "file_ext" => "jpg");
94
95    while (1) {
96        my($ff, $mark, $len) = unpack("CCn", my_read($fh, 4));
97        last if $ff != 0xFF;
98        last if $mark == 0xDA || $mark == 0xD9;  # SOS/EOI
99	last if $len < 2;
100        process_chunk($info, $img_no, $mark, my_read($fh, $len - 2));
101    }
102}
103
104sub process_chunk
105{
106    my($info, $img_no, $mark, $data) = @_;
107    #printf "MARK 0x%02X, len=%d\n", $mark, length($data);
108
109    if ($mark == 0xFE) {
110        $info->push_info($img_no, Comment => $data);
111    }
112    elsif ($mark >= 0xE0 && $mark <= 0xEF) {
113        process_app($info, $mark, $data) if $img_no == 0;
114    }
115    elsif ($sof{$mark}) {
116        my($precision, $height, $width, $num_comp) =
117            unpack("CnnC", substr($data, 0, 6, ""));
118	$info->push_info($img_no, "JPEG_Type", $sof{$mark});
119	$info->push_info($img_no, "width", $width);
120	$info->push_info($img_no, "height", $height);
121
122	for (1..$num_comp) {
123	    $info->push_info($img_no, "BitsPerSample", $precision);
124	}
125	$info->push_info($img_no, "SamplesPerPixel" => $num_comp);
126
127	# XXX need to consider JFIF/Adobe markers to determine this...
128	if ($num_comp == 1) {
129	    $info->push_info($img_no, "color_type" => "Gray");
130	}
131	elsif ($num_comp == 3) {
132	    $info->push_info($img_no, "color_type" => "YCbCr");  # or RGB ?
133	}
134	elsif ($num_comp == 4) {
135	    $info->push_info($img_no, "color_type" => "CMYK");  # or YCCK ?
136	}
137
138	if (1) {
139	    my %comp_id_lookup = ( 1 => "Y",
140				   2 => "Cb",
141				   3 => "Cr",
142				   82 => "R",
143				   71 => "G",
144				   66 => "B" );
145	    while (length($data)) {
146		my($comp_id, $hv, $qtable) =
147		    unpack("CCC", substr($data, 0, 3, ""));
148		my $horiz_sf = $hv >> 4 & 0x0f;
149		my $vert_sf = $hv & 0x0f;
150		$comp_id = $comp_id_lookup{$comp_id} || $comp_id;
151		$info->push_info($img_no, "ColorComponents",  [$comp_id, $hv, $qtable]);
152		$info->push_info($img_no, "ColorComponentsDecoded",
153				 { ComponentIdentifier => $comp_id,
154				   HorizontalSamplingFactor => $horiz_sf,
155				   VerticalSamplingFactor => $vert_sf,
156				   QuantizationTableDesignator => $qtable } );
157	    }
158	}
159    }
160}
161
162sub process_app
163{
164    my($info, $mark, $data) = @_;
165    my $app = $mark - 0xE0;
166    my $id = substr($data, 0, 5, "");
167    #$info->push_info(0, "Debug", "APP$app $id");
168    $id = "$app-$id";
169    if ($id eq "0-JFIF\0") {
170	process_app0_jfif($info, $data);
171    }
172    elsif ($id eq "0-JFXX\0") {
173	process_app0_jfxx($info, $data);
174    }
175    elsif ($id eq "1-Exif\0") {
176	process_app1_exif($info, $data);
177    }
178    elsif ($id eq "14-Adobe") {
179	process_app14_adobe($info, $data);
180    }
181    else {
182	$info->push_info(0, "App$id", $data);
183	#printf "  %s\n", Data::Dump::dump($data);
184    }
185}
186
187sub process_app0_jfif
188{
189    my($info, $data) = @_;
190    if (length $data < 9) {
191	$info->push_info(0, "Debug", "Short JFIF chunk");
192	return;
193    }
194    my($ver_hi, $ver_lo, $unit, $x_density, $y_density, $x_thumb, $y_thumb) =
195	unpack("CC C nn CC", substr($data, 0, 9, ""));
196    $info->push_info(0, "JFIF_Version", sprintf("%d.%02d", $ver_hi, $ver_lo));
197
198    my $res = $x_density != $y_density || !$unit
199	? "$x_density/$y_density" : $x_density;
200
201    if ($unit) {
202	$unit = { 0 => "pixels",
203		  1 => "dpi",
204		  2 => "dpcm"
205		}->{$unit} || "jfif-unit-$unit";
206	$res .= " $unit";
207    }
208    $info->push_info(0, "resolution", $res);
209
210    if ($x_thumb || $y_thumb) {
211	$info->push_info(1, "width", $x_thumb);
212	$info->push_info(1, "height", $y_thumb);
213	$info->push_info(1, "ByteCount", length($data));
214    }
215}
216
217sub process_app0_jfxx
218{
219    my($info, $data) = @_;
220    my($code) = ord(substr($data, 0, 1, ""));
221    $info->push_info(1, "JFXX_ImageType",
222		     { 0x10 => "JPEG thumbnail",
223		       0x11 => "Bitmap thumbnail",
224		       0x13 => "RGB thumbnail",
225		     }->{$code} || "Unknown extention code $code");
226
227    if ($code == 0x10) {
228	eval {
229	    with_io_string {
230		_process_file($info, $_, 1);
231	    } $data;
232	};
233	$info->push_info(1, "error" => $@) if $@;
234    }
235}
236
237sub process_app1_exif
238{
239    my($info, $data) = @_;
240    my $null = substr($data, 0, 1, "");
241    if ($null ne "\0") {
242	$info->push_info(0, "Debug", "Exif chunk does not start with \\0");
243	return;
244    }
245
246    require Image::TIFF;
247    my $t = Image::TIFF->new(\$data);
248
249    for my $i (0 .. $t->num_ifds - 1) {
250	my $ifd = $t->ifd($i);
251	for (@$ifd) {
252	    $info->push_info($i, $_->[0], $_->[3]);
253	}
254
255	# If we find JPEGInterchangeFormat/JPEGInterchangeFormatLngth,
256	# then we should apply process_file kind of recusively to extract
257	# information of this (thumbnail) image file...
258	if (my($ipos) = $info->get_info($i, "JPEGInterchangeFormat", 1)) {
259	    my($ilen) = $info->get_info($i, "JPEGInterchangeFormatLngth", 1);
260	    die unless $ilen;
261	    my $jdata = substr($data, $ipos, $ilen);
262	    #$info->push_info($i, "JPEGImage" => $jdata);
263
264	    with_io_string {
265		_process_file($info, $_, $i);
266	    } $jdata;
267	}
268
269	# Turn XResolution/YResolution into 'resolution'
270	my($xres) = $info->get_info($i, "XResolution", 1);
271	my($yres) = $info->get_info($i, "YResolution", 1);
272
273	# Samsung Digimax 200 is a totally confused camera that
274	# puts rational numbers with 0 as denominator and they
275	# also seem to not understand what resolution means.
276	for ($xres, $yres) {
277	    $_ += 0 if ref($_) eq "Image::TIFF::Rational";
278	}
279
280	my($unit) = $info->get_info($i, "ResolutionUnit", 1);
281	my $res = "1/1";  # default;
282	if ($xres && $yres) {
283	    $res = ($xres == $yres) ? $xres : "$xres/$yres";
284	}
285	$res .= " $unit" if $unit && $unit ne "pixels";
286	$info->push_info($i, "resolution", $res);
287    }
288}
289
290sub process_app14_adobe
291{
292    my($info, $data) = @_;
293    my($version, $flags0, $flags1, $transform) = unpack("nnnC", $data);
294    $info->push_info(0, "AdobeTransformVersion" => $version);
295    $info->push_info(0, "AdobeTransformFlags" => [$flags0, $flags1]);
296    $info->push_info(0, "AdobeTransform" => $transform);
297}
298
2991;
300