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