source: gsdl/trunk/perllib/cpan/Image/ExifTool/PNG.pm@ 16842

Last change on this file since 16842 was 16842, checked in by davidb, 16 years ago

ExifTool added to cpan area to support metadata extraction from files such as JPEG. Primarily targetted as Image files (hence the Image folder name decided upon by the ExifTool author) it also can handle video such as flash and audio such as Wav
File size: 34.3 KB
Line 
1#------------------------------------------------------------------------------
2# File: PNG.pm
3#
4# Description: Read and write PNG meta information
5#
6# Revisions: 06/10/2005 - P. Harvey Created
7# 06/23/2005 - P. Harvey Added MNG and JNG support
8# 09/16/2005 - P. Harvey Added write support
9#
10# References: 1) http://www.libpng.org/pub/png/spec/1.2/
11# 2) http://www.faqs.org/docs/png/
12# 3) http://www.libpng.org/pub/mng/
13# 4) http://www.libpng.org/pub/png/spec/register/
14#
15# Notes: I haven't found a sample PNG image with a 'iTXt' chunk, so
16# this part of the code is still untested.
17#
18# Writing meta information in PNG images is a pain in the butt
19# for a number of reasons: One biggie is that you have to
20# decompress then decode the ASCII/hex profile information before
21# you can edit it, then you have to ASCII/hex-encode, recompress
22# and calculate a CRC before you can write it out again. gaaaak.
23#------------------------------------------------------------------------------
24
25package Image::ExifTool::PNG;
26
27use strict;
28use vars qw($VERSION $AUTOLOAD);
29use Image::ExifTool qw(:DataAccess :Utils);
30
31$VERSION = '1.15';
32
33sub ProcessPNG_tEXt($$$);
34sub ProcessPNG_iTXt($$$);
35sub ProcessPNG_Compressed($$$);
36sub CalculateCRC($;$$$);
37sub HexEncode($);
38sub AddChunks($$);
39sub Add_iCCP($$);
40
41my $noCompressLib;
42
43# look up for file type, header chunk and end chunk, based on file signature
44my %pngLookup = (
45 "\x89PNG\r\n\x1a\n" => ['PNG', 'IHDR', 'IEND' ],
46 "\x8aMNG\r\n\x1a\n" => ['MNG', 'MHDR', 'MEND' ],
47 "\x8bJNG\r\n\x1a\n" => ['JNG', 'JHDR', 'IEND' ],
48);
49
50# color type of current image
51$Image::ExifTool::PNG::colorType = -1;
52
53# PNG chunks
54%Image::ExifTool::PNG::Main = (
55 WRITE_PROC => \&Image::ExifTool::DummyWriteProc,
56 GROUPS => { 2 => 'Image' },
57 bKGD => {
58 Name => 'BackgroundColor',
59 ValueConv => 'join(" ",unpack(length($val) < 2 ? "C" : "n*", $val))',
60 },
61 cHRM => {
62 Name => 'PrimaryChromaticities',
63 SubDirectory => { TagTable => 'Image::ExifTool::PNG::PrimaryChromaticities' },
64 },
65 fRAc => {
66 Name => 'FractalParameters',
67 Binary => 1,
68 },
69 gAMA => {
70 Name => 'Gamma',
71 ValueConv => 'my $a=unpack("N",$val);$a ? int(1e9/$a+0.5)/1e4 : $val',
72 },
73 gIFg => {
74 Name => 'GIFGraphicControlExtension',
75 Binary => 1,
76 },
77 gIFt => {
78 Name => 'GIFPlainTextExtension',
79 Binary => 1,
80 },
81 gIFx => {
82 Name => 'GIFApplicationExtension',
83 Binary => 1,
84 },
85 hIST => {
86 Name => 'PaletteHistogram',
87 Binary => 1,
88 },
89 iCCP => {
90 Name => 'ICC_Profile',
91 SubDirectory => {
92 TagTable => 'Image::ExifTool::ICC_Profile::Main',
93 ProcessProc => \&ProcessPNG_Compressed,
94 },
95 },
96# IDAT
97# IEND
98 IHDR => {
99 Name => 'ImageHeader',
100 SubDirectory => { TagTable => 'Image::ExifTool::PNG::ImageHeader' },
101 },
102 iTXt => {
103 Name => 'InternationalText',
104 SubDirectory => {
105 TagTable => 'Image::ExifTool::PNG::TextualData',
106 ProcessProc => \&ProcessPNG_iTXt,
107 },
108 },
109 oFFs => {
110 Name => 'ImageOffset',
111 ValueConv => q{
112 my @a = unpack("NNC",$val);
113 $a[2] = ($a[2] ? "microns" : "pixels");
114 return "$a[0], $a[1] ($a[2])";
115 },
116 },
117 pCAL => {
118 Name => 'PixelCalibration',
119 Binary => 1,
120 },
121 pHYs => {
122 Name => 'PhysicalPixel',
123 SubDirectory => { TagTable => 'Image::ExifTool::PNG::PhysicalPixel' },
124 },
125 PLTE => {
126 Name => 'Palette',
127 ValueConv => 'length($val) <= 3 ? join(" ",unpack("C*",$val)) : \$val',
128 },
129 sBIT => {
130 Name => 'SignificantBits',
131 ValueConv => 'join(" ",unpack("C*",$val))',
132 },
133 sPLT => {
134 Name => 'SuggestedPalette',
135 Binary => 1,
136 PrintConv => 'split("\0",$$val,1)', # extract palette name
137 },
138 sRGB => {
139 Name => 'SRGBRendering',
140 ValueConv => 'unpack("C",$val)',
141 PrintConv => {
142 0 => 'Perceptual',
143 1 => 'Relative Colorimetric',
144 2 => 'Saturation',
145 3 => 'Absolute Colorimetric',
146 },
147 },
148 tEXt => {
149 Name => 'TextualData',
150 SubDirectory => { TagTable => 'Image::ExifTool::PNG::TextualData' },
151 },
152 tIME => {
153 Name => 'ModifyDate',
154 Groups => { 2 => 'Time' },
155 Writable => 1,
156 Shift => 'Time',
157 ValueConv => 'sprintf("%.4d:%.2d:%.2d %.2d:%.2d:%.2d", unpack("nC5", $val))',
158 ValueConvInv => q{
159 my @a = ($val=~/^(\d+):(\d+):(\d+)\s+(\d+):(\d+):(\d+)/);
160 @a == 6 or warn('Invalid date'), return undef;
161 return pack('nC5', @a);
162 },
163 PrintConv => '$self->ConvertDateTime($val)',
164 PrintConvInv => '$val',
165 },
166 tRNS => {
167 Name => 'Transparency',
168 ValueConv => q{
169 return \$val if length($val) > 6;
170 join(" ",unpack($Image::ExifTool::PNG::colorType == 3 ? "C*" : "n*", $val));
171 },
172 },
173 tXMP => {
174 Name => 'XMP',
175 Notes => 'obsolete location specified by older XMP draft',
176 SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' },
177 },
178 zTXt => {
179 Name => 'CompressedText',
180 SubDirectory => {
181 TagTable => 'Image::ExifTool::PNG::TextualData',
182 ProcessProc => \&ProcessPNG_Compressed,
183 },
184 },
185);
186
187# PNG IHDR chunk
188%Image::ExifTool::PNG::ImageHeader = (
189 PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
190 GROUPS => { 2 => 'Image' },
191 0 => {
192 Name => 'ImageWidth',
193 Format => 'int32u',
194 },
195 4 => {
196 Name => 'ImageHeight',
197 Format => 'int32u',
198 },
199 8 => 'BitDepth',
200 9 => {
201 Name => 'ColorType',
202 RawConv => '$Image::ExifTool::PNG::colorType = $val',
203 PrintConv => {
204 0 => 'Grayscale',
205 2 => 'RGB',
206 3 => 'Palette',
207 4 => 'Grayscale with Alpha',
208 6 => 'RGB with Alpha',
209 },
210 },
211 10 => {
212 Name => 'Compression',
213 PrintConv => { 0 => 'Deflate/Inflate' },
214 },
215 11 => {
216 Name => 'Filter',
217 PrintConv => { 0 => 'Adaptive' },
218 },
219 12 => {
220 Name => 'Interlace',
221 PrintConv => { 0 => 'Noninterlaced', 1 => 'Adam7 Interlace' },
222 },
223);
224
225# PNG cHRM chunk
226%Image::ExifTool::PNG::PrimaryChromaticities = (
227 PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
228 GROUPS => { 2 => 'Image' },
229 FORMAT => 'int32u',
230 0 => { Name => 'WhitePointX', ValueConv => '$val / 100000' },
231 1 => { Name => 'WhitePointY', ValueConv => '$val / 100000' },
232 2 => { Name => 'RedX', ValueConv => '$val / 100000' },
233 3 => { Name => 'RedY', ValueConv => '$val / 100000' },
234 4 => { Name => 'GreenX', ValueConv => '$val / 100000' },
235 5 => { Name => 'GreenY', ValueConv => '$val / 100000' },
236 6 => { Name => 'BlueX', ValueConv => '$val / 100000' },
237 7 => { Name => 'BlueY', ValueConv => '$val / 100000' },
238);
239
240# PNG pHYs chunk
241%Image::ExifTool::PNG::PhysicalPixel = (
242 PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
243 GROUPS => { 2 => 'Image' },
244 0 => {
245 Name => 'PixelsPerUnitX',
246 Format => 'int32u',
247 },
248 4 => {
249 Name => 'PixelsPerUnitY',
250 Format => 'int32u',
251 },
252 8 => {
253 Name => 'PixelUnits',
254 PrintConv => { 0 => 'Unknown', 1 => 'Meters' },
255 },
256);
257
258my %unreg = ( Notes => 'unregistered' );
259
260# Tags for PNG tEXt zTXt and iTXt chunks
261# (NOTE: ValueConv is set dynamically, so don't set it here!)
262%Image::ExifTool::PNG::TextualData = (
263 PROCESS_PROC => \&ProcessPNG_tEXt,
264 WRITE_PROC => \&Image::ExifTool::DummyWriteProc,
265 WRITABLE => 'string',
266 PREFERRED => 1, # always add these tags when writing
267 GROUPS => { 2 => 'Image' },
268 NOTES => q{
269The PNG TextualData format allows aribrary tag names to be used. The tags
270listed below are the only ones that can be written (unless new user-defined
271tags are added via the configuration file), however ExifTool will extract
272any other TextualData tags that are found.
273
274The information for the TextualData tags may be stored as tEXt, zTXt or iTXt
275chunks in the PNG image. ExifTool will read and edit tags in their original
276form, but tEXt chunks are written by default when creating new tags.
277Compressed zTXt chunks are written only if Compress::Zlib is available, and
278only for profile information or when the -z (Compress) option is specified.
279
280Some of the tags below are not registered as part of the PNG specification,
281but are included here because they are generated by other software such as
282ImageMagick.
283 },
284 Title => { },
285 Author => { Groups => { 2 => 'Author' } },
286 Description => { },
287 Copyright => { Groups => { 2 => 'Author' } },
288 'Creation Time' => {
289 Name => 'CreationTime',
290 Groups => { 2 => 'Time' },
291 Shift => 'Time',
292 },
293 Software => { },
294 Disclaimer => { },
295 # change name to differentiate from ExifTool Warning
296 Warning => { Name => 'PNGWarning', },
297 Source => { },
298 Comment => { },
299#
300# The following tags are not part of the original PNG specification,
301# but are written by ImageMagick and other software
302#
303 Artist => { %unreg, Groups => { 2 => 'Author' } },
304 Document => { %unreg },
305 Label => { %unreg },
306 Make => { %unreg, Groups => { 2 => 'Camera' } },
307 Model => { %unreg, Groups => { 2 => 'Camera' } },
308 TimeStamp => { %unreg, Groups => { 2 => 'Time' }, Shift => 'Time' },
309 URL => { %unreg },
310 'XML:com.adobe.xmp' => {
311 Name => 'XMP',
312 Notes => q{
313 location according to the XMP specification -- this is where ExifTool will
314 add a new XMP chunk if the image didn't already contain XMP
315 },
316 SubDirectory => {
317 TagTable => 'Image::ExifTool::XMP::Main',
318 },
319 },
320 'Raw profile type APP1' => [
321 {
322 # EXIF table must come first because we key on this in ProcessProfile()
323 # (No condition because this is just for BuildTagLookup)
324 Name => 'APP1_Profile',
325 SubDirectory => {
326 TagTable=>'Image::ExifTool::Exif::Main',
327 ProcessProc => \&ProcessProfile,
328 },
329 },
330 {
331 Name => 'APP1_Profile',
332 SubDirectory => {
333 TagTable=>'Image::ExifTool::XMP::Main',
334 ProcessProc => \&ProcessProfile,
335 },
336 },
337 ],
338 'Raw profile type exif' => {
339 Name => 'EXIF_Profile',
340 SubDirectory => {
341 TagTable=>'Image::ExifTool::Exif::Main',
342 ProcessProc => \&ProcessProfile,
343 },
344 },
345 'Raw profile type icc' => {
346 Name => 'ICC_Profile',
347 SubDirectory => {
348 TagTable => 'Image::ExifTool::ICC_Profile::Main',
349 ProcessProc => \&ProcessProfile,
350 },
351 },
352 'Raw profile type icm' => {
353 Name => 'ICC_Profile',
354 SubDirectory => {
355 TagTable => 'Image::ExifTool::ICC_Profile::Main',
356 ProcessProc => \&ProcessProfile,
357 },
358 },
359 'Raw profile type iptc' => {
360 Name => 'IPTC_Profile',
361 SubDirectory => {
362 TagTable => 'Image::ExifTool::Photoshop::Main',
363 ProcessProc => \&ProcessProfile,
364 },
365 },
366 'Raw profile type xmp' => {
367 Name => 'XMP_Profile',
368 SubDirectory => {
369 TagTable => 'Image::ExifTool::XMP::Main',
370 ProcessProc => \&ProcessProfile,
371 },
372 },
373);
374
375#------------------------------------------------------------------------------
376# AutoLoad our writer routines when necessary
377#
378sub AUTOLOAD
379{
380 return Image::ExifTool::DoAutoLoad($AUTOLOAD, @_);
381}
382
383#------------------------------------------------------------------------------
384# Found a PNG tag -- extract info from subdirectory or decompress data if necessary
385# Inputs: 0) ExifTool object reference, 1) Pointer to tag table,
386# 2) Tag ID, 3) Tag value, 4) [optional] compressed data flag:
387# 0=not compressed, 1=unknown compression, 2-N=compression with type N-2
388# 5) optional output buffer reference
389# Returns: 1 on success
390sub FoundPNG($$$$;$$)
391{
392 my ($exifTool, $tagTablePtr, $tag, $val, $compressed, $outBuff) = @_;
393 my ($wasCompressed, $deflateErr);
394 return 0 unless defined $val;
395#
396# First, uncompress data if requested
397#
398 my $verbose = $exifTool->Options('Verbose');
399 my $out = $exifTool->Options('TextOut');
400 my $tagInfo = $exifTool->GetTagInfo($tagTablePtr, $tag) ||
401 # (some software forgets to capitalize first letter)
402 $exifTool->GetTagInfo($tagTablePtr, ucfirst($tag));
403
404 if ($compressed and $compressed > 1) {
405 if ($compressed == 2) { # Inflate/Deflate compression
406 if (eval 'require Compress::Zlib') {
407 my ($v2, $stat);
408 my $inflate = Compress::Zlib::inflateInit();
409 $inflate and ($v2, $stat) = $inflate->inflate($val);
410 if ($inflate and $stat == Compress::Zlib::Z_STREAM_END()) {
411 $val = $v2;
412 $compressed = 0;
413 $wasCompressed = 1;
414 } else {
415 $deflateErr = "Error inflating $tag";
416 }
417 } elsif (not $noCompressLib) {
418 $noCompressLib = 1;
419 my $verb = $outBuff ? 'write' : 'decode';
420 $deflateErr = "Install Compress::Zlib to $verb compressed information";
421 } else {
422 $deflateErr = ''; # flag deflate error but no warning
423 }
424 } else {
425 $compressed -= 2;
426 $deflateErr = "Unknown compression method $compressed for $tag";
427 }
428 if ($compressed and $verbose and $tagInfo and $$tagInfo{SubDirectory}) {
429 $exifTool->VerboseDir("Unable to decompress $$tagInfo{Name}", 0, length($val));
430 }
431 $exifTool->Warn($deflateErr) if $deflateErr and not $outBuff;
432 }
433#
434# extract information from subdirectory if available
435#
436 if ($tagInfo) {
437 my $tagName = $$tagInfo{Name};
438 my $processed;
439 if ($$tagInfo{SubDirectory} and not $compressed) {
440 my $len = length $val;
441 if ($verbose and $exifTool->{INDENT} ne ' ') {
442 if ($wasCompressed and $verbose > 2) {
443 my $name = $tagName;
444 $wasCompressed and $name = "Decompressed $name";
445 $exifTool->VerboseDir($name, 0, $len);
446 my %parms = ( Prefix => $exifTool->{INDENT}, Out => $out );
447 $parms{MaxLen} = 96 unless $verbose > 3;
448 Image::ExifTool::HexDump(\$val, undef, %parms);
449 }
450 # don't indent next directory (since it is really the same data)
451 $exifTool->{INDENT} =~ s/..$//;
452 }
453 my $subdir = $$tagInfo{SubDirectory};
454 my $processProc = $$subdir{ProcessProc};
455 # nothing more to do if writing and subdirectory is not writable
456 my $subTable = GetTagTable($$subdir{TagTable});
457 return 1 if $outBuff and not $$subTable{WRITE_PROC};
458 my %subdirInfo = (
459 DataPt => \$val,
460 DirStart => 0,
461 DataLen => $len,
462 DirLen => $len,
463 DirName => $tagName,
464 TagInfo => $tagInfo,
465 ReadOnly => 1, # (only used by WriteXMP)
466 OutBuff => $outBuff,
467 );
468 # no need to re-decompress if already done
469 undef $processProc if $wasCompressed and $processProc eq \&ProcessPNG_Compressed;
470 # rewrite this directory if necessary (but always process TextualData normally)
471 if ($outBuff and not $processProc and $subTable ne \%Image::ExifTool::PNG::TextualData) {
472 return 1 unless $exifTool->{EDIT_DIRS}->{$tagName};
473 $$outBuff = $exifTool->WriteDirectory(\%subdirInfo, $subTable);
474 # if this was an XMP directory, we must make it read-only
475 $tagName eq 'XMP' and Image::ExifTool::XMP::ValidateXMP(\$outBuff,'r');
476 delete $exifTool->{ADD_DIRS}->{$tagName};
477 } else {
478 $processed = $exifTool->ProcessDirectory(\%subdirInfo, $subTable, $processProc);
479 }
480 $compressed = 1; # pretend this is compressed since it is binary data
481 }
482 if ($outBuff) {
483 my $writable = $tagInfo->{Writable};
484 if ($writable or ($$tagTablePtr{WRITABLE} and
485 not defined $writable and not $$tagInfo{SubDirectory}))
486 {
487 # write new value for this tag if necessary
488 my ($isOverwriting, $newVal);
489 if ($exifTool->{DEL_GROUP}->{PNG}) {
490 # remove this tag now, but keep in ADD_PNG list to add back later
491 $isOverwriting = 1;
492 } else {
493 # remove this from the list of PNG tags to add
494 delete $exifTool->{ADD_PNG}->{$tag};
495 # (also handle case of tEXt tags written with lowercase first letter)
496 delete $exifTool->{ADD_PNG}->{ucfirst($tag)};
497 my $newValueHash = $exifTool->GetNewValueHash($tagInfo);
498 $isOverwriting = Image::ExifTool::IsOverwriting($newValueHash);
499 if (defined $deflateErr) {
500 $newVal = Image::ExifTool::GetNewValues($newValueHash);
501 # can only write tag now if unconditionally deleting it
502 if ($isOverwriting > 0 and not defined $newVal) {
503 $val = '<deflate error>';
504 } else {
505 $isOverwriting = 0; # can't rewrite this compressed text
506 $exifTool->Warn($deflateErr) if $deflateErr;
507 }
508 } else {
509 if ($isOverwriting < 0) {
510 $isOverwriting = Image::ExifTool::IsOverwriting($newValueHash, $val);
511 }
512 # (must get new value after IsOverwriting() in case it was shifted)
513 $newVal = Image::ExifTool::GetNewValues($newValueHash);
514 }
515 }
516 if ($isOverwriting) {
517 $$outBuff = (defined $newVal) ? $newVal : '';
518 ++$exifTool->{CHANGED};
519 if ($verbose > 1) {
520 print $out " - PNG:$tagName = '",$exifTool->Printable($val),"'\n";
521 print $out " + PNG:$tagName = '",$exifTool->Printable($newVal),"'\n" if defined $newVal;
522 }
523 }
524 }
525 if ($$outBuff) {
526 if ($wasCompressed) {
527 # re-compress the output data
528 my $deflate;
529 if (eval 'require Compress::Zlib') {
530 my $deflate = Compress::Zlib::deflateInit();
531 if ($deflate) {
532 $$outBuff = $deflate->deflate($$outBuff);
533 $$outBuff .= $deflate->flush() if defined $$outBuff;
534 } else {
535 undef $$outBuff;
536 }
537 }
538 $$outBuff or $exifTool->Warn("PNG:$tagName not written (compress error)");
539 } elsif ($exifTool->Options('Compress')) {
540 $exifTool->Warn("PNG:$tagName not compressed (uncompressed tag existed)", 1);
541 }
542 }
543 return 1;
544 }
545 return 1 if $processed;
546 } else {
547 my $name;
548 ($name = $tag) =~ s/\s+(.)/\u$1/g; # remove white space from tag name
549 $tagInfo = { Name => $name };
550 # make unknown profiles binary data type
551 $$tagInfo{ValueConv} = '\$val' if $tag =~ /^Raw profile type /;
552 Image::ExifTool::AddTagToTable($tagTablePtr, $tag, $tagInfo);
553 }
554#
555# store this tag information
556#
557 if ($verbose) {
558 # temporarily remove subdirectory so it isn't printed in verbose information
559 # since we aren't decoding it anyway;
560 my $subdir = $$tagInfo{SubDirectory};
561 delete $$tagInfo{SubDirectory};
562 $exifTool->VerboseInfo($tag, $tagInfo,
563 Table => $tagTablePtr,
564 DataPt => \$val,
565 );
566 $$tagInfo{SubDirectory} = $subdir if $subdir;
567 }
568 # set the RawConv dynamically depending on whether this is binary or not
569 my $delRawConv;
570 if ($compressed and not defined $$tagInfo{ValueConv}) {
571 $$tagInfo{RawConv} = '\$val';
572 $delRawConv = 1;
573 }
574 $exifTool->FoundTag($tagInfo, $val);
575 delete $$tagInfo{RawConv} if $delRawConv;
576 return 1;
577}
578
579#------------------------------------------------------------------------------
580# Process encoded PNG profile information
581# Inputs: 0) ExifTool object reference, 1) DirInfo reference, 2) Pointer to tag table
582# Returns: 1 on success
583sub ProcessProfile($$$)
584{
585 my ($exifTool, $dirInfo, $tagTablePtr) = @_;
586 my $dataPt = $$dirInfo{DataPt};
587 my $tagInfo = $$dirInfo{TagInfo};
588 my $outBuff = $$dirInfo{OutBuff};
589 my $tagName = $$tagInfo{Name};
590
591 # ImageMagick 5.3.6 writes profiles with the following headers:
592 # "\nICC Profile\n", "\nIPTC profile\n", "\n\xaa\x01{generic prof\n"
593 # and "\ngeneric profile\n"
594 return 0 unless $$dataPt =~ /^\n(.*?)\n\s*(\d+)\n(.*)/s;
595 my ($profileType, $len) = ($1, $2);
596 # data is encoded in hex, so change back to binary
597 my $buff = pack('H*', join('',split(' ',$3)));
598 my $actualLen = length $buff;
599 if ($len ne $actualLen) {
600 $exifTool->Warn("$tagName is wrong size (should be $len bytes but is $actualLen)");
601 $len = $actualLen;
602 }
603 my $verbose = $exifTool->Options('Verbose');
604 if ($verbose) {
605 if ($verbose > 2) {
606 $exifTool->VerboseDir("Decoded $tagName", 0, $len);
607 my %parms = (
608 Prefix => $exifTool->{INDENT},
609 Out => $exifTool->Options('TextOut'),
610 );
611 $parms{MaxLen} = 96 unless $verbose > 3;
612 Image::ExifTool::HexDump(\$buff, undef, %parms);
613 }
614 # don't indent next directory (since it is really the same data)
615 $exifTool->{INDENT} =~ s/..$//;
616 }
617 my %dirInfo = (
618 Parent => 'PNG',
619 DataPt => \$buff,
620 DataLen => $len,
621 DirStart => 0,
622 DirLen => $len,
623 Base => 0,
624 OutFile => $outBuff,
625 );
626 my $processed = 0;
627 my $oldChanged = $exifTool->{CHANGED};
628 my $exifTable = GetTagTable('Image::ExifTool::Exif::Main');
629 my $editDirs = $exifTool->{EDIT_DIRS};
630 my $addDirs = $exifTool->{ADD_DIRS};
631 if ($tagTablePtr ne $exifTable) {
632 # process non-EXIF and non-APP1 profile as-is
633 if ($outBuff) {
634 # no need to rewrite this if not editing tags in this directory
635 my $dir = $tagName;
636 $dir =~ s/_Profile// unless $dir =~ /^ICC/;
637 return 1 unless $$editDirs{$dir};
638 $$outBuff = $exifTool->WriteDirectory(\%dirInfo, $tagTablePtr);
639 delete $$addDirs{$dir};
640 } else {
641 $processed = $exifTool->ProcessDirectory(\%dirInfo, $tagTablePtr);
642 }
643 } elsif ($buff =~ /^$Image::ExifTool::exifAPP1hdr/) {
644 # APP1 EXIF information
645 return 1 if $outBuff and not $$editDirs{IFD0};
646 my $hdrLen = length($Image::ExifTool::exifAPP1hdr);
647 $dirInfo{DirStart} += $hdrLen;
648 $dirInfo{DirLen} -= $hdrLen;
649 $processed = $exifTool->ProcessTIFF(\%dirInfo);
650 if ($outBuff) {
651 if ($$outBuff) {
652 $$outBuff = $Image::ExifTool::exifAPP1hdr . $$outBuff if $$outBuff;
653 } else {
654 $$outBuff = '' if $processed;
655 }
656 delete $$addDirs{IFD0};
657 }
658 } elsif ($buff =~ /^$Image::ExifTool::xmpAPP1hdr/) {
659 # APP1 XMP information
660 my $hdrLen = length($Image::ExifTool::xmpAPP1hdr);
661 my $tagTablePtr = GetTagTable('Image::ExifTool::XMP::Main');
662 $dirInfo{DirStart} += $hdrLen;
663 $dirInfo{DirLen} -= $hdrLen;
664 if ($outBuff) {
665 return 1 unless $$editDirs{XMP};
666 $$outBuff = $exifTool->WriteDirectory(\%dirInfo, $tagTablePtr);
667 $$outBuff and $$outBuff = $Image::ExifTool::xmpAPP1hdr . $$outBuff;
668 delete $$addDirs{XMP};
669 } else {
670 $processed = $exifTool->ProcessDirectory(\%dirInfo, $tagTablePtr);
671 }
672 } elsif ($buff =~ /^(MM\0\x2a|II\x2a\0)/) {
673 # TIFF information (haven't seen this, but what the heck...)
674 return 1 if $outBuff and not $$editDirs{IFD0};
675 $processed = $exifTool->ProcessTIFF(\%dirInfo);
676 if ($outBuff) {
677 if ($$outBuff) {
678 $$outBuff = $Image::ExifTool::exifAPP1hdr . $$outBuff if $$outBuff;
679 } else {
680 $$outBuff = '' if $processed;
681 }
682 delete $$addDirs{IFD0};
683 }
684 } else {
685 my $profName = $profileType;
686 $profName =~ tr/\x00-\x1f\x7f-\xff/./;
687 $exifTool->Warn("Unknown raw profile '$profName'");
688 }
689 if ($outBuff and $$outBuff) {
690 if ($exifTool->{CHANGED} != $oldChanged) {
691 my $hdr = sprintf("\n%s\n%8d\n", $profileType, length($$outBuff));
692 # hex encode the data
693 $$outBuff = $hdr . HexEncode($outBuff);
694 } else {
695 undef $$outBuff;
696 }
697 }
698 return $processed;
699}
700
701#------------------------------------------------------------------------------
702# Process PNG compressed zTXt or iCCP chunk
703# Inputs: 0) ExifTool object reference, 1) DirInfo reference, 2) Pointer to tag table
704# Returns: 1 on success
705sub ProcessPNG_Compressed($$$)
706{
707 my ($exifTool, $dirInfo, $tagTablePtr) = @_;
708 my ($tag, $val) = split /\0/, ${$$dirInfo{DataPt}}, 2;
709 return 0 unless defined $val;
710 # set compressed to 2 + compression method to decompress the data
711 my $compressed = 2 + unpack('C', $val);
712 my $hdr = $tag . "\0" . substr($val, 0, 1);
713 $val = substr($val, 1); # remove compression method byte
714 # use the PNG chunk tag instead of the embedded tag name for iCCP chunks
715 if ($$dirInfo{TagInfo} and $$dirInfo{TagInfo}->{Name} eq 'ICC_Profile') {
716 $tag = 'iCCP';
717 $tagTablePtr = \%Image::ExifTool::PNG::Main;
718 }
719 my $outBuff = $$dirInfo{OutBuff};
720 my $rtnVal = FoundPNG($exifTool, $tagTablePtr, $tag, $val, $compressed, $outBuff);
721 # add header back onto this chunk if we are writing
722 $$outBuff = $hdr . $$outBuff if $outBuff and $$outBuff;
723 return $rtnVal;
724}
725
726#------------------------------------------------------------------------------
727# Process PNG tEXt chunk
728# Inputs: 0) ExifTool object reference, 1) DirInfo reference, 2) Pointer to tag table
729# Returns: 1 on success
730sub ProcessPNG_tEXt($$$)
731{
732 my ($exifTool, $dirInfo, $tagTablePtr) = @_;
733 my ($tag, $val) = split /\0/, ${$$dirInfo{DataPt}}, 2;
734 my $outBuff = $$dirInfo{OutBuff};
735 my $rtnVal = FoundPNG($exifTool, $tagTablePtr, $tag, $val, undef, $outBuff);
736 # add header back onto this chunk if we are writing
737 $$outBuff = $tag . "\0" . $$outBuff if $outBuff and $$outBuff;
738 return $rtnVal;
739}
740
741#------------------------------------------------------------------------------
742# Process PNG iTXt chunk
743# Inputs: 0) ExifTool object reference, 1) DirInfo reference, 2) Pointer to tag table
744# Returns: 1 on success
745sub ProcessPNG_iTXt($$$)
746{
747 my ($exifTool, $dirInfo, $tagTablePtr) = @_;
748 my ($tag, $dat) = split /\0/, ${$$dirInfo{DataPt}}, 2;
749 return 0 unless defined $dat and length($dat) >= 4;
750 my ($compressed, $meth) = unpack('CC', $dat);
751 my ($lang, $trans, $val) = split /\0/, substr($dat, 2), 3;
752 # set compressed flag so we will decompress it in FoundPNG()
753 $compressed and $compressed = 2 + $meth;
754 my $outBuff = $$dirInfo{OutBuff};
755 my $rtnVal = FoundPNG($exifTool, $tagTablePtr, $tag, $val, $compressed, $outBuff);
756 if ($outBuff and $$outBuff) {
757 $$outBuff = $tag . "\0" . substr($dat, 0, 2) . "$lang\0$trans\0" . $$outBuff;
758 }
759 return $rtnVal;
760}
761
762#------------------------------------------------------------------------------
763# Extract meta information from a PNG image
764# Inputs: 0) ExifTool object reference, 1) dirInfo reference
765# Returns: 1 on success, 0 if this wasn't a valid PNG image, or -1 on write error
766sub ProcessPNG($$)
767{
768 my ($exifTool, $dirInfo) = @_;
769 my $outfile = $$dirInfo{OutFile};
770 my $raf = $$dirInfo{RAF};
771 my $datChunk = '';
772 my $datCount = 0;
773 my $datBytes = 0;
774 my ($sig, $err, $ok);
775
776 # check to be sure this is a valid PNG/MNG/JNG image
777 return 0 unless $raf->Read($sig,8) == 8 and $pngLookup{$sig};
778 if ($outfile) {
779 Write($outfile, $sig) or $err = 1 if $outfile;
780 # can only add tags in Main and TextualData tables
781 $exifTool->{ADD_PNG} = $exifTool->GetNewTagInfoHash(
782 \%Image::ExifTool::PNG::Main,
783 \%Image::ExifTool::PNG::TextualData);
784 # initialize with same directories as JPEG, but PNG tags take priority
785 $exifTool->InitWriteDirs('JPEG','PNG');
786 }
787 my ($fileType, $hdrChunk, $endChunk) = @{$pngLookup{$sig}};
788 $exifTool->SetFileType($fileType); # set the FileType tag
789 SetByteOrder('MM'); # PNG files are big-endian
790 my $tagTablePtr = GetTagTable('Image::ExifTool::PNG::Main');
791 my $mngTablePtr;
792 if ($fileType ne 'PNG') {
793 $mngTablePtr = GetTagTable('Image::ExifTool::MNG::Main');
794 }
795 my $verbose = $exifTool->Options('Verbose');
796 my $out = $exifTool->Options('TextOut');
797 my ($hbuf, $dbuf, $cbuf, $foundHdr);
798
799 # process the PNG/MNG/JNG chunks
800 undef $noCompressLib;
801 for (;;) {
802 $raf->Read($hbuf,8) == 8 or $exifTool->Warn("Truncated $fileType image"), last;
803 my ($len, $chunk) = unpack('Na4',$hbuf);
804 $len > 0x7fffffff and $exifTool->Warn("Invalid $fileType box size"), last;
805 if ($verbose) {
806 # don't dump image data chunks in verbose mode (only give count instead)
807 if ($datCount and $chunk ne $datChunk) {
808 my $s = $datCount > 1 ? 's' : '';
809 print $out "$fileType $datChunk ($datCount chunk$s, total $datBytes bytes)\n";
810 $datCount = $datBytes = 0;
811 $datChunk = '';
812 }
813 if ($chunk =~ /^(IDAT|JDAT|JDAA)$/) {
814 $datChunk = $chunk;
815 $datCount++;
816 $datBytes += $len;
817 }
818 }
819 if ($outfile) {
820 if ($chunk eq 'IEND') {
821 # add any new chunks immediately before the IEND chunk
822 AddChunks($exifTool, $outfile) or $err = 1;
823 } elsif ($chunk eq 'PLTE' or $chunk eq 'IDAT') {
824 # iCCP chunk must come before PLTE and IDAT
825 # (ignore errors -- will add later as text profile if this fails)
826 Add_iCCP($exifTool, $outfile);
827 }
828 }
829 if ($chunk eq $endChunk) {
830 if ($outfile) {
831 # copy over the rest of the file if necessary
832 Write($outfile, $hbuf) or $err = 1;
833 while ($raf->Read($hbuf, 65536)) {
834 Write($outfile, $hbuf) or $err = 1;
835 }
836 }
837 $verbose and print $out "$fileType $chunk (end of image)\n";
838 $ok = 1;
839 last;
840 }
841 # read chunk data and CRC
842 unless ($raf->Read($dbuf,$len)==$len and $raf->Read($cbuf, 4)==4) {
843 $exifTool->Warn("Corrupted $fileType image");
844 last;
845 }
846 unless ($foundHdr) {
847 if ($chunk eq $hdrChunk) {
848 $foundHdr = 1;
849 } else {
850 $exifTool->Warn("$fileType image did not start with $hdrChunk");
851 last;
852 }
853 }
854 if ($verbose) {
855 # check CRC when in verbose mode (since we don't care about speed)
856 my $crc = CalculateCRC(\$hbuf, undef, 4);
857 $crc = CalculateCRC(\$dbuf, $crc);
858 $crc == unpack('N',$cbuf) or $exifTool->Warn("Bad CRC for $chunk chunk");
859 if ($datChunk) {
860 Write($outfile, $hbuf, $dbuf, $cbuf) or $err = 1 if $outfile;
861 next;
862 }
863 print $out "$fileType $chunk ($len bytes):\n";
864 if ($verbose > 2) {
865 my %dumpParms = ( Out => $out );
866 $dumpParms{MaxLen} = 96 if $verbose <= 4;
867 Image::ExifTool::HexDump(\$dbuf, undef, %dumpParms);
868 }
869 }
870 # only extract information from chunks in our tables
871 my ($theBuff, $outBuff);
872 $outBuff = \$theBuff if $outfile;
873 if ($$tagTablePtr{$chunk}) {
874 FoundPNG($exifTool, $tagTablePtr, $chunk, $dbuf, undef, $outBuff);
875 } elsif ($mngTablePtr and $$mngTablePtr{$chunk}) {
876 FoundPNG($exifTool, $mngTablePtr, $chunk, $dbuf, undef, $outBuff);
877 }
878 if ($outfile) {
879 if ($theBuff) {
880 $hbuf = pack('Na4',length($theBuff), $chunk);
881 $dbuf = $theBuff;
882 my $crc = CalculateCRC(\$hbuf, undef, 4);
883 $crc = CalculateCRC(\$dbuf, $crc);
884 $cbuf = pack('N', $crc);
885 } elsif (defined $theBuff) {
886 next; # empty if we deleted the information
887 }
888 Write($outfile, $hbuf, $dbuf, $cbuf) or $err = 1;
889 }
890 }
891 return -1 if $outfile and ($err or not $ok);
892 return 1; # this was a valid PNG/MNG/JNG image
893}
894
8951; # end
896
897__END__
898
899=head1 NAME
900
901Image::ExifTool::PNG - Read and write PNG meta information
902
903=head1 SYNOPSIS
904
905This module is used by Image::ExifTool
906
907=head1 DESCRIPTION
908
909This module contains routines required by Image::ExifTool to read and
910write PNG (Portable Network Graphics), MNG (Multi-image Network Graphics)
911and JNG (JPEG Network Graphics) images.
912
913=head1 AUTHOR
914
915Copyright 2003-2007, Phil Harvey (phil at owl.phy.queensu.ca)
916
917This library is free software; you can redistribute it and/or modify it
918under the same terms as Perl itself.
919
920=head1 REFERENCES
921
922=over 4
923
924=item L<http://www.libpng.org/pub/png/spec/1.2/>
925
926=item L<http://www.faqs.org/docs/png/>
927
928=item L<http://www.libpng.org/pub/mng/>
929
930=item L<http://www.libpng.org/pub/png/spec/register/>
931
932=back
933
934=head1 SEE ALSO
935
936L<Image::ExifTool::TagNames/PNG Tags>,
937L<Image::ExifTool::TagNames/MNG Tags>,
938L<Image::ExifTool(3pm)|Image::ExifTool>
939
940=cut
941
Note: See TracBrowser for help on using the repository browser.