File Coverage

blib/lib/Image/ExifTool/PNG.pm
Criterion Covered Total %
statement 298 498 59.8
branch 175 400 43.7
condition 95 219 43.3
subroutine 13 15 86.6
pod 0 11 0.0
total 581 1143 50.8


line stmt bran cond sub pod time code
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             # 5) ftp://ftp.simplesystems.org/pub/png/documents/pngext-1.4.0-pdg.html
15             # 6) ftp://ftp.simplesystems.org/pub/png/documents/pngext-1.5.0.html
16             #
17             # Notes: Writing meta information in PNG images is a pain in the butt
18             # for a number of reasons: One biggie is that you have to
19             # decompress then decode the ASCII/hex profile information before
20             # you can edit it, then you have to ASCII/hex-encode, recompress
21             # and calculate a CRC before you can write it out again. gaaaak.
22             #
23             # Although XMP is allowed after the IDAT chunk according to the
24             # PNG specifiction, some apps (Apple Spotlight and Preview for
25             # OS X 10.8.5 and Adobe Photoshop CC 14.0) ignore it unless it
26             # comes before IDAT. As of version 11.58, ExifTool uses a 2-pass
27             # writing algorithm to allow it to be compatible with XMP after
28             # IDAT while writing it before IDAT. (PNG and EXIF are still
29             # written after IDAT.) As of version 11.63, this strategy is
30             # applied to all text chunks (tEXt, zTXt and iTXt).
31             #------------------------------------------------------------------------------
32              
33             package Image::ExifTool::PNG;
34              
35 22     22   3765 use strict;
  22         51  
  22         730  
36 22     22   258 use vars qw($VERSION $AUTOLOAD %stdCase);
  22         47  
  22         1148  
37 22     22   126 use Image::ExifTool qw(:DataAccess :Utils);
  22         49  
  22         140640  
38              
39             $VERSION = '1.60';
40              
41             sub ProcessPNG_tEXt($$$);
42             sub ProcessPNG_iTXt($$$);
43             sub ProcessPNG_eXIf($$$);
44             sub ProcessPNG_Compressed($$$);
45             sub CalculateCRC($;$$$);
46             sub HexEncode($);
47             sub AddChunks($$;@);
48             sub Add_iCCP($$);
49             sub DoneDir($$$;$);
50             sub GetLangInfo($$);
51             sub BuildTextChunk($$$$$);
52             sub ConvertPNGDate($$);
53             sub InversePNGDate($$);
54              
55             # translate lower-case to actual case used for eXIf/zXIf chunks
56             %stdCase = ( 'zxif' => 'zxIf', exif => 'eXIf' );
57              
58             my $noCompressLib;
59              
60             # look up for file type, header chunk and end chunk, based on file signature
61             my %pngLookup = (
62             "\x89PNG\r\n\x1a\n" => ['PNG', 'IHDR', 'IEND' ],
63             "\x8aMNG\r\n\x1a\n" => ['MNG', 'MHDR', 'MEND' ],
64             "\x8bJNG\r\n\x1a\n" => ['JNG', 'JHDR', 'IEND' ],
65             );
66              
67             # map for directories in PNG images
68             my %pngMap = (
69             IFD1 => 'IFD0',
70             EXIF => 'IFD0', # to write EXIF as a block
71             ExifIFD => 'IFD0',
72             GPS => 'IFD0',
73             SubIFD => 'IFD0',
74             GlobParamIFD => 'IFD0',
75             PrintIM => 'IFD0',
76             InteropIFD => 'ExifIFD',
77             MakerNotes => 'ExifIFD',
78             IFD0 => 'PNG',
79             XMP => 'PNG',
80             ICC_Profile => 'PNG',
81             Photoshop => 'PNG',
82             'PNG-pHYs' => 'PNG',
83             IPTC => 'Photoshop',
84             MakerNotes => 'ExifIFD',
85             );
86              
87             # color type of current image
88             $Image::ExifTool::PNG::colorType = -1;
89              
90             # data and text chunk types
91             my %isDatChunk = ( IDAT => 1, JDAT => 1, JDAA => 1 );
92             my %isTxtChunk = ( tEXt => 1, zTXt => 1, iTXt => 1, eXIf => 1 );
93              
94             # chunks that we shouldn't move other chunks across (ref 3)
95             my %noLeapFrog = ( SAVE => 1, SEEK => 1, IHDR => 1, JHDR => 1, IEND => 1, MEND => 1,
96             DHDR => 1, BASI => 1, CLON => 1, PAST => 1, SHOW => 1, MAGN => 1 );
97              
98             # PNG chunks
99             %Image::ExifTool::PNG::Main = (
100             WRITE_PROC => \&Image::ExifTool::DummyWriteProc,
101             GROUPS => { 2 => 'Image' },
102             PREFERRED => 1, # always add these tags when writing
103             NOTES => q{
104             Tags extracted from PNG images. See
105             L for the official PNG 1.2
106             specification.
107              
108             According to the specification, a PNG file should end at the IEND chunk,
109             however ExifTool will preserve any data found after this when writing unless
110             it is specifically deleted with C<-Trailer:All=>. When reading, a minor
111             warning is issued if this trailer exists, and ExifTool will attempt to parse
112             this data as additional PNG chunks.
113              
114             Also according to the PNG specification, there is no restriction on the
115             location of text-type chunks (tEXt, zTXt and iTXt). However, certain
116             utilities (including some Apple and Adobe utilities) won't read the XMP iTXt
117             chunk if it comes after the IDAT chunk, and at least one utility won't read
118             other text chunks here. For this reason, when writing, ExifTool 11.63 and
119             later create new text chunks (including XMP) before IDAT, and move existing
120             text chunks to before IDAT.
121              
122             The PNG format contains CRC checksums that are validated when reading with
123             either the L or L option. When writing, these checksums are
124             validated by default, but the L option may be used to bypass this
125             check if speed is more of a concern.
126             },
127             bKGD => {
128             Name => 'BackgroundColor',
129             ValueConv => 'join(" ",unpack(length($val) < 2 ? "C" : "n*", $val))',
130             },
131             cHRM => {
132             Name => 'PrimaryChromaticities',
133             SubDirectory => { TagTable => 'Image::ExifTool::PNG::PrimaryChromaticities' },
134             },
135             dSIG => {
136             Name => 'DigitalSignature',
137             Binary => 1,
138             },
139             fRAc => {
140             Name => 'FractalParameters',
141             Binary => 1,
142             },
143             gAMA => {
144             Name => 'Gamma',
145             Writable => 1,
146             Protected => 1,
147             Notes => q{
148             ExifTool reports the gamma for decoding the image, which is consistent with
149             the EXIF convention, but is the inverse of the stored encoding gamma
150             },
151             ValueConv => 'my $a=unpack("N",$val);$a ? int(1e9/$a+0.5)/1e4 : $val',
152             ValueConvInv => 'pack("N", int(1e5/$val+0.5))',
153             },
154             gIFg => {
155             Name => 'GIFGraphicControlExtension',
156             Binary => 1,
157             },
158             gIFt => {
159             Name => 'GIFPlainTextExtension',
160             Binary => 1,
161             },
162             gIFx => {
163             Name => 'GIFApplicationExtension',
164             Binary => 1,
165             },
166             hIST => {
167             Name => 'PaletteHistogram',
168             Binary => 1,
169             },
170             iCCP => {
171             Name => 'ICC_Profile',
172             Notes => q{
173             this is where ExifTool will write a new ICC_Profile. When creating a new
174             ICC_Profile, the SRGBRendering tag should be deleted if it exists
175             },
176             SubDirectory => {
177             TagTable => 'Image::ExifTool::ICC_Profile::Main',
178             ProcessProc => \&ProcessPNG_Compressed,
179             },
180             },
181             'iCCP-name' => {
182             Name => 'ProfileName',
183             Writable => 1,
184             FakeTag => 1, # (not a real PNG tag, so don't try to write it)
185             Notes => q{
186             not a real tag ID, this tag represents the iCCP profile name, and may only
187             be written when the ICC_Profile is written
188             },
189             },
190             # IDAT
191             # IEND
192             IHDR => {
193             Name => 'ImageHeader',
194             SubDirectory => { TagTable => 'Image::ExifTool::PNG::ImageHeader' },
195             },
196             iTXt => {
197             Name => 'InternationalText',
198             SubDirectory => {
199             TagTable => 'Image::ExifTool::PNG::TextualData',
200             ProcessProc => \&ProcessPNG_iTXt,
201             },
202             },
203             oFFs => {
204             Name => 'ImageOffset',
205             ValueConv => q{
206             my @a = unpack("NNC",$val);
207             $a[2] = ($a[2] ? "microns" : "pixels");
208             return "$a[0], $a[1] ($a[2])";
209             },
210             },
211             pCAL => {
212             Name => 'PixelCalibration',
213             Binary => 1,
214             },
215             pHYs => {
216             Name => 'PhysicalPixel',
217             SubDirectory => {
218             TagTable => 'Image::ExifTool::PNG::PhysicalPixel',
219             DirName => 'PNG-pHYs', # (needed for writing)
220             },
221             },
222             PLTE => {
223             Name => 'Palette',
224             ValueConv => 'length($val) <= 3 ? join(" ",unpack("C*",$val)) : \$val',
225             },
226             sBIT => {
227             Name => 'SignificantBits',
228             ValueConv => 'join(" ",unpack("C*",$val))',
229             },
230             sCAL => { # png 1.4.0
231             Name => 'SubjectScale',
232             SubDirectory => { TagTable => 'Image::ExifTool::PNG::SubjectScale' },
233             },
234             sPLT => {
235             Name => 'SuggestedPalette',
236             Binary => 1,
237             PrintConv => 'split("\0",$$val,1)', # extract palette name
238             },
239             sRGB => {
240             Name => 'SRGBRendering',
241             Writable => 1,
242             Protected => 1,
243             Notes => 'this chunk should not be present if an iCCP chunk exists',
244             ValueConv => 'unpack("C",$val)',
245             ValueConvInv => 'pack("C",$val)',
246             PrintConv => {
247             0 => 'Perceptual',
248             1 => 'Relative Colorimetric',
249             2 => 'Saturation',
250             3 => 'Absolute Colorimetric',
251             },
252             },
253             sTER => { # png 1.4.0
254             Name => 'StereoImage',
255             SubDirectory => { TagTable => 'Image::ExifTool::PNG::StereoImage' },
256             },
257             tEXt => {
258             Name => 'TextualData',
259             SubDirectory => { TagTable => 'Image::ExifTool::PNG::TextualData' },
260             },
261             tIME => {
262             Name => 'ModifyDate',
263             Groups => { 2 => 'Time' },
264             Writable => 1,
265             Shift => 'Time',
266             ValueConv => 'sprintf("%.4d:%.2d:%.2d %.2d:%.2d:%.2d", unpack("nC5", $val))',
267             ValueConvInv => q{
268             my @a = ($val=~/^(\d+):(\d+):(\d+)\s+(\d+):(\d+):(\d+)/);
269             @a == 6 or warn('Invalid date'), return undef;
270             return pack('nC5', @a);
271             },
272             PrintConv => '$self->ConvertDateTime($val)',
273             PrintConvInv => '$self->InverseDateTime($val)',
274             },
275             tRNS => {
276             Name => 'Transparency',
277             # may have as many entries as the PLTE table, but who wants to see all that?
278             ValueConv => q{
279             return \$val if length($val) > 6;
280             join(" ",unpack($Image::ExifTool::PNG::colorType == 3 ? "C*" : "n*", $val));
281             },
282             },
283             tXMP => {
284             Name => 'XMP',
285             Notes => 'obsolete location specified by a September 2001 XMP draft',
286             NonStandard => 'XMP',
287             SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' },
288             },
289             vpAg => { # private imagemagick chunk
290             Name => 'VirtualPage',
291             SubDirectory => { TagTable => 'Image::ExifTool::PNG::VirtualPage' },
292             },
293             zTXt => {
294             Name => 'CompressedText',
295             SubDirectory => {
296             TagTable => 'Image::ExifTool::PNG::TextualData',
297             ProcessProc => \&ProcessPNG_Compressed,
298             },
299             },
300             # animated PNG (ref https://wiki.mozilla.org/APNG_Specification)
301             acTL => {
302             Name => 'AnimationControl',
303             SubDirectory => {
304             TagTable => 'Image::ExifTool::PNG::AnimationControl',
305             },
306             },
307             # eXIf (ref 6)
308             $stdCase{exif} => {
309             Name => $stdCase{exif},
310             Notes => 'this is where ExifTool will create new EXIF',
311             SubDirectory => {
312             TagTable => 'Image::ExifTool::Exif::Main',
313             DirName => 'EXIF', # (to write as a block)
314             ProcessProc => \&ProcessPNG_eXIf,
315             },
316             },
317             # zXIf
318             $stdCase{zxif} => {
319             Name => $stdCase{zxif},
320             Notes => 'a once-proposed chunk for compressed EXIF',
321             NonStandard => 'EXIF',
322             SubDirectory => {
323             TagTable => 'Image::ExifTool::Exif::Main',
324             DirName => 'EXIF', # (to write as a block)
325             ProcessProc => \&ProcessPNG_eXIf,
326             },
327             },
328             # fcTL - animation frame control for each frame
329             # fdAT - animation data for each frame
330             iDOT => { # (ref NealKrawetz)
331             Name => 'AppleDataOffsets',
332             Binary => 1,
333             # Apple offsets into data relative to start of iDOT chunk:
334             # int32u Divisor [only ever seen 2]
335             # int32u Unknown [always 0]
336             # int32u TotalDividedHeight [image height from IDHR/Divisor]
337             # int32u Size [always 40 / 0x28; size of this chunk]
338             # int32u DividedHeight1
339             # int32u DividedHeight2
340             # int32u IDAT_Offset2 [location of IDAT with start of DividedHeight2 segment]
341             },
342             );
343              
344             # PNG IHDR chunk
345             %Image::ExifTool::PNG::ImageHeader = (
346             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
347             GROUPS => { 2 => 'Image' },
348             0 => {
349             Name => 'ImageWidth',
350             Format => 'int32u',
351             },
352             4 => {
353             Name => 'ImageHeight',
354             Format => 'int32u',
355             },
356             8 => 'BitDepth',
357             9 => {
358             Name => 'ColorType',
359             RawConv => '$Image::ExifTool::PNG::colorType = $val',
360             PrintConv => {
361             0 => 'Grayscale',
362             2 => 'RGB',
363             3 => 'Palette',
364             4 => 'Grayscale with Alpha',
365             6 => 'RGB with Alpha',
366             },
367             },
368             10 => {
369             Name => 'Compression',
370             PrintConv => { 0 => 'Deflate/Inflate' },
371             },
372             11 => {
373             Name => 'Filter',
374             PrintConv => { 0 => 'Adaptive' },
375             },
376             12 => {
377             Name => 'Interlace',
378             PrintConv => { 0 => 'Noninterlaced', 1 => 'Adam7 Interlace' },
379             },
380             );
381              
382             # PNG cHRM chunk
383             %Image::ExifTool::PNG::PrimaryChromaticities = (
384             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
385             GROUPS => { 2 => 'Image' },
386             FORMAT => 'int32u',
387             0 => { Name => 'WhitePointX', ValueConv => '$val / 100000' },
388             1 => { Name => 'WhitePointY', ValueConv => '$val / 100000' },
389             2 => { Name => 'RedX', ValueConv => '$val / 100000' },
390             3 => { Name => 'RedY', ValueConv => '$val / 100000' },
391             4 => { Name => 'GreenX', ValueConv => '$val / 100000' },
392             5 => { Name => 'GreenY', ValueConv => '$val / 100000' },
393             6 => { Name => 'BlueX', ValueConv => '$val / 100000' },
394             7 => { Name => 'BlueY', ValueConv => '$val / 100000' },
395             );
396              
397             # PNG pHYs chunk
398             %Image::ExifTool::PNG::PhysicalPixel = (
399             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
400             WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
401             WRITABLE => 1,
402             GROUPS => { 1 => 'PNG-pHYs', 2 => 'Image' },
403             WRITE_GROUP => 'PNG-pHYs',
404             NOTES => q{
405             These tags are found in the PNG pHYs chunk and belong to the PNG-pHYs family
406             1 group. They are all created together with default values if necessary
407             when any of these tags is written, and may only be deleted as a group.
408             },
409             0 => {
410             Name => 'PixelsPerUnitX',
411             Format => 'int32u',
412             Notes => 'default 2834',
413             },
414             4 => {
415             Name => 'PixelsPerUnitY',
416             Format => 'int32u',
417             Notes => 'default 2834',
418             },
419             8 => {
420             Name => 'PixelUnits',
421             PrintConv => { 0 => 'Unknown', 1 => 'meters' },
422             Notes => 'default meters',
423             },
424             );
425              
426             # PNG sCAL chunk
427             %Image::ExifTool::PNG::SubjectScale = (
428             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
429             GROUPS => { 2 => 'Image' },
430             0 => {
431             Name => 'SubjectUnits',
432             PrintConv => { 1 => 'meters', 2 => 'radians' },
433             },
434             1 => {
435             Name => 'SubjectPixelWidth',
436             Format => 'var_string',
437             },
438             2 => {
439             Name => 'SubjectPixelHeight',
440             Format => 'var_string',
441             },
442             );
443              
444             # PNG vpAg chunk
445             %Image::ExifTool::PNG::VirtualPage = (
446             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
447             GROUPS => { 2 => 'Image' },
448             FORMAT => 'int32u',
449             0 => 'VirtualImageWidth',
450             1 => 'VirtualImageHeight',
451             2 => {
452             Name => 'VirtualPageUnits',
453             Format => 'int8u',
454             # what is the conversion for this?
455             },
456             );
457              
458             # PNG sTER chunk
459             %Image::ExifTool::PNG::StereoImage = (
460             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
461             GROUPS => { 2 => 'Image' },
462             0 => {
463             Name => 'StereoMode',
464             PrintConv => {
465             0 => 'Cross-fuse Layout',
466             1 => 'Diverging-fuse Layout',
467             },
468             },
469             );
470              
471             my %unreg = ( Notes => 'unregistered' );
472              
473             # Tags for PNG tEXt zTXt and iTXt chunks
474             # (NOTE: ValueConv is set dynamically, so don't set it here!)
475             %Image::ExifTool::PNG::TextualData = (
476             PROCESS_PROC => \&ProcessPNG_tEXt,
477             WRITE_PROC => \&Image::ExifTool::DummyWriteProc,
478             WRITABLE => 'string',
479             PREFERRED => 1, # always add these tags when writing
480             GROUPS => { 2 => 'Image' },
481             LANG_INFO => \&GetLangInfo,
482             NOTES => q{
483             The PNG TextualData format allows arbitrary tag names to be used. The tags
484             listed below are the only ones that can be written (unless new user-defined
485             tags are added via the configuration file), however ExifTool will extract
486             any other TextualData tags that are found. All TextualData tags (including
487             tags not listed below) are removed when deleting all PNG tags.
488              
489             These tags may be stored as tEXt, zTXt or iTXt chunks in the PNG image. By
490             default ExifTool writes new string-value tags as as uncompressed tEXt, or
491             compressed zTXt if the L (-z) option is used and Compress::Zlib is
492             available. Alternate language tags and values containing special characters
493             (unless the Latin character set is used) are written as iTXt, and compressed
494             if the L option is used and Compress::Zlib is available. Raw profile
495             information is always created as compressed zTXt if Compress::Zlib is
496             available, or tEXt otherwise. Standard XMP is written as uncompressed iTXt.
497             User-defined tags may set an 'iTXt' flag in the tag definition to be written
498             only as iTXt.
499              
500             Alternate languages are accessed by suffixing the tag name with a '-',
501             followed by an RFC 3066 language code (eg. "PNG:Comment-fr", or
502             "Title-en-US"). See L for the RFC 3066
503             specification.
504              
505             Some of the tags below are not registered as part of the PNG specification,
506             but are included here because they are generated by other software such as
507             ImageMagick.
508             },
509             Title => { },
510             Author => { Groups => { 2 => 'Author' } },
511             Description => { },
512             Copyright => { Groups => { 2 => 'Author' } },
513             'Creation Time' => {
514             Name => 'CreationTime',
515             Groups => { 2 => 'Time' },
516             Shift => 'Time',
517             Notes => 'stored in RFC-1123 format and converted to/from EXIF format by ExifTool',
518             RawConv => \&ConvertPNGDate,
519             ValueConvInv => \&InversePNGDate,
520             PrintConv => '$self->ConvertDateTime($val)',
521             PrintConvInv => '$self->InverseDateTime($val,undef,1)',
522             },
523             Software => { },
524             Disclaimer => { },
525             # change name to differentiate from ExifTool Warning
526             Warning => { Name => 'PNGWarning', },
527             Source => { },
528             Comment => { },
529             Collection => { }, # (PNG extensions, 2004)
530             #
531             # The following tags are not part of the original PNG specification,
532             # but are written by ImageMagick and other software
533             #
534             Artist => { %unreg, Groups => { 2 => 'Author' } },
535             Document => { %unreg },
536             Label => { %unreg },
537             Make => { %unreg, Groups => { 2 => 'Camera' } },
538             Model => { %unreg, Groups => { 2 => 'Camera' } },
539             'create-date'=> {
540             Name => 'CreateDate',
541             Groups => { 2 => 'Time' },
542             Shift => 'Time',
543             %unreg,
544             ValueConv => 'require Image::ExifTool::XMP; Image::ExifTool::XMP::ConvertXMPDate($val)',
545             ValueConvInv => 'require Image::ExifTool::XMP; Image::ExifTool::XMP::FormatXMPDate($val)',
546             PrintConv => '$self->ConvertDateTime($val)',
547             PrintConvInv => '$self->InverseDateTime($val,undef,1)',
548             },
549             'modify-date'=> {
550             Name => 'ModDate', # (to distinguish from tIME chunk "ModifyDate")
551             Groups => { 2 => 'Time' },
552             Shift => 'Time',
553             %unreg,
554             ValueConv => 'require Image::ExifTool::XMP; Image::ExifTool::XMP::ConvertXMPDate($val)',
555             ValueConvInv => 'require Image::ExifTool::XMP; Image::ExifTool::XMP::FormatXMPDate($val)',
556             PrintConv => '$self->ConvertDateTime($val)',
557             PrintConvInv => '$self->InverseDateTime($val,undef,1)',
558             },
559             TimeStamp => { %unreg, Groups => { 2 => 'Time' }, Shift => 'Time' },
560             URL => { %unreg },
561             'XML:com.adobe.xmp' => {
562             Name => 'XMP',
563             Notes => q{
564             unregistered, but this is the location according to the June 2002 or later
565             XMP specification, and is where ExifTool will add a new XMP chunk if the
566             image didn't already contain XMP
567             },
568             SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' },
569             },
570             'Raw profile type APP1' => [
571             {
572             # EXIF table must come first because we key on this in ProcessProfile()
573             # (No condition because this is just for BuildTagLookup)
574             Name => 'APP1_Profile',
575             %unreg,
576             NonStandard => 'EXIF',
577             SubDirectory => {
578             TagTable => 'Image::ExifTool::Exif::Main',
579             ProcessProc => \&ProcessProfile,
580             },
581             },
582             {
583             Name => 'APP1_Profile',
584             NonStandard => 'XMP',
585             SubDirectory => {
586             TagTable => 'Image::ExifTool::XMP::Main',
587             ProcessProc => \&ProcessProfile,
588             },
589             },
590             ],
591             'Raw profile type exif' => {
592             Name => 'EXIF_Profile',
593             %unreg,
594             NonStandard => 'EXIF',
595             SubDirectory => {
596             TagTable => 'Image::ExifTool::Exif::Main',
597             ProcessProc => \&ProcessProfile,
598             },
599             },
600             'Raw profile type icc' => {
601             Name => 'ICC_Profile',
602             %unreg,
603             SubDirectory => {
604             TagTable => 'Image::ExifTool::ICC_Profile::Main',
605             ProcessProc => \&ProcessProfile,
606             },
607             },
608             'Raw profile type icm' => {
609             Name => 'ICC_Profile',
610             %unreg,
611             SubDirectory => {
612             TagTable => 'Image::ExifTool::ICC_Profile::Main',
613             ProcessProc => \&ProcessProfile,
614             },
615             },
616             'Raw profile type iptc' => {
617             Name => 'IPTC_Profile',
618             Notes => q{
619             unregistered. May be either IPTC IIM or Photoshop IRB format. This is
620             where ExifTool will add new IPTC, inside a Photoshop IRB container
621             },
622             SubDirectory => {
623             TagTable => 'Image::ExifTool::Photoshop::Main',
624             ProcessProc => \&ProcessProfile,
625             },
626             },
627             'Raw profile type xmp' => {
628             Name => 'XMP_Profile',
629             %unreg,
630             NonStandard => 'XMP',
631             SubDirectory => {
632             TagTable => 'Image::ExifTool::XMP::Main',
633             ProcessProc => \&ProcessProfile,
634             },
635             },
636             'Raw profile type 8bim' => {
637             Name => 'Photoshop_Profile',
638             %unreg,
639             SubDirectory => {
640             TagTable => 'Image::ExifTool::Photoshop::Main',
641             ProcessProc => \&ProcessProfile,
642             },
643             },
644             );
645              
646             # Animation control
647             %Image::ExifTool::PNG::AnimationControl = (
648             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
649             GROUPS => { 2 => 'Image' },
650             FORMAT => 'int32u',
651             NOTES => q{
652             Tags found in the Animation Control chunk. See
653             L for details.
654             },
655             0 => {
656             Name => 'AnimationFrames',
657             RawConv => '$self->OverrideFileType("APNG", undef, "PNG"); $val',
658             },
659             1 => {
660             Name => 'AnimationPlays',
661             PrintConv => '$val || "inf"',
662             },
663             );
664              
665             #------------------------------------------------------------------------------
666             # AutoLoad our writer routines when necessary
667             #
668             sub AUTOLOAD
669             {
670 1     1   4 return Image::ExifTool::DoAutoLoad($AUTOLOAD, @_);
671             }
672              
673             #------------------------------------------------------------------------------
674             # Get standard case for language code (this routine copied from XMP.pm)
675             # Inputs: 0) Language code
676             # Returns: Language code in standard case
677             sub StandardLangCase($)
678             {
679 24     24 0 36 my $lang = shift;
680             # make 2nd subtag uppercase only if it is 2 letters
681 24 100       122 return lc($1) . uc($2) . lc($3) if $lang =~ /^([a-z]{2,3}|[xi])(-[a-z]{2})\b(.*)/i;
682 11         38 return lc($lang);
683             }
684              
685             #------------------------------------------------------------------------------
686             # Convert date from PNG to EXIF format
687             # Inputs: 0) Date/time in PNG format, 1) ExifTool ref
688             # Returns: EXIF formatted date/time string
689             my %monthNum = (
690             Jan=>1, Feb=>2, Mar=>3, Apr=>4, May=>5, Jun=>6,
691             Jul=>7, Aug=>8, Sep=>9, Oct=>10,Nov=>11,Dec=>12
692             );
693             my %tzConv = (
694             UT => '+00:00', GMT => '+00:00', UTC => '+00:00', # (UTC not in spec -- PH addition)
695             EST => '-05:00', EDT => '-04:00',
696             CST => '-06:00', CDT => '-05:00',
697             MST => '-07:00', MDT => '-06:00',
698             PST => '-08:00', PDT => '-07:00',
699             A => '-01:00', N => '+01:00',
700             B => '-02:00', O => '+02:00',
701             C => '-03:00', P => '+03:00',
702             D => '-04:00', Q => '+04:00',
703             E => '-05:00', R => '+05:00',
704             F => '-06:00', S => '+06:00',
705             G => '-07:00', T => '+07:00',
706             H => '-08:00', U => '+08:00',
707             I => '-09:00', V => '+09:00',
708             K => '-10:00', W => '+10:00',
709             L => '-11:00', X => '+11:00',
710             M => '-12:00', Y => '+12:00',
711             Z => '+00:00',
712             );
713             sub ConvertPNGDate($$)
714             {
715 0     0 0 0 my ($val, $et) = @_;
716             # standard format is like "Mon, 1 Jan 2018 12:10:22 EST" (RFC-1123 section 5.2.14)
717 0         0 while ($val =~ /(\d+)\s*(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)\s*(\d+)\s+(\d+):(\d{2})(:\d{2})?\s*(\S*)/i) {
718 0         0 my ($day,$mon,$yr,$hr,$min,$sec,$tz) = ($1,$2,$3,$4,$5,$6,$7);
719 0 0       0 $yr += $yr > 70 ? 1900 : 2000 if $yr < 100; # boost year to 4 digits if necessary
    0          
720 0 0       0 $mon = $monthNum{ucfirst lc $mon} or return $val;
721 0 0       0 if (not $tz) {
    0          
    0          
722 0         0 $tz = '';
723             } elsif ($tzConv{uc $tz}) {
724 0         0 $tz = $tzConv{uc $tz};
725             } elsif ($tz =~ /^([-+]\d+):?(\d{2})/) {
726 0         0 $tz = $1 . ':' . $2;
727             } else {
728 0         0 last; # (non-standard date)
729             }
730 0   0     0 return sprintf("%.4d:%.2d:%.2d %.2d:%.2d%s%s",$yr,$mon,$day,$hr,$min,$sec||':00',$tz);
731             }
732 0 0 0     0 if (($et->Options('StrictDate') and not $$et{TAGS_FROM_FILE}) or $et->Options('Validate')) {
      0        
733 0         0 $et->Warn('Non standard PNG date/time format', 1);
734             }
735 0         0 return $val;
736             }
737              
738             #------------------------------------------------------------------------------
739             # Convert EXIF date/time to PNG format
740             # Inputs: 0) Date/time in EXIF format, 1) ExifTool ref
741             # Returns: PNG formatted date/time string
742             sub InversePNGDate($$)
743             {
744 0     0 0 0 my ($val, $et) = @_;
745 0 0       0 if ($et->Options('StrictDate')) {
746 0         0 my $err;
747 0 0       0 if ($val =~ /^(\d{4}):(\d{2}):(\d{2}) (\d{2})(:\d{2})(:\d{2})?(?:\.\d*)?\s*(\S*)/) {
748 0         0 my ($yr,$mon,$day,$hr,$min,$sec,$tz) = ($1,$2,$3,$4,$5,$6,$7);
749 0 0       0 $sec or $sec = '';
750 0         0 my %monName = map { $monthNum{$_} => $_ } keys %monthNum;
  0         0  
751 0 0       0 $mon = $monName{$mon + 0} or $err = 1;
752 0 0       0 if (length $tz) {
753 0 0       0 $tz =~ /^(Z|[-+]\d{2}:?\d{2})/ or $err = 1;
754 0         0 $tz =~ tr/://d;
755 0         0 $tz = ' ' . $tz;
756             }
757 0 0       0 $val = "$day $mon $yr $hr$min$sec$tz" unless $err;
758             }
759 0 0       0 if ($err) {
760 0         0 warn "Invalid date/time (use YYYY:mm:dd HH:MM:SS[.ss][+/-HH:MM|Z])\n";
761 0         0 undef $val;
762             }
763             }
764 0         0 return $val;
765             }
766              
767             #------------------------------------------------------------------------------
768             # Get localized version of tagInfo hash
769             # Inputs: 0) tagInfo hash ref, 1) language code (eg. "x-default")
770             # Returns: new tagInfo hash ref, or undef if invalid
771             sub GetLangInfo($$)
772             {
773 23     23 0 44 my ($tagInfo, $lang) = @_;
774 23         39 $lang =~ tr/_/-/; # RFC 3066 specifies '-' as a separator
775             # no alternate languages for XMP or raw profile directories
776 23 50       54 return undef if $$tagInfo{SubDirectory};
777             # language code must normalized for use in tag ID
778 23         54 return Image::ExifTool::GetLangInfo($tagInfo, StandardLangCase($lang));
779             }
780              
781             #------------------------------------------------------------------------------
782             # Found a PNG tag -- extract info from subdirectory or decompress data if necessary
783             # Inputs: 0) ExifTool object reference, 1) Pointer to tag table,
784             # 2) Tag ID, 3) Tag value, 4) [optional] compressed data flag:
785             # 0=not compressed, 1=unknown compression, 2-N=compression with type N-2
786             # 5) optional output buffer ref, 6) character encoding (tEXt/zTXt/iTXt only)
787             # 6) optional language code
788             # Returns: 1 on success
789             sub FoundPNG($$$$;$$$$)
790             {
791 100     100 0 221 my ($et, $tagTablePtr, $tag, $val, $compressed, $outBuff, $enc, $lang) = @_;
792 100 50       193 return 0 unless defined $val;
793 100         221 my $verbose = $et->Options('Verbose');
794 100         128 my $id = $tag; # generate tag ID which includes language code
795 100 100       159 if ($lang) {
796             # case of language code must be normalized since they are case insensitive
797 1         4 $lang = StandardLangCase($lang);
798 1         2 $id .= '-' . $lang;
799             }
800 100   66     198 my $tagInfo = $et->GetTagInfo($tagTablePtr, $id) ||
801             # (some software forgets to capitalize first letter)
802             $et->GetTagInfo($tagTablePtr, ucfirst($id));
803             # create alternate language tag if necessary
804 100 50 33     203 if (not $tagInfo and $lang) {
805 0   0     0 $tagInfo = $et->GetTagInfo($tagTablePtr, $tag) ||
806             $et->GetTagInfo($tagTablePtr, ucfirst($tag));
807 0 0       0 $tagInfo = GetLangInfo($tagInfo, $lang) if $tagInfo;
808             }
809             #
810             # uncompress data if necessary
811             #
812 100         126 my ($wasCompressed, $deflateErr);
813 100 100 66     179 if ($compressed and $compressed > 1) {
814 2 50       7 if ($compressed == 2) { # Inflate/Deflate compression
815 2 50       5 if (eval { require Compress::Zlib }) {
  2 0       12  
816 2         5 my ($v2, $stat);
817 2         6 my $inflate = Compress::Zlib::inflateInit();
818 2 50       208 $inflate and ($v2, $stat) = $inflate->inflate($val);
819 2 50 33     84 if ($inflate and $stat == Compress::Zlib::Z_STREAM_END()) {
820 2         35 $val = $v2;
821 2         3 $compressed = 0;
822 2         11 $wasCompressed = 1;
823             } else {
824 0         0 $deflateErr = "Error inflating $tag";
825             }
826             } elsif (not $noCompressLib) {
827 0         0 $deflateErr = "Install Compress::Zlib to read compressed information";
828             } else {
829 0         0 $deflateErr = ''; # flag deflate error but no warning
830             }
831             } else {
832 0         0 $compressed -= 2;
833 0         0 $deflateErr = "Unknown compression method $compressed for $tag";
834             }
835 2 0 33     8 if ($compressed and $verbose and $tagInfo and $$tagInfo{SubDirectory}) {
      33        
      0        
836 0         0 $et->VerboseDir("Unable to decompress $$tagInfo{Name}", 0, length($val));
837             }
838             # issue warning if relevant
839 2 50 33     6 if ($deflateErr and not $outBuff) {
840 0         0 $et->Warn($deflateErr);
841 0 0       0 $noCompressLib = 1 if $deflateErr =~ /^Install/;
842             }
843             }
844             # translate character encoding if necessary (tEXt/zTXt/iTXt string values only)
845 100 100 66     297 if ($enc and not $compressed and not ($tagInfo and $$tagInfo{SubDirectory})) {
      66        
      100        
846 22         59 $val = $et->Decode($val, $enc);
847             }
848             #
849             # extract information from subdirectory if available
850             #
851 100 50       159 if ($tagInfo) {
    0          
852 100         155 my $tagName = $$tagInfo{Name};
853 100         120 my $processed;
854 100 100       168 if ($$tagInfo{SubDirectory}) {
855 64 0 33     123 if ($$et{OPTIONS}{Validate} and $$tagInfo{NonStandard}) {
856 0         0 $et->WarnOnce("Non-standard $$tagInfo{NonStandard} in PNG $tag chunk", 1);
857             }
858 64         81 my $subdir = $$tagInfo{SubDirectory};
859 64   66     159 my $dirName = $$subdir{DirName} || $tagName;
860 64 50       93 if (not $compressed) {
    0          
861 64         82 my $len = length $val;
862 64 50 66     123 if ($verbose and $$et{INDENT} ne ' ') {
863 0 0 0     0 if ($wasCompressed and $verbose > 2) {
864 0         0 my $name = $tagName;
865 0 0       0 $wasCompressed and $name = "Decompressed $name";
866 0         0 $et->VerboseDir($name, 0, $len);
867 0         0 $et->VerboseDump(\$val);
868             }
869             # don't indent next directory (since it is really the same data)
870 0         0 $$et{INDENT} =~ s/..$//;
871             }
872 64         82 my $processProc = $$subdir{ProcessProc};
873             # nothing more to do if writing and subdirectory is not writable
874 64         153 my $subTable = GetTagTable($$subdir{TagTable});
875 64 100 100     158 return 1 if $outBuff and not $$subTable{WRITE_PROC};
876 59   66     138 my $dirName = $$subdir{DirName} || $tagName;
877 59         265 my %subdirInfo = (
878             DataPt => \$val,
879             DirStart => 0,
880             DataLen => $len,
881             DirLen => $len,
882             DirName => $dirName,
883             TagInfo => $tagInfo,
884             ReadOnly => 1, # (used only by WriteXMP)
885             OutBuff => $outBuff,
886             );
887             # no need to re-decompress if already done
888 59 100 66     137 undef $processProc if $wasCompressed and $processProc and $processProc eq \&ProcessPNG_Compressed;
      100        
889             # rewrite this directory if necessary (but always process TextualData normally)
890 59 100 100     161 if ($outBuff and not $processProc and $subTable ne \%Image::ExifTool::PNG::TextualData) {
      100        
891 5 100       25 return 1 unless $$et{EDIT_DIRS}{$dirName};
892 3         13 $$outBuff = $et->WriteDirectory(\%subdirInfo, $subTable);
893 3 50 33     16 if ($tagName eq 'XMP' and $$outBuff) {
894             # make sure the XMP is marked as read-only
895 3         10 Image::ExifTool::XMP::ValidateXMP($outBuff,'r');
896             }
897 3         13 DoneDir($et, $dirName, $outBuff, $$tagInfo{NonStandard});
898             } else {
899 54         129 $processed = $et->ProcessDirectory(\%subdirInfo, $subTable, $processProc);
900             }
901 57         166 $compressed = 1; # pretend this is compressed since it is binary data
902             } elsif ($outBuff) {
903 0 0 0     0 if ($$et{DEL_GROUP}{$dirName} or ($dirName eq 'EXIF' and $$et{DEL_GROUP}{IFD0})) {
      0        
904 0         0 $$outBuff = '';
905 0         0 ++$$et{CHANGED};
906 0         0 $et->VPrint(0, " Deleting $tag chunk");
907             } else {
908 0 0 0     0 if ($$et{EDIT_DIRS}{$dirName} or ($dirName eq 'EXIF' and $$et{EDIT_DIRS}{IFD0})) {
      0        
909 0         0 $et->Warn("Can't write $dirName. Requires Compress::Zlib");
910             }
911             # pretend we did this directory so we don't try to recreate it
912 0         0 DoneDir($et, $dirName, $outBuff, $$tagInfo{NonStandard});
913             }
914             }
915             }
916 93 100       156 if ($outBuff) {
917 23         35 my $writable = $$tagInfo{Writable};
918 23         27 my $isOverwriting;
919 23 100 66     101 if ($writable or ($$tagTablePtr{WRITABLE} and
      100        
      66        
920             not defined $writable and not $$tagInfo{SubDirectory}))
921             {
922             # write new value for this tag if necessary
923 5         7 my $newVal;
924 5 100       12 if ($$et{DEL_GROUP}{PNG}){
925             # remove this tag now, but keep in ADD_PNG list to add back later
926 1         2 $isOverwriting = 1;
927             } else {
928             # remove this from the list of PNG tags to add
929 4         8 delete $$et{ADD_PNG}{$id};
930             # (also handle case of tEXt tags written with lowercase first letter)
931 4         11 delete $$et{ADD_PNG}{ucfirst($id)};
932 4         13 my $nvHash = $et->GetNewValueHash($tagInfo);
933 4         12 $isOverwriting = $et->IsOverwriting($nvHash);
934 4 50       18 if (defined $deflateErr) {
935 0         0 $newVal = $et->GetNewValue($nvHash);
936             # can only write tag now if always overwriting
937 0 0       0 if ($isOverwriting > 0) {
    0          
938 0         0 $val = '';
939             } elsif ($isOverwriting) {
940 0         0 $isOverwriting = 0; # can't overwrite
941 0 0       0 $et->Warn($deflateErr) if $deflateErr;
942             }
943             } else {
944 4 50       11 if ($isOverwriting < 0) {
945 0         0 $isOverwriting = $et->IsOverwriting($nvHash, $val);
946             }
947             # (must get new value after IsOverwriting() in case it was shifted)
948 4         11 $newVal = $et->GetNewValue($nvHash);
949             }
950             }
951 5 100       15 if ($isOverwriting) {
952 2 50       7 $$outBuff = (defined $newVal) ? $newVal : '';
953 2         4 ++$$et{CHANGED};
954 2         12 $et->VerboseValue("- PNG:$tagName", $val);
955 2 50       7 $et->VerboseValue("+ PNG:$tagName", $newVal) if defined $newVal;
956             }
957             }
958 23 100 100     61 if (defined $$outBuff and length $$outBuff) {
959 6 100       18 if ($enc) { # must be tEXt/zTXt/iTXt if $enc is set
    50          
960 3         12 $$outBuff = BuildTextChunk($et, $tag, $tagInfo, $$outBuff, $lang);
961             } elsif ($wasCompressed) {
962             # re-compress the output data
963 0         0 my $len = length $$outBuff;
964 0         0 my $deflate = Compress::Zlib::deflateInit();
965 0 0       0 if ($deflate) {
966 0         0 $$outBuff = $deflate->deflate($$outBuff);
967 0 0       0 $$outBuff .= $deflate->flush() if defined $$outBuff;
968             } else {
969 0         0 undef $$outBuff;
970             }
971 0 0       0 if (not $$outBuff) {
    0          
972 0         0 $et->Warn("PNG:$tagName not written (compress error)");
973             } elsif (lc $tag eq 'zxif') {
974 0         0 $$outBuff = "\0" . pack('N',$len) . $$outBuff; # add zXIf header
975             }
976             }
977             }
978 23         58 return 1;
979             }
980 70 100       158 return 1 if $processed;
981             } elsif ($outBuff) {
982 0 0 0     0 if ($$et{DEL_GROUP}{PNG} and $tagTablePtr eq \%Image::ExifTool::PNG::TextualData) {
983             # delete all TextualData tags if deleting the PNG group
984 0         0 $$outBuff = '';
985 0         0 ++$$et{CHANGED};
986 0         0 $et->VerboseValue("- PNG:$tag", $val);
987             }
988 0         0 return 1;
989             } else {
990 0         0 my $name;
991 0         0 ($name = $tag) =~ s/\s+(.)/\u$1/g; # remove white space from tag name
992 0         0 $tagInfo = { Name => $name };
993 0 0       0 $$tagInfo{LangCode} = $lang if $lang;
994             # make unknown profiles binary data type
995 0 0       0 $$tagInfo{Binary} = 1 if $tag =~ /^Raw profile type /;
996 0 0       0 $verbose and $et->VPrint(0, " [adding $tag]\n");
997 0         0 AddTagToTable($tagTablePtr, $tag, $tagInfo);
998             }
999             #
1000             # store this tag information
1001             #
1002 26 50       48 if ($verbose) {
1003             # temporarily remove subdirectory so it isn't printed in verbose information
1004             # since we aren't decoding it anyway;
1005 0         0 my $subdir = $$tagInfo{SubDirectory};
1006 0         0 delete $$tagInfo{SubDirectory};
1007 0         0 $et->VerboseInfo($tag, $tagInfo,
1008             Table => $tagTablePtr,
1009             DataPt => \$val,
1010             );
1011 0 0       0 $$tagInfo{SubDirectory} = $subdir if $subdir;
1012             }
1013             # set the RawConv dynamically depending on whether this is binary or not
1014 26         31 my $delRawConv;
1015 26 50 33     55 if ($compressed and not defined $$tagInfo{ValueConv}) {
1016 0         0 $$tagInfo{RawConv} = '\$val';
1017 0         0 $delRawConv = 1;
1018             }
1019 26         70 $et->FoundTag($tagInfo, $val);
1020 26 50       45 delete $$tagInfo{RawConv} if $delRawConv;
1021 26         57 return 1;
1022             }
1023              
1024             #------------------------------------------------------------------------------
1025             # Process encoded PNG profile information
1026             # Inputs: 0) ExifTool object reference, 1) DirInfo reference, 2) Pointer to tag table
1027             # Returns: 1 on success
1028             sub ProcessProfile($$$)
1029             {
1030 1     1 0 3 my ($et, $dirInfo, $tagTablePtr) = @_;
1031 1         3 my $dataPt = $$dirInfo{DataPt};
1032 1         2 my $tagInfo = $$dirInfo{TagInfo};
1033 1         3 my $outBuff = $$dirInfo{OutBuff};
1034 1         2 my $tagName = $$tagInfo{Name};
1035              
1036             # ImageMagick 5.3.6 writes profiles with the following headers:
1037             # "\nICC Profile\n", "\nIPTC profile\n", "\n\xaa\x01{generic prof\n"
1038             # and "\ngeneric profile\n"
1039 1 50       8 return 0 unless $$dataPt =~ /^\n(.*?)\n\s*(\d+)\n(.*)/s;
1040 1         4 my ($profileType, $len) = ($1, $2);
1041             # data is encoded in hex, so change back to binary
1042 1         15 my $buff = pack('H*', join('',split(' ',$3)));
1043 1         3 my $actualLen = length $buff;
1044 1 50       3 if ($len ne $actualLen) {
1045 0         0 $et->Warn("$tagName is wrong size (should be $len bytes but is $actualLen)");
1046 0         0 $len = $actualLen;
1047             }
1048 1         4 my $verbose = $et->Options('Verbose');
1049 1 50       3 if ($verbose) {
1050 0 0       0 if ($verbose > 2) {
1051 0         0 $et->VerboseDir("Decoded $tagName", 0, $len);
1052 0         0 $et->VerboseDump(\$buff);
1053             }
1054             # don't indent next directory (since it is really the same data)
1055 0         0 $$et{INDENT} =~ s/..$//;
1056             }
1057 1         7 my %dirInfo = (
1058             Parent => 'PNG',
1059             DataPt => \$buff,
1060             DataLen => $len,
1061             DirStart => 0,
1062             DirLen => $len,
1063             Base => 0,
1064             OutFile => $outBuff,
1065             );
1066 1         3 $$et{PROCESSED} = { }; # reset processed directory offsets
1067 1         2 my $processed = 0;
1068 1         2 my $oldChanged = $$et{CHANGED};
1069 1         4 my $exifTable = GetTagTable('Image::ExifTool::Exif::Main');
1070 1         3 my $editDirs = $$et{EDIT_DIRS};
1071              
1072 1 50       4 if ($tagTablePtr ne $exifTable) {
    0          
    0          
    0          
1073             # this is unfortunate, but the "IPTC" profile may be stored as either
1074             # IPTC IIM or a Photoshop IRB resource, so we must test for this
1075 1 50 33     8 if ($tagName eq 'IPTC_Profile' and $buff =~ /^\x1c/) {
1076 0         0 $tagTablePtr = GetTagTable('Image::ExifTool::IPTC::Main');
1077             }
1078             # process non-EXIF and non-APP1 profile as-is
1079 1 50       3 if ($outBuff) {
1080             # no need to rewrite this if not editing tags in this directory
1081 0         0 my $dir = $tagName;
1082 0 0       0 $dir =~ s/_Profile// unless $dir =~ /^ICC/;
1083 0 0       0 return 1 unless $$editDirs{$dir};
1084 0         0 $$outBuff = $et->WriteDirectory(\%dirInfo, $tagTablePtr);
1085 0         0 DoneDir($et, $dir, $outBuff, $$tagInfo{NonStandard});
1086             } else {
1087 1         5 $processed = $et->ProcessDirectory(\%dirInfo, $tagTablePtr);
1088             }
1089             } elsif ($buff =~ /^$Image::ExifTool::exifAPP1hdr/) {
1090             # APP1 EXIF information
1091 0 0 0     0 return 1 if $outBuff and not $$editDirs{IFD0};
1092 0         0 my $hdrLen = length($Image::ExifTool::exifAPP1hdr);
1093 0         0 $dirInfo{DirStart} += $hdrLen;
1094 0         0 $dirInfo{DirLen} -= $hdrLen;
1095 0 0       0 if ($outBuff) {
1096             # delete non-standard EXIF if recreating from scratch
1097 0 0 0     0 if ($$et{DEL_GROUP}{EXIF} or $$et{DEL_GROUP}{IFD0}) {
1098 0         0 $$outBuff = '';
1099 0         0 $et->VPrint(0, ' Deleting non-standard APP1 EXIF information');
1100 0         0 return 1;
1101             }
1102 0         0 $$outBuff = $et->WriteDirectory(\%dirInfo, $tagTablePtr,
1103             \&Image::ExifTool::WriteTIFF);
1104 0 0       0 $$outBuff = $Image::ExifTool::exifAPP1hdr . $$outBuff if $$outBuff;
1105 0         0 DoneDir($et, 'IFD0', $outBuff, $$tagInfo{NonStandard});
1106             } else {
1107 0         0 $processed = $et->ProcessTIFF(\%dirInfo);
1108             }
1109             } elsif ($buff =~ /^$Image::ExifTool::xmpAPP1hdr/) {
1110             # APP1 XMP information
1111 0         0 my $hdrLen = length($Image::ExifTool::xmpAPP1hdr);
1112 0         0 my $tagTablePtr = GetTagTable('Image::ExifTool::XMP::Main');
1113 0         0 $dirInfo{DirStart} += $hdrLen;
1114 0         0 $dirInfo{DirLen} -= $hdrLen;
1115 0 0       0 if ($outBuff) {
1116 0 0       0 return 1 unless $$editDirs{XMP};
1117 0         0 $$outBuff = $et->WriteDirectory(\%dirInfo, $tagTablePtr);
1118 0 0       0 $$outBuff and $$outBuff = $Image::ExifTool::xmpAPP1hdr . $$outBuff;
1119 0         0 DoneDir($et, 'XMP', $outBuff, $$tagInfo{NonStandard});
1120             } else {
1121 0         0 $processed = $et->ProcessDirectory(\%dirInfo, $tagTablePtr);
1122             }
1123             } elsif ($buff =~ /^(MM\0\x2a|II\x2a\0)/) {
1124             # TIFF information
1125 0 0 0     0 return 1 if $outBuff and not $$editDirs{IFD0};
1126 0 0       0 if ($outBuff) {
1127             # delete non-standard EXIF if recreating from scratch
1128 0 0 0     0 if ($$et{DEL_GROUP}{EXIF} or $$et{DEL_GROUP}{IFD0}) {
1129 0         0 $$outBuff = '';
1130 0         0 $et->VPrint(0, ' Deleting non-standard EXIF/TIFF information');
1131 0         0 return 1;
1132             }
1133 0         0 $$outBuff = $et->WriteDirectory(\%dirInfo, $tagTablePtr,
1134             \&Image::ExifTool::WriteTIFF);
1135 0         0 DoneDir($et, 'IFD0', $outBuff, $$tagInfo{NonStandard});
1136             } else {
1137 0         0 $processed = $et->ProcessTIFF(\%dirInfo);
1138             }
1139             } else {
1140 0         0 my $profName = $profileType;
1141 0         0 $profName =~ tr/\x00-\x1f\x7f-\xff/./;
1142 0         0 $et->Warn("Unknown raw profile '${profName}'");
1143             }
1144 1 0 33     5 if ($outBuff and defined $$outBuff and length $$outBuff) {
      33        
1145 0 0       0 if ($$et{CHANGED} != $oldChanged) {
1146 0         0 my $hdr = sprintf("\n%s\n%8d\n", $profileType, length($$outBuff));
1147             # hex encode the data
1148 0         0 $$outBuff = $hdr . HexEncode($outBuff);
1149             } else {
1150 0         0 undef $$outBuff;
1151             }
1152             }
1153 1         4 return $processed;
1154             }
1155              
1156             #------------------------------------------------------------------------------
1157             # Process PNG compressed zTXt or iCCP chunk
1158             # Inputs: 0) ExifTool object reference, 1) DirInfo reference, 2) Pointer to tag table
1159             # Returns: 1 on success
1160             # Notes: writes new chunk data to ${$$dirInfo{OutBuff}} if writing tag
1161             sub ProcessPNG_Compressed($$$)
1162             {
1163 2     2 0 4 my ($et, $dirInfo, $tagTablePtr) = @_;
1164 2         4 my ($tag, $val) = split /\0/, ${$$dirInfo{DataPt}}, 2;
  2         10  
1165 2 50       8 return 0 unless defined $val;
1166             # set compressed to 2 + compression method to decompress the data
1167 2         7 my $compressed = 2 + unpack('C', $val);
1168 2         9 my $hdr = $tag . "\0" . substr($val, 0, 1);
1169 2         5 $val = substr($val, 1); # remove compression method byte
1170 2         3 my $success;
1171 2         4 my $outBuff = $$dirInfo{OutBuff};
1172 2         3 my $tagInfo = $$dirInfo{TagInfo};
1173             # use the PNG chunk tag instead of the embedded tag name for iCCP chunks
1174 2 100 66     10 if ($tagInfo and $$tagInfo{Name} eq 'ICC_Profile') {
1175 1         5 $et->VerboseDir('iCCP');
1176 1         2 $tagTablePtr = \%Image::ExifTool::PNG::Main;
1177 1 50 33     9 FoundPNG($et, $tagTablePtr, 'iCCP-name', $tag) if length($tag) and not $outBuff;
1178 1         3 $success = FoundPNG($et, $tagTablePtr, 'iCCP', $val, $compressed, $outBuff);
1179 1 50 33     6 if ($outBuff and $$outBuff) {
1180 0         0 my $profileName = $et->GetNewValue($Image::ExifTool::PNG::Main{'iCCP-name'});
1181 0 0       0 if (defined $profileName) {
1182 0         0 $hdr = $profileName . substr($hdr, length $tag);
1183 0         0 $et->VerboseValue("+ PNG:ProfileName", $profileName);
1184             }
1185 0         0 $$outBuff = $hdr . $$outBuff;
1186             }
1187             } else {
1188 1         3 $success = FoundPNG($et, $tagTablePtr, $tag, $val, $compressed, $outBuff, 'Latin');
1189             }
1190 2         6 return $success;
1191             }
1192              
1193             #------------------------------------------------------------------------------
1194             # Process PNG tEXt chunk
1195             # Inputs: 0) ExifTool object reference, 1) DirInfo reference, 2) Pointer to tag table
1196             # Returns: 1 on success
1197             # Notes: writes new chunk data to ${$$dirInfo{OutBuff}} if writing tag
1198             sub ProcessPNG_tEXt($$$)
1199             {
1200 21     21 0 36 my ($et, $dirInfo, $tagTablePtr) = @_;
1201 21         28 my ($tag, $val) = split /\0/, ${$$dirInfo{DataPt}}, 2;
  21         69  
1202 21         39 my $outBuff = $$dirInfo{OutBuff};
1203 21 100       44 $$et{INDENT} = substr($$et{INDENT}, 0, -2) if $$et{OPTIONS}{Verbose};
1204 21         76 return FoundPNG($et, $tagTablePtr, $tag, $val, undef, $outBuff, 'Latin');
1205             }
1206              
1207             #------------------------------------------------------------------------------
1208             # Process PNG iTXt chunk
1209             # Inputs: 0) ExifTool object reference, 1) DirInfo reference, 2) Pointer to tag table
1210             # Returns: 1 on success
1211             # Notes: writes new chunk data to ${$$dirInfo{OutBuff}} if writing tag
1212             sub ProcessPNG_iTXt($$$)
1213             {
1214 12     12 0 26 my ($et, $dirInfo, $tagTablePtr) = @_;
1215 12         14 my ($tag, $dat) = split /\0/, ${$$dirInfo{DataPt}}, 2;
  12         53  
1216 12 50 33     48 return 0 unless defined $dat and length($dat) >= 4;
1217 12         33 my ($compressed, $meth) = unpack('CC', $dat);
1218 12         57 my ($lang, $trans, $val) = split /\0/, substr($dat, 2), 3;
1219             # set compressed flag so we will decompress it in FoundPNG()
1220 12 50       26 $compressed and $compressed = 2 + $meth;
1221 12         20 my $outBuff = $$dirInfo{OutBuff};
1222 12 100       30 $$et{INDENT} = substr($$et{INDENT}, 0, -2) if $$et{OPTIONS}{Verbose};
1223 12         30 return FoundPNG($et, $tagTablePtr, $tag, $val, $compressed, $outBuff, 'UTF8', $lang);
1224             }
1225              
1226             #------------------------------------------------------------------------------
1227             # Process PNG eXIf/zXIf chunk
1228             # Inputs: 0) ExifTool object reference, 1) DirInfo reference, 2) Pointer to tag table
1229             # Returns: 1 on success
1230             # Notes: writes new chunk data to ${$$dirInfo{OutBuff}} if writing tag
1231             sub ProcessPNG_eXIf($$$)
1232             {
1233 2     2 0 5 my ($et, $dirInfo, $tagTablePtr) = @_;
1234 2         4 my $outBuff = $$dirInfo{OutBuff};
1235 2         4 my $dataPt = $$dirInfo{DataPt};
1236 2         5 my $tagInfo = $$dirInfo{TagInfo};
1237 2         4 my $tag = $$tagInfo{TagID};
1238 2   33     5 my $del = $outBuff && ($$et{DEL_GROUP}{EXIF} or $$et{DEL_GROUP}{IFD0});
1239 2         4 my $type;
1240              
1241 2 50       7 if ($$dataPt =~ /^Exif\0\0/) {
1242 0         0 $et->Warn('Improper "Exif00" header in EXIF chunk');
1243 0         0 $$dataPt = substr($$dataPt, 6);
1244 0         0 $$dirInfo{DataLen} = length $$dataPt;
1245 0 0       0 $$dirInfo{DirLen} -= 6 if $$dirInfo{DirLen};
1246             }
1247 2 50       12 if ($$dataPt =~ /^(\0|II|MM)/) {
    0          
1248 2         7 $type = $1;
1249             } elsif ($del) {
1250 0         0 $et->VPrint(0, " Deleting invalid $tag chunk");
1251 0         0 $$outBuff = '';
1252 0         0 ++$$et{CHANGED};
1253 0         0 return 1;
1254             } else {
1255 0         0 $et->Warn("Invalid $tag chunk");
1256 0         0 return 0;
1257             }
1258 2 50 0     7 if ($type eq "\0") { # is this compressed EXIF?
    50          
    0          
    0          
1259 0         0 my $buf = substr($$dataPt, 5);
1260             # go around again to uncompress the data
1261 0         0 $tagTablePtr = GetTagTable('Image::ExifTool::PNG::Main');
1262 0         0 return FoundPNG($et, $tagTablePtr, $$tagInfo{TagID}, \$buf, 2, $outBuff);
1263             } elsif (not $outBuff) {
1264 2         8 return $et->ProcessTIFF($dirInfo);
1265             # (zxIf was not adopted)
1266             #} elsif ($del and ($et->Options('Compress') xor lc($tag) eq 'zxif')) {
1267             } elsif ($del and lc($tag) eq 'zxif') {
1268 0         0 $et->VPrint(0, " Deleting $tag chunk");
1269 0         0 $$outBuff = '';
1270 0         0 ++$$et{CHANGED};
1271             } elsif ($$et{EDIT_DIRS}{IFD0}) {
1272 0         0 $$outBuff = $et->WriteDirectory($dirInfo, $tagTablePtr,
1273             \&Image::ExifTool::WriteTIFF);
1274 0         0 DoneDir($et, 'IFD0', $outBuff, $$tagInfo{NonStandard});
1275             }
1276 0         0 return 1;
1277             }
1278              
1279             #------------------------------------------------------------------------------
1280             # Extract meta information from a PNG image
1281             # Inputs: 0) ExifTool object reference, 1) dirInfo reference
1282             # Returns: 1 on success, 0 if this wasn't a valid PNG image, or -1 on write error
1283             sub ProcessPNG($$)
1284             {
1285 12     12 0 29 my ($et, $dirInfo) = @_;
1286 12         20 my $outfile = $$dirInfo{OutFile};
1287 12         21 my $raf = $$dirInfo{RAF};
1288 12         17 my $datChunk = '';
1289 12         21 my $datCount = 0;
1290 12         14 my $datBytes = 0;
1291 12         41 my $fastScan = $et->Options('FastScan');
1292 12         43 my ($n, $sig, $err, $hbuf, $dbuf, $cbuf);
1293 12         0 my ($wasHdr, $wasEnd, $wasDat, $doTxt, @txtOffset);
1294              
1295             # check to be sure this is a valid PNG/MNG/JNG image
1296 12 50 33     32 return 0 unless $raf->Read($sig,8) == 8 and $pngLookup{$sig};
1297              
1298 12 100       34 if ($outfile) {
1299 5         9 delete $$et{TextChunkType};
1300 5 50 50     24 Write($outfile, $sig) or $err = 1 if $outfile;
1301             # can only add tags in Main and TextualData tables
1302 5         27 $$et{ADD_PNG} = $et->GetNewTagInfoHash(
1303             \%Image::ExifTool::PNG::Main,
1304             \%Image::ExifTool::PNG::TextualData);
1305             # initialize with same directories, with PNG tags taking priority
1306 5         17 $et->InitWriteDirs(\%pngMap,'PNG');
1307             } else {
1308             # disable buffering in FastScan mode
1309 7 50       19 $$raf{NoBuffer} = 1 if $fastScan;
1310             }
1311 12         15 my ($fileType, $hdrChunk, $endChunk) = @{$pngLookup{$sig}};
  12         34  
1312 12         43 $et->SetFileType($fileType); # set the FileType tag
1313 12         48 SetByteOrder('MM'); # PNG files are big-endian
1314 12         26 my $tagTablePtr = GetTagTable('Image::ExifTool::PNG::Main');
1315 12         16 my $mngTablePtr;
1316 12 50       34 if ($fileType ne 'PNG') {
1317 0         0 $mngTablePtr = GetTagTable('Image::ExifTool::MNG::Main');
1318             }
1319 12         34 my $verbose = $et->Options('Verbose');
1320 12         25 my $validate = $et->Options('Validate');
1321 12         35 my $out = $et->Options('TextOut');
1322              
1323             # scan ahead to find offsets of all text chunks after IDAT
1324 12 100       39 if ($outfile) {
1325 5         17 while ($raf->Read($hbuf,8) == 8) {
1326 30         96 my ($len, $chunk) = unpack('Na4',$hbuf);
1327 30 50       54 last if $len > 0x7fffffff;
1328 30 100       71 if ($wasDat) {
    100          
1329 15 100       38 last if $noLeapFrog{$chunk}; # (don't move text across these chunks)
1330 10 50       35 push @txtOffset, $raf->Tell() - 8 if $isTxtChunk{$chunk};
1331             } elsif ($isDatChunk{$chunk}) {
1332 5         8 $wasDat = $chunk;
1333             }
1334 25 50       53 $raf->Seek($len + 4, 1) or last; # skip chunk data
1335             }
1336 5 50       15 $raf->Seek(8,0) or $et->Error('Error seeking in file'), return -1;
1337 5         11 undef $wasDat;
1338             }
1339              
1340             # process the PNG/MNG/JNG chunks
1341 12         21 undef $noCompressLib;
1342 12         16 for (;;) {
1343 110 100       167 if ($doTxt) {
1344             # read text chunks that were found after IDAT so we can write them before
1345 15 50       36 $raf->Seek(shift(@txtOffset), 0) or $et->Error('Seek error'), last;
1346             # (this is the IDAT offset if @txtOffset is now empty)
1347 15 100       40 undef $doTxt unless @txtOffset;
1348             }
1349 110         246 $n = $raf->Read($hbuf,8); # read chunk header
1350              
1351 110 100       241 if ($wasEnd) {
    50          
1352 7 50       19 last unless $n; # stop now if normal end of PNG
1353 0         0 $et->WarnOnce("Trailer data after $fileType $endChunk chunk", 1);
1354 0 0       0 last if $n < 8;
1355 0         0 $$et{SET_GROUP1} = 'Trailer';
1356             } elsif ($n != 8) {
1357 0 0       0 $et->Warn("Truncated $fileType image") unless $wasEnd;
1358 0         0 last;
1359             }
1360 103         300 my ($len, $chunk) = unpack('Na4',$hbuf);
1361 103 50       188 if ($len > 0x7fffffff) {
1362 0 0       0 $et->Warn("Invalid $fileType chunk size") unless $wasEnd;
1363 0         0 last;
1364             }
1365 103 100       164 if ($verbose) {
1366 9 100       23 print $out " Moving $chunk from after IDAT ($len bytes)\n" if $doTxt;
1367             # don't dump image data chunks in verbose mode (only give count instead)
1368 9 100 66     25 if ($datCount and $chunk ne $datChunk) {
1369 1 50       4 my $s = $datCount > 1 ? 's' : '';
1370 1         6 print $out "$fileType $datChunk ($datCount chunk$s, total $datBytes bytes)\n";
1371 1         2 $datCount = $datBytes = 0;
1372             }
1373             }
1374 103 100       162 unless ($wasHdr) {
1375 12 50 0     49 if ($chunk eq $hdrChunk) {
    0          
1376 12         17 $wasHdr = 1;
1377             } elsif ($hdrChunk eq 'IHDR' and $chunk eq 'CgBI') {
1378 0         0 $et->Warn('Non-standard PNG image (Apple iPhone format)');
1379             } else {
1380 0         0 $et->WarnOnce("$fileType image did not start with $hdrChunk");
1381             }
1382             }
1383 103 100 100     322 if ($outfile and ($isDatChunk{$chunk} or $chunk eq $endChunk) and @txtOffset) {
      100        
      100        
1384             # continue processing here after we move the text chunks from after IDAT
1385 5         14 push @txtOffset, $raf->Tell() - 8;
1386 5         8 $doTxt = 1; # process text chunks now
1387 5         8 next;
1388             }
1389 98 100       194 if ($isDatChunk{$chunk}) {
1390 12 50 33     33 if ($fastScan and $fastScan >= 2) {
1391 0         0 $et->VPrint(0,"End processing at $chunk chunk due to FastScan=$fastScan setting");
1392 0         0 last;
1393             }
1394 12         20 $datChunk = $chunk;
1395 12         20 $datCount++;
1396 12         18 $datBytes += $len;
1397 12         16 $wasDat = $chunk;
1398             } else {
1399 86         117 $datChunk = '';
1400             }
1401 98 100       156 if ($outfile) {
1402             # add text chunks (including XMP) before any data chunk end chunk
1403 40 100 100     124 if ($datChunk or $chunk eq $endChunk) {
    50          
1404             # write iCCP chunk now if requested because AddChunks will try
1405             # to add it as a text profile chunk if this isn't successful
1406             # (ie. if Compress::Zlib wasn't available)
1407 10         42 Add_iCCP($et, $outfile);
1408 10 50       24 AddChunks($et, $outfile) or $err = 1; # add all text chunks
1409 10 50       24 AddChunks($et, $outfile, 'IFD0') or $err = 1; # and eXIf chunk
1410             } elsif ($chunk eq 'PLTE') {
1411             # iCCP chunk must come before PLTE (and IDAT, handled above)
1412             # (ignore errors -- will add later as text profile if this fails)
1413 0         0 Add_iCCP($et, $outfile);
1414             }
1415             }
1416 98 100       181 if ($chunk eq $endChunk) {
1417             # read CRC
1418 12 50       27 unless ($raf->Read($cbuf,4) == 4) {
1419 0 0       0 $et->Warn("Truncated $fileType $endChunk chunk") unless $wasEnd;
1420 0         0 last;
1421             }
1422 12 100       27 $verbose and print $out "$fileType $chunk (end of image)\n";
1423 12         17 $wasEnd = 1;
1424 12 100       22 if ($outfile) {
1425             # write the IEND/MEND chunk with CRC
1426 5 50       15 Write($outfile, $hbuf, $cbuf) or $err = 1;
1427 5 50       15 if ($$et{DEL_GROUP}{Trailer}) {
1428 0 0       0 if ($raf->Read($hbuf, 1)) {
1429 0 0       0 $verbose and printf $out " Deleting PNG trailer\n";
1430 0         0 ++$$et{CHANGED};
1431             }
1432             } else {
1433             # copy over any existing trailer data
1434 5         7 my $tot = 0;
1435 5         7 for (;;) {
1436 5 50       21 $n = $raf->Read($hbuf, 65536) or last;
1437 0         0 $tot += $n;
1438 0 0       0 Write($outfile, $hbuf) or $err = 1;
1439             }
1440 5 50 33     15 $tot and $verbose and printf $out " Copying PNG trailer ($tot bytes)\n";
1441             }
1442 5         8 last;
1443             }
1444 7         13 next;
1445             }
1446 86 100 66     243 if ($datChunk) {
    100          
1447 12         19 my $chunkSizeLimit = 10000000; # largest chunk to read into memory
1448 12 100 33     34 if ($outfile) {
    50          
1449             # avoid loading very large data chunks into memory
1450 5 50       14 if ($len > $chunkSizeLimit) {
1451 0 0       0 Write($outfile, $hbuf) or $err = 1;
1452 0 0       0 Image::ExifTool::CopyBlock($raf, $outfile, $len+4) or $et->Error("Error copying $datChunk");
1453 0         0 next;
1454             }
1455             # skip over data chunks if possible/necessary
1456             } elsif (not $validate or $len > $chunkSizeLimit) {
1457 7 50       20 $raf->Seek($len + 4, 1) or $et->Warn('Seek error'), last;
1458 7         16 next;
1459             }
1460             } elsif ($wasDat and $isTxtChunk{$chunk}) {
1461 15         19 my $msg;
1462 15 100       32 if (not $outfile) {
    50          
1463 5         6 $msg = 'may be ignored by some readers';
1464             } elsif (defined $doTxt) { # $doTxt == 0 if we crossed a noLeapFrog chunk
1465 0         0 $msg = "can't be moved"; # (but could be deleted then added back again)
1466             } else {
1467 10         13 $msg = 'fixed';
1468             }
1469 15         69 $et->WarnOnce("Text/EXIF chunk(s) found after $$et{FileType} $wasDat ($msg)", 1);
1470             }
1471             # read chunk data and CRC
1472 79 50 33     276 unless ($raf->Read($dbuf,$len)==$len and $raf->Read($cbuf, 4)==4) {
1473 0 0       0 $et->Warn("Corrupted $fileType image") unless $wasEnd;
1474 0         0 last;
1475             }
1476 79 100 66     921 if ($verbose or $validate or ($outfile and not $fastScan)) {
      66        
      100        
1477             # check CRC when in verbose mode (since we don't care about speed)
1478 35         96 my $crc = CalculateCRC(\$hbuf, undef, 4);
1479 35         72 $crc = CalculateCRC(\$dbuf, $crc);
1480 35 50       93 unless ($crc == unpack('N',$cbuf)) {
1481 0         0 my $msg = "Bad CRC for $chunk chunk";
1482 0 0       0 $outfile ? $et->Error($msg, 1) : $et->Warn($msg);
1483             }
1484 35 100       61 if ($datChunk) {
1485 5 50 50     20 Write($outfile, $hbuf, $dbuf, $cbuf) or $err = 1 if $outfile;
1486 5         10 next;
1487             }
1488             # just skip over any text chunk found after IDAT
1489 30 100 66     92 if ($outfile and $wasDat) {
1490 10 50 33     32 if ($isTxtChunk{$chunk} and not defined $doTxt) {
1491 10 50       22 ++$$et{CHANGED} if $$et{FORCE_WRITE}{PNG};
1492 10 100       23 print $out " Deleting $chunk that was moved ($len bytes)\n" if $verbose;
1493 10         18 next;
1494             }
1495             # done moving text if we hit one of these chunks
1496 0 0       0 $doTxt = 0 if $noLeapFrog{$chunk};
1497             }
1498 20 100       39 if ($verbose) {
1499 4         12 print $out "$fileType $chunk ($len bytes):\n";
1500 4 50       9 $et->VerboseDump(\$dbuf, Addr => $raf->Tell() - $len - 4) if $verbose > 2;
1501             }
1502             }
1503             # translate case of chunk names that have changed since the first implementation
1504 64 50 33     162 if (not $$tagTablePtr{$chunk} and $stdCase{lc $chunk}) {
1505 0         0 my $stdChunk = $stdCase{lc $chunk};
1506 0 0 0     0 if ($outfile and ($$et{EDIT_DIRS}{IFD0} or $stdChunk !~ /^[ez]xif$/i)) {
      0        
1507 0         0 $et->Warn("Changed $chunk chunk to $stdChunk", 1);
1508 0         0 ++$$et{CHANGED};
1509             } else {
1510 0         0 $et->Warn("$chunk chunk should be $stdChunk", 1);
1511             }
1512 0         0 $chunk = $stdCase{lc $chunk};
1513             }
1514             # only extract information from chunks in our tables
1515 64         85 my ($theBuff, $outBuff);
1516 64 100       105 $outBuff = \$theBuff if $outfile;
1517 64 50 0     99 if ($$tagTablePtr{$chunk}) {
    0          
1518 64         112 FoundPNG($et, $tagTablePtr, $chunk, $dbuf, undef, $outBuff);
1519             } elsif ($mngTablePtr and $$mngTablePtr{$chunk}) {
1520 0         0 FoundPNG($et, $mngTablePtr, $chunk, $dbuf, undef, $outBuff);
1521             }
1522 64 100       151 if ($outfile) {
1523 20 100       38 if (defined $theBuff) {
1524 5 100       15 next unless length $theBuff; # empty if we deleted the information
1525             # change chunk type if necessary
1526 3 50       7 if ($$et{TextChunkType}) {
1527 3         6 $chunk = $$et{TextChunkType};
1528 3         6 delete $$et{TextChunkType};
1529             }
1530 3         15 $hbuf = pack('Na4', length($theBuff), $chunk);
1531 3         5 $dbuf = $theBuff;
1532 3         11 my $crc = CalculateCRC(\$hbuf, undef, 4);
1533 3         9 $crc = CalculateCRC(\$dbuf, $crc);
1534 3         10 $cbuf = pack('N', $crc);
1535             }
1536 18 50       49 Write($outfile, $hbuf, $dbuf, $cbuf) or $err = 1;
1537             }
1538             }
1539 12         20 delete $$et{SET_GROUP1};
1540 12 50 33     41 return -1 if $outfile and ($err or not $wasEnd);
      66        
1541 12         37 return 1; # this was a valid PNG/MNG/JNG image
1542             }
1543              
1544             1; # end
1545              
1546             __END__