File Coverage

blib/lib/Image/ExifTool/PNG.pm
Criterion Covered Total %
statement 302 504 59.9
branch 178 408 43.6
condition 96 222 43.2
subroutine 13 15 86.6
pod 0 11 0.0
total 589 1160 50.7


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 23     23   4934 use strict;
  23         78  
  23         935  
36 23     23   151 use vars qw($VERSION $AUTOLOAD %stdCase);
  23         59  
  23         1536  
37 23     23   152 use Image::ExifTool qw(:DataAccess :Utils);
  23         56  
  23         186947  
38              
39             $VERSION = '1.63';
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             caBX => { # C2PA metadata
343             Name => 'JUMBF',
344             SubDirectory => { TagTable => 'Image::ExifTool::Jpeg2000::Main' },
345             },
346             cICP => {
347             Name => 'CICodePoints',
348             SubDirectory => {
349             TagTable => 'Image::ExifTool::PNG::CICodePoints',
350             },
351             },
352             );
353              
354             # PNG IHDR chunk
355             %Image::ExifTool::PNG::ImageHeader = (
356             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
357             GROUPS => { 2 => 'Image' },
358             0 => {
359             Name => 'ImageWidth',
360             Format => 'int32u',
361             },
362             4 => {
363             Name => 'ImageHeight',
364             Format => 'int32u',
365             },
366             8 => 'BitDepth',
367             9 => {
368             Name => 'ColorType',
369             RawConv => '$Image::ExifTool::PNG::colorType = $val',
370             PrintConv => {
371             0 => 'Grayscale',
372             2 => 'RGB',
373             3 => 'Palette',
374             4 => 'Grayscale with Alpha',
375             6 => 'RGB with Alpha',
376             },
377             },
378             10 => {
379             Name => 'Compression',
380             PrintConv => { 0 => 'Deflate/Inflate' },
381             },
382             11 => {
383             Name => 'Filter',
384             PrintConv => { 0 => 'Adaptive' },
385             },
386             12 => {
387             Name => 'Interlace',
388             PrintConv => { 0 => 'Noninterlaced', 1 => 'Adam7 Interlace' },
389             },
390             );
391              
392             # PNG cHRM chunk
393             %Image::ExifTool::PNG::PrimaryChromaticities = (
394             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
395             GROUPS => { 2 => 'Image' },
396             FORMAT => 'int32u',
397             0 => { Name => 'WhitePointX', ValueConv => '$val / 100000' },
398             1 => { Name => 'WhitePointY', ValueConv => '$val / 100000' },
399             2 => { Name => 'RedX', ValueConv => '$val / 100000' },
400             3 => { Name => 'RedY', ValueConv => '$val / 100000' },
401             4 => { Name => 'GreenX', ValueConv => '$val / 100000' },
402             5 => { Name => 'GreenY', ValueConv => '$val / 100000' },
403             6 => { Name => 'BlueX', ValueConv => '$val / 100000' },
404             7 => { Name => 'BlueY', ValueConv => '$val / 100000' },
405             );
406              
407             # PNG pHYs chunk
408             %Image::ExifTool::PNG::PhysicalPixel = (
409             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
410             WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
411             WRITABLE => 1,
412             GROUPS => { 1 => 'PNG-pHYs', 2 => 'Image' },
413             WRITE_GROUP => 'PNG-pHYs',
414             NOTES => q{
415             These tags are found in the PNG pHYs chunk and belong to the PNG-pHYs family
416             1 group. They are all created together with default values if necessary
417             when any of these tags is written, and may only be deleted as a group.
418             },
419             0 => {
420             Name => 'PixelsPerUnitX',
421             Format => 'int32u',
422             Notes => 'default 2834',
423             },
424             4 => {
425             Name => 'PixelsPerUnitY',
426             Format => 'int32u',
427             Notes => 'default 2834',
428             },
429             8 => {
430             Name => 'PixelUnits',
431             PrintConv => { 0 => 'Unknown', 1 => 'meters' },
432             Notes => 'default meters',
433             },
434             );
435              
436             # PNG cICP chunk
437             %Image::ExifTool::PNG::CICodePoints = (
438             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
439             GROUPS => { 1 => 'PNG-cICP', 2 => 'Image' },
440             NOTES => q{
441             These tags are found in the PNG cICP chunk and belong to the PNG-cICP family
442             1 group.
443             },
444             # (same as tags in QuickTime::ColorRep)
445             0 => {
446             Name => 'ColorPrimaries',
447             PrintConv => {
448             1 => 'BT.709',
449             2 => 'Unspecified',
450             4 => 'BT.470 System M (historical)',
451             5 => 'BT.470 System B, G (historical)',
452             6 => 'BT.601',
453             7 => 'SMPTE 240',
454             8 => 'Generic film (color filters using illuminant C)',
455             9 => 'BT.2020, BT.2100',
456             10 => 'SMPTE 428 (CIE 1921 XYZ)',
457             11 => 'SMPTE RP 431-2',
458             12 => 'SMPTE EG 432-1',
459             22 => 'EBU Tech. 3213-E',
460             },
461             },
462             1 => {
463             Name => 'TransferCharacteristics',
464             PrintConv => {
465             0 => 'For future use (0)',
466             1 => 'BT.709',
467             2 => 'Unspecified',
468             3 => 'For future use (3)',
469             4 => 'BT.470 System M (historical)',
470             5 => 'BT.470 System B, G (historical)',
471             6 => 'BT.601',
472             7 => 'SMPTE 240 M',
473             8 => 'Linear',
474             9 => 'Logarithmic (100 : 1 range)',
475             10 => 'Logarithmic (100 * Sqrt(10) : 1 range)',
476             11 => 'IEC 61966-2-4',
477             12 => 'BT.1361',
478             13 => 'sRGB or sYCC',
479             14 => 'BT.2020 10-bit systems',
480             15 => 'BT.2020 12-bit systems',
481             16 => 'SMPTE ST 2084, ITU BT.2100 PQ',
482             17 => 'SMPTE ST 428',
483             18 => 'BT.2100 HLG, ARIB STD-B67',
484             },
485             },
486             2 => {
487             Name => 'MatrixCoefficients',
488             PrintConv => {
489             0 => 'Identity matrix',
490             1 => 'BT.709',
491             2 => 'Unspecified',
492             3 => 'For future use (3)',
493             4 => 'US FCC 73.628',
494             5 => 'BT.470 System B, G (historical)',
495             6 => 'BT.601',
496             7 => 'SMPTE 240 M',
497             8 => 'YCgCo',
498             9 => 'BT.2020 non-constant luminance, BT.2100 YCbCr',
499             10 => 'BT.2020 constant luminance',
500             11 => 'SMPTE ST 2085 YDzDx',
501             12 => 'Chromaticity-derived non-constant luminance',
502             13 => 'Chromaticity-derived constant luminance',
503             14 => 'BT.2100 ICtCp',
504             },
505             },
506             3 => 'VideoFullRangeFlag',
507             );
508              
509             # PNG sCAL chunk
510             %Image::ExifTool::PNG::SubjectScale = (
511             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
512             GROUPS => { 2 => 'Image' },
513             0 => {
514             Name => 'SubjectUnits',
515             PrintConv => { 1 => 'meters', 2 => 'radians' },
516             },
517             1 => {
518             Name => 'SubjectPixelWidth',
519             Format => 'var_string',
520             },
521             2 => {
522             Name => 'SubjectPixelHeight',
523             Format => 'var_string',
524             },
525             );
526              
527             # PNG vpAg chunk
528             %Image::ExifTool::PNG::VirtualPage = (
529             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
530             GROUPS => { 2 => 'Image' },
531             FORMAT => 'int32u',
532             0 => 'VirtualImageWidth',
533             1 => 'VirtualImageHeight',
534             2 => {
535             Name => 'VirtualPageUnits',
536             Format => 'int8u',
537             # what is the conversion for this?
538             },
539             );
540              
541             # PNG sTER chunk
542             %Image::ExifTool::PNG::StereoImage = (
543             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
544             GROUPS => { 2 => 'Image' },
545             0 => {
546             Name => 'StereoMode',
547             PrintConv => {
548             0 => 'Cross-fuse Layout',
549             1 => 'Diverging-fuse Layout',
550             },
551             },
552             );
553              
554             my %unreg = ( Notes => 'unregistered' );
555              
556             # Tags for PNG tEXt zTXt and iTXt chunks
557             # (NOTE: ValueConv is set dynamically, so don't set it here!)
558             %Image::ExifTool::PNG::TextualData = (
559             PROCESS_PROC => \&ProcessPNG_tEXt,
560             WRITE_PROC => \&Image::ExifTool::DummyWriteProc,
561             WRITABLE => 'string',
562             PREFERRED => 1, # always add these tags when writing
563             GROUPS => { 2 => 'Image' },
564             LANG_INFO => \&GetLangInfo,
565             NOTES => q{
566             The PNG TextualData format allows arbitrary tag names to be used. The tags
567             listed below are the only ones that can be written (unless new user-defined
568             tags are added via the configuration file), however ExifTool will extract
569             any other TextualData tags that are found. All TextualData tags (including
570             tags not listed below) are removed when deleting all PNG tags.
571              
572             These tags may be stored as tEXt, zTXt or iTXt chunks in the PNG image. By
573             default ExifTool writes new string-value tags as as uncompressed tEXt, or
574             compressed zTXt if the L (-z) option is used and Compress::Zlib is
575             available. Alternate language tags and values containing special characters
576             (unless the Latin character set is used) are written as iTXt, and compressed
577             if the L option is used and Compress::Zlib is available. Raw profile
578             information is always created as compressed zTXt if Compress::Zlib is
579             available, or tEXt otherwise. Standard XMP is written as uncompressed iTXt.
580             User-defined tags may set an 'iTXt' flag in the tag definition to be written
581             only as iTXt.
582              
583             Alternate languages are accessed by suffixing the tag name with a '-',
584             followed by an RFC 3066 language code (eg. "PNG:Comment-fr", or
585             "Title-en-US"). See L for the RFC 3066
586             specification.
587              
588             Some of the tags below are not registered as part of the PNG specification,
589             but are included here because they are generated by other software such as
590             ImageMagick.
591             },
592             Title => { },
593             Author => { Groups => { 2 => 'Author' } },
594             Description => { },
595             Copyright => { Groups => { 2 => 'Author' } },
596             'Creation Time' => {
597             Name => 'CreationTime',
598             Groups => { 2 => 'Time' },
599             Shift => 'Time',
600             Notes => 'stored in RFC-1123 format and converted to/from EXIF format by ExifTool',
601             RawConv => \&ConvertPNGDate,
602             ValueConvInv => \&InversePNGDate,
603             PrintConv => '$self->ConvertDateTime($val)',
604             PrintConvInv => '$self->InverseDateTime($val,undef,1)',
605             },
606             Software => { },
607             Disclaimer => { },
608             # change name to differentiate from ExifTool Warning
609             Warning => { Name => 'PNGWarning', },
610             Source => { },
611             Comment => { },
612             Collection => { }, # (PNG extensions, 2004)
613             #
614             # The following tags are not part of the original PNG specification,
615             # but are written by ImageMagick and other software
616             #
617             Artist => { %unreg, Groups => { 2 => 'Author' } },
618             Document => { %unreg },
619             Label => { %unreg },
620             Make => { %unreg, Groups => { 2 => 'Camera' } },
621             Model => { %unreg, Groups => { 2 => 'Camera' } },
622             # parameters (written by Stable Diffusion)
623             # aesthetic_score (written by Stable Diffusion)
624             'create-date'=> {
625             Name => 'CreateDate',
626             Groups => { 2 => 'Time' },
627             Shift => 'Time',
628             %unreg,
629             ValueConv => 'require Image::ExifTool::XMP; Image::ExifTool::XMP::ConvertXMPDate($val)',
630             ValueConvInv => 'require Image::ExifTool::XMP; Image::ExifTool::XMP::FormatXMPDate($val)',
631             PrintConv => '$self->ConvertDateTime($val)',
632             PrintConvInv => '$self->InverseDateTime($val,undef,1)',
633             },
634             'modify-date'=> {
635             Name => 'ModDate', # (to distinguish from tIME chunk "ModifyDate")
636             Groups => { 2 => 'Time' },
637             Shift => 'Time',
638             %unreg,
639             ValueConv => 'require Image::ExifTool::XMP; Image::ExifTool::XMP::ConvertXMPDate($val)',
640             ValueConvInv => 'require Image::ExifTool::XMP; Image::ExifTool::XMP::FormatXMPDate($val)',
641             PrintConv => '$self->ConvertDateTime($val)',
642             PrintConvInv => '$self->InverseDateTime($val,undef,1)',
643             },
644             TimeStamp => { %unreg, Groups => { 2 => 'Time' }, Shift => 'Time' },
645             URL => { %unreg },
646             'XML:com.adobe.xmp' => {
647             Name => 'XMP',
648             Notes => q{
649             unregistered, but this is the location according to the June 2002 or later
650             XMP specification, and is where ExifTool will add a new XMP chunk if the
651             image didn't already contain XMP
652             },
653             SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' },
654             },
655             'Raw profile type APP1' => [
656             {
657             # EXIF table must come first because we key on this in ProcessProfile()
658             # (No condition because this is just for BuildTagLookup)
659             Name => 'APP1_Profile',
660             %unreg,
661             NonStandard => 'EXIF',
662             SubDirectory => {
663             TagTable => 'Image::ExifTool::Exif::Main',
664             ProcessProc => \&ProcessProfile,
665             },
666             },
667             {
668             Name => 'APP1_Profile',
669             NonStandard => 'XMP',
670             SubDirectory => {
671             TagTable => 'Image::ExifTool::XMP::Main',
672             ProcessProc => \&ProcessProfile,
673             },
674             },
675             ],
676             'Raw profile type exif' => {
677             Name => 'EXIF_Profile',
678             %unreg,
679             NonStandard => 'EXIF',
680             SubDirectory => {
681             TagTable => 'Image::ExifTool::Exif::Main',
682             ProcessProc => \&ProcessProfile,
683             },
684             },
685             'Raw profile type icc' => {
686             Name => 'ICC_Profile',
687             %unreg,
688             SubDirectory => {
689             TagTable => 'Image::ExifTool::ICC_Profile::Main',
690             ProcessProc => \&ProcessProfile,
691             },
692             },
693             'Raw profile type icm' => {
694             Name => 'ICC_Profile',
695             %unreg,
696             SubDirectory => {
697             TagTable => 'Image::ExifTool::ICC_Profile::Main',
698             ProcessProc => \&ProcessProfile,
699             },
700             },
701             'Raw profile type iptc' => {
702             Name => 'IPTC_Profile',
703             Notes => q{
704             unregistered. May be either IPTC IIM or Photoshop IRB format. This is
705             where ExifTool will add new IPTC, inside a Photoshop IRB container
706             },
707             SubDirectory => {
708             TagTable => 'Image::ExifTool::Photoshop::Main',
709             ProcessProc => \&ProcessProfile,
710             },
711             },
712             'Raw profile type xmp' => {
713             Name => 'XMP_Profile',
714             %unreg,
715             NonStandard => 'XMP',
716             SubDirectory => {
717             TagTable => 'Image::ExifTool::XMP::Main',
718             ProcessProc => \&ProcessProfile,
719             },
720             },
721             'Raw profile type 8bim' => {
722             Name => 'Photoshop_Profile',
723             %unreg,
724             SubDirectory => {
725             TagTable => 'Image::ExifTool::Photoshop::Main',
726             ProcessProc => \&ProcessProfile,
727             },
728             },
729             );
730              
731             # Animation control
732             %Image::ExifTool::PNG::AnimationControl = (
733             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
734             GROUPS => { 2 => 'Image' },
735             FORMAT => 'int32u',
736             NOTES => q{
737             Tags found in the Animation Control chunk. See
738             L for details.
739             },
740             0 => {
741             Name => 'AnimationFrames',
742             RawConv => '$self->OverrideFileType("APNG", undef, "PNG"); $val',
743             },
744             1 => {
745             Name => 'AnimationPlays',
746             PrintConv => '$val || "inf"',
747             },
748             );
749              
750             #------------------------------------------------------------------------------
751             # AutoLoad our writer routines when necessary
752             #
753             sub AUTOLOAD
754             {
755 1     1   8 return Image::ExifTool::DoAutoLoad($AUTOLOAD, @_);
756             }
757              
758             #------------------------------------------------------------------------------
759             # Get standard case for language code (this routine copied from XMP.pm)
760             # Inputs: 0) Language code
761             # Returns: Language code in standard case
762             sub StandardLangCase($)
763             {
764 24     24 0 55 my $lang = shift;
765             # make 2nd subtag uppercase only if it is 2 letters
766 24 100       158 return lc($1) . uc($2) . lc($3) if $lang =~ /^([a-z]{2,3}|[xi])(-[a-z]{2})\b(.*)/i;
767 11         54 return lc($lang);
768             }
769              
770             #------------------------------------------------------------------------------
771             # Convert date from PNG to EXIF format
772             # Inputs: 0) Date/time in PNG format, 1) ExifTool ref
773             # Returns: EXIF formatted date/time string
774             my %monthNum = (
775             Jan=>1, Feb=>2, Mar=>3, Apr=>4, May=>5, Jun=>6,
776             Jul=>7, Aug=>8, Sep=>9, Oct=>10,Nov=>11,Dec=>12
777             );
778             my %tzConv = (
779             UT => '+00:00', GMT => '+00:00', UTC => '+00:00', # (UTC not in spec -- PH addition)
780             EST => '-05:00', EDT => '-04:00',
781             CST => '-06:00', CDT => '-05:00',
782             MST => '-07:00', MDT => '-06:00',
783             PST => '-08:00', PDT => '-07:00',
784             A => '-01:00', N => '+01:00',
785             B => '-02:00', O => '+02:00',
786             C => '-03:00', P => '+03:00',
787             D => '-04:00', Q => '+04:00',
788             E => '-05:00', R => '+05:00',
789             F => '-06:00', S => '+06:00',
790             G => '-07:00', T => '+07:00',
791             H => '-08:00', U => '+08:00',
792             I => '-09:00', V => '+09:00',
793             K => '-10:00', W => '+10:00',
794             L => '-11:00', X => '+11:00',
795             M => '-12:00', Y => '+12:00',
796             Z => '+00:00',
797             );
798             sub ConvertPNGDate($$)
799             {
800 0     0 0 0 my ($val, $et) = @_;
801             # standard format is like "Mon, 1 Jan 2018 12:10:22 EST" (RFC-1123 section 5.2.14)
802 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) {
803 0         0 my ($day,$mon,$yr,$hr,$min,$sec,$tz) = ($1,$2,$3,$4,$5,$6,$7);
804 0 0       0 $yr += $yr > 70 ? 1900 : 2000 if $yr < 100; # boost year to 4 digits if necessary
    0          
805 0 0       0 $mon = $monthNum{ucfirst lc $mon} or return $val;
806 0 0       0 if (not $tz) {
    0          
    0          
807 0         0 $tz = '';
808             } elsif ($tzConv{uc $tz}) {
809 0         0 $tz = $tzConv{uc $tz};
810             } elsif ($tz =~ /^([-+]\d+):?(\d{2})/) {
811 0         0 $tz = $1 . ':' . $2;
812             } else {
813 0         0 last; # (non-standard date)
814             }
815 0   0     0 return sprintf("%.4d:%.2d:%.2d %.2d:%.2d%s%s",$yr,$mon,$day,$hr,$min,$sec||':00',$tz);
816             }
817 0 0 0     0 if (($et->Options('StrictDate') and not $$et{TAGS_FROM_FILE}) or $et->Options('Validate')) {
      0        
818 0         0 $et->Warn('Non standard PNG date/time format', 1);
819             }
820 0         0 return $val;
821             }
822              
823             #------------------------------------------------------------------------------
824             # Convert EXIF date/time to PNG format
825             # Inputs: 0) Date/time in EXIF format, 1) ExifTool ref
826             # Returns: PNG formatted date/time string
827             sub InversePNGDate($$)
828             {
829 0     0 0 0 my ($val, $et) = @_;
830 0 0       0 if ($et->Options('StrictDate')) {
831 0         0 my $err;
832 0 0       0 if ($val =~ /^(\d{4}):(\d{2}):(\d{2}) (\d{2})(:\d{2})(:\d{2})?(?:\.\d*)?\s*(\S*)/) {
833 0         0 my ($yr,$mon,$day,$hr,$min,$sec,$tz) = ($1,$2,$3,$4,$5,$6,$7);
834 0 0       0 $sec or $sec = '';
835 0         0 my %monName = map { $monthNum{$_} => $_ } keys %monthNum;
  0         0  
836 0 0       0 $mon = $monName{$mon + 0} or $err = 1;
837 0 0       0 if (length $tz) {
838 0 0       0 $tz =~ /^(Z|[-+]\d{2}:?\d{2})/ or $err = 1;
839 0         0 $tz =~ tr/://d;
840 0         0 $tz = ' ' . $tz;
841             }
842 0 0       0 $val = "$day $mon $yr $hr$min$sec$tz" unless $err;
843             }
844 0 0       0 if ($err) {
845 0         0 warn "Invalid date/time (use YYYY:mm:dd HH:MM:SS[.ss][+/-HH:MM|Z])\n";
846 0         0 undef $val;
847             }
848             }
849 0         0 return $val;
850             }
851              
852             #------------------------------------------------------------------------------
853             # Get localized version of tagInfo hash
854             # Inputs: 0) tagInfo hash ref, 1) language code (eg. "x-default")
855             # Returns: new tagInfo hash ref, or undef if invalid
856             sub GetLangInfo($$)
857             {
858 23     23 0 65 my ($tagInfo, $lang) = @_;
859 23         48 $lang =~ tr/_/-/; # RFC 3066 specifies '-' as a separator
860             # no alternate languages for XMP or raw profile directories
861 23 50       85 return undef if $$tagInfo{SubDirectory};
862             # language code must normalized for use in tag ID
863 23         80 return Image::ExifTool::GetLangInfo($tagInfo, StandardLangCase($lang));
864             }
865              
866             #------------------------------------------------------------------------------
867             # Found a PNG tag -- extract info from subdirectory or decompress data if necessary
868             # Inputs: 0) ExifTool object reference, 1) Pointer to tag table,
869             # 2) Tag ID, 3) Tag value, 4) [optional] compressed data flag:
870             # 0=not compressed, 1=unknown compression, 2-N=compression with type N-2
871             # 5) optional output buffer ref, 6) character encoding (tEXt/zTXt/iTXt only)
872             # 6) optional language code
873             # Returns: 1 on success
874             sub FoundPNG($$$$;$$$$)
875             {
876 100     100 0 304 my ($et, $tagTablePtr, $tag, $val, $compressed, $outBuff, $enc, $lang) = @_;
877 100 50       233 return 0 unless defined $val;
878 100         303 my $verbose = $et->Options('Verbose');
879 100         190 my $id = $tag; # generate tag ID which includes language code
880 100 100       214 if ($lang) {
881             # case of language code must be normalized since they are case insensitive
882 1         5 $lang = StandardLangCase($lang);
883 1         3 $id .= '-' . $lang;
884             }
885 100   66     277 my $tagInfo = $et->GetTagInfo($tagTablePtr, $id) ||
886             # (some software forgets to capitalize first letter)
887             $et->GetTagInfo($tagTablePtr, ucfirst($id));
888             # create alternate language tag if necessary
889 100 50 33     313 if (not $tagInfo and $lang) {
890 0   0     0 $tagInfo = $et->GetTagInfo($tagTablePtr, $tag) ||
891             $et->GetTagInfo($tagTablePtr, ucfirst($tag));
892 0 0       0 $tagInfo = GetLangInfo($tagInfo, $lang) if $tagInfo;
893             }
894             #
895             # uncompress data if necessary
896             #
897 100         185 my ($wasCompressed, $deflateErr);
898 100 100 66     230 if ($compressed and $compressed > 1) {
899 2 50       13 if ($compressed == 2) { # Inflate/Deflate compression
900 2 50       5 if (eval { require Compress::Zlib }) {
  2 0       25  
901 2         4 my ($v2, $stat);
902 2         17 my $inflate = Compress::Zlib::inflateInit();
903 2 50       294 $inflate and ($v2, $stat) = $inflate->inflate($val);
904 2 50 33     117 if ($inflate and $stat == Compress::Zlib::Z_STREAM_END()) {
905 2         50 $val = $v2;
906 2         4 $compressed = 0;
907 2         20 $wasCompressed = 1;
908             } else {
909 0         0 $deflateErr = "Error inflating $tag";
910             }
911             } elsif (not $noCompressLib) {
912 0         0 $deflateErr = "Install Compress::Zlib to read compressed information";
913             } else {
914 0         0 $deflateErr = ''; # flag deflate error but no warning
915             }
916             } else {
917 0         0 $compressed -= 2;
918 0         0 $deflateErr = "Unknown compression method $compressed for $tag";
919             }
920 2 0 33     10 if ($compressed and $verbose and $tagInfo and $$tagInfo{SubDirectory}) {
      33        
      0        
921 0         0 $et->VerboseDir("Unable to decompress $$tagInfo{Name}", 0, length($val));
922             }
923             # issue warning if relevant
924 2 50 33     11 if ($deflateErr and not $outBuff) {
925 0         0 $et->Warn($deflateErr);
926 0 0       0 $noCompressLib = 1 if $deflateErr =~ /^Install/;
927             }
928             }
929             # translate character encoding if necessary (tEXt/zTXt/iTXt string values only)
930 100 100 66     439 if ($enc and not $compressed and not ($tagInfo and $$tagInfo{SubDirectory})) {
      66        
      100        
931 22         92 $val = $et->Decode($val, $enc);
932             }
933             #
934             # extract information from subdirectory if available
935             #
936 100 50       210 if ($tagInfo) {
    0          
937 100         260 my $tagName = $$tagInfo{Name};
938 100         170 my $processed;
939 100 100       234 if ($$tagInfo{SubDirectory}) {
940 64 0 33     162 if ($$et{OPTIONS}{Validate} and $$tagInfo{NonStandard}) {
941 0         0 $et->WarnOnce("Non-standard $$tagInfo{NonStandard} in PNG $tag chunk", 1);
942             }
943 64         108 my $subdir = $$tagInfo{SubDirectory};
944 64   66     224 my $dirName = $$subdir{DirName} || $tagName;
945 64 50       120 if (not $compressed) {
    0          
946 64         109 my $len = length $val;
947 64 50 66     150 if ($verbose and $$et{INDENT} ne ' ') {
948 0 0 0     0 if ($wasCompressed and $verbose > 2) {
949 0         0 my $name = $tagName;
950 0 0       0 $wasCompressed and $name = "Decompressed $name";
951 0         0 $et->VerboseDir($name, 0, $len);
952 0         0 $et->VerboseDump(\$val);
953             }
954             # don't indent next directory (since it is really the same data)
955 0         0 $$et{INDENT} =~ s/..$//;
956             }
957 64         116 my $processProc = $$subdir{ProcessProc};
958             # nothing more to do if writing and subdirectory is not writable
959 64         188 my $subTable = GetTagTable($$subdir{TagTable});
960 64 100 100     274 return 1 if $outBuff and not $$subTable{WRITE_PROC};
961 59   66     220 my $dirName = $$subdir{DirName} || $tagName;
962 59         393 my %subdirInfo = (
963             DataPt => \$val,
964             DirStart => 0,
965             DataLen => $len,
966             DirLen => $len,
967             DirName => $dirName,
968             TagInfo => $tagInfo,
969             ReadOnly => 1, # (used only by WriteXMP)
970             OutBuff => $outBuff,
971             );
972             # no need to re-decompress if already done
973 59 100 66     175 undef $processProc if $wasCompressed and $processProc and $processProc eq \&ProcessPNG_Compressed;
      100        
974             # rewrite this directory if necessary (but always process TextualData normally)
975 59 100 100     219 if ($outBuff and not $processProc and $subTable ne \%Image::ExifTool::PNG::TextualData) {
      100        
976 5 100       36 return 1 unless $$et{EDIT_DIRS}{$dirName};
977 3         21 $$outBuff = $et->WriteDirectory(\%subdirInfo, $subTable);
978 3 50 33     26 if ($tagName eq 'XMP' and $$outBuff) {
979             # make sure the XMP is marked as read-only
980 3         24 Image::ExifTool::XMP::ValidateXMP($outBuff,'r');
981             }
982 3         24 DoneDir($et, $dirName, $outBuff, $$tagInfo{NonStandard});
983             } else {
984 54         206 $processed = $et->ProcessDirectory(\%subdirInfo, $subTable, $processProc);
985             }
986 57         228 $compressed = 1; # pretend this is compressed since it is binary data
987             } elsif ($outBuff) {
988 0 0 0     0 if ($$et{DEL_GROUP}{$dirName} or ($dirName eq 'EXIF' and $$et{DEL_GROUP}{IFD0})) {
      0        
989 0         0 $$outBuff = '';
990 0         0 ++$$et{CHANGED};
991 0         0 $et->VPrint(0, " Deleting $tag chunk");
992             } else {
993 0 0 0     0 if ($$et{EDIT_DIRS}{$dirName} or ($dirName eq 'EXIF' and $$et{EDIT_DIRS}{IFD0})) {
      0        
994 0         0 $et->Warn("Can't write $dirName. Requires Compress::Zlib");
995             }
996             # pretend we did this directory so we don't try to recreate it
997 0         0 DoneDir($et, $dirName, $outBuff, $$tagInfo{NonStandard});
998             }
999             }
1000             }
1001 93 100       221 if ($outBuff) {
1002 23         59 my $writable = $$tagInfo{Writable};
1003 23         51 my $isOverwriting;
1004 23 100 66     168 if ($writable or ($$tagTablePtr{WRITABLE} and
      100        
      66        
1005             not defined $writable and not $$tagInfo{SubDirectory}))
1006             {
1007             # write new value for this tag if necessary
1008 5         12 my $newVal;
1009 5 100       33 if ($$et{DEL_GROUP}{PNG}){
1010             # remove this tag now, but keep in ADD_PNG list to add back later
1011 1         4 $isOverwriting = 1;
1012             } else {
1013             # remove this from the list of PNG tags to add
1014 4         22 delete $$et{ADD_PNG}{$id};
1015             # (also handle case of tEXt tags written with lowercase first letter)
1016 4         17 delete $$et{ADD_PNG}{ucfirst($id)};
1017 4         27 my $nvHash = $et->GetNewValueHash($tagInfo);
1018 4         26 $isOverwriting = $et->IsOverwriting($nvHash);
1019 4 50       13 if (defined $deflateErr) {
1020 0         0 $newVal = $et->GetNewValue($nvHash);
1021             # can only write tag now if always overwriting
1022 0 0       0 if ($isOverwriting > 0) {
    0          
1023 0         0 $val = '';
1024             } elsif ($isOverwriting) {
1025 0         0 $isOverwriting = 0; # can't overwrite
1026 0 0       0 $et->Warn($deflateErr) if $deflateErr;
1027             }
1028             } else {
1029 4 50       16 if ($isOverwriting < 0) {
1030 0         0 $isOverwriting = $et->IsOverwriting($nvHash, $val);
1031             }
1032             # (must get new value after IsOverwriting() in case it was shifted)
1033 4         17 $newVal = $et->GetNewValue($nvHash);
1034             }
1035             }
1036 5 100       29 if ($isOverwriting) {
1037 2 50       8 $$outBuff = (defined $newVal) ? $newVal : '';
1038 2         7 ++$$et{CHANGED};
1039 2         19 $et->VerboseValue("- PNG:$tagName", $val);
1040 2 50       8 $et->VerboseValue("+ PNG:$tagName", $newVal) if defined $newVal;
1041             }
1042             }
1043 23 100 100     98 if (defined $$outBuff and length $$outBuff) {
1044 6 100       30 if ($enc) { # must be tEXt/zTXt/iTXt if $enc is set
    50          
1045 3         26 $$outBuff = BuildTextChunk($et, $tag, $tagInfo, $$outBuff, $lang);
1046             } elsif ($wasCompressed) {
1047             # re-compress the output data
1048 0         0 my $len = length $$outBuff;
1049 0         0 my $deflate = Compress::Zlib::deflateInit();
1050 0 0       0 if ($deflate) {
1051 0         0 $$outBuff = $deflate->deflate($$outBuff);
1052 0 0       0 $$outBuff .= $deflate->flush() if defined $$outBuff;
1053             } else {
1054 0         0 undef $$outBuff;
1055             }
1056 0 0       0 if (not $$outBuff) {
    0          
1057 0         0 $et->Warn("PNG:$tagName not written (compress error)");
1058             } elsif (lc $tag eq 'zxif') {
1059 0         0 $$outBuff = "\0" . pack('N',$len) . $$outBuff; # add zXIf header
1060             }
1061             }
1062             }
1063 23         75 return 1;
1064             }
1065 70 100       213 return 1 if $processed;
1066             } elsif ($outBuff) {
1067 0 0 0     0 if ($$et{DEL_GROUP}{PNG} and $tagTablePtr eq \%Image::ExifTool::PNG::TextualData) {
1068             # delete all TextualData tags if deleting the PNG group
1069 0         0 $$outBuff = '';
1070 0         0 ++$$et{CHANGED};
1071 0         0 $et->VerboseValue("- PNG:$tag", $val);
1072             }
1073 0         0 return 1;
1074             } else {
1075 0         0 my $name;
1076 0         0 ($name = $tag) =~ s/\s+(.)/\u$1/g; # remove white space from tag name
1077 0         0 $tagInfo = { Name => $name };
1078 0 0       0 $$tagInfo{LangCode} = $lang if $lang;
1079             # make unknown profiles binary data type
1080 0 0       0 $$tagInfo{Binary} = 1 if $tag =~ /^Raw profile type /;
1081 0 0       0 $verbose and $et->VPrint(0, " [adding $tag]\n");
1082 0         0 AddTagToTable($tagTablePtr, $tag, $tagInfo);
1083             }
1084             #
1085             # store this tag information
1086             #
1087 26 50       79 if ($verbose) {
1088             # temporarily remove subdirectory so it isn't printed in verbose information
1089             # since we aren't decoding it anyway;
1090 0         0 my $subdir = $$tagInfo{SubDirectory};
1091 0         0 delete $$tagInfo{SubDirectory};
1092 0         0 $et->VerboseInfo($tag, $tagInfo,
1093             Table => $tagTablePtr,
1094             DataPt => \$val,
1095             );
1096 0 0       0 $$tagInfo{SubDirectory} = $subdir if $subdir;
1097             }
1098             # set the RawConv dynamically depending on whether this is binary or not
1099 26         50 my $delRawConv;
1100 26 50 33     64 if ($compressed and not defined $$tagInfo{ValueConv}) {
1101 0         0 $$tagInfo{RawConv} = '\$val';
1102 0         0 $delRawConv = 1;
1103             }
1104 26         103 $et->FoundTag($tagInfo, $val);
1105 26 50       71 delete $$tagInfo{RawConv} if $delRawConv;
1106 26         80 return 1;
1107             }
1108              
1109             #------------------------------------------------------------------------------
1110             # Process encoded PNG profile information
1111             # Inputs: 0) ExifTool object reference, 1) DirInfo reference, 2) Pointer to tag table
1112             # Returns: 1 on success
1113             sub ProcessProfile($$$)
1114             {
1115 1     1 0 3 my ($et, $dirInfo, $tagTablePtr) = @_;
1116 1         4 my $dataPt = $$dirInfo{DataPt};
1117 1         4 my $tagInfo = $$dirInfo{TagInfo};
1118 1         3 my $outBuff = $$dirInfo{OutBuff};
1119 1         3 my $tagName = $$tagInfo{Name};
1120              
1121             # ImageMagick 5.3.6 writes profiles with the following headers:
1122             # "\nICC Profile\n", "\nIPTC profile\n", "\n\xaa\x01{generic prof\n"
1123             # and "\ngeneric profile\n"
1124 1 50       10 return 0 unless $$dataPt =~ /^\n(.*?)\n\s*(\d+)\n(.*)/s;
1125 1         5 my ($profileType, $len) = ($1, $2);
1126             # data is encoded in hex, so change back to binary
1127 1         27 my $buff = pack('H*', join('',split(' ',$3)));
1128 1         4 my $actualLen = length $buff;
1129 1 50       4 if ($len ne $actualLen) {
1130 0         0 $et->Warn("$tagName is wrong size (should be $len bytes but is $actualLen)");
1131 0         0 $len = $actualLen;
1132             }
1133 1         7 my $verbose = $et->Options('Verbose');
1134 1 50       7 if ($verbose) {
1135 0 0       0 if ($verbose > 2) {
1136 0         0 $et->VerboseDir("Decoded $tagName", 0, $len);
1137 0         0 $et->VerboseDump(\$buff);
1138             }
1139             # don't indent next directory (since it is really the same data)
1140 0         0 $$et{INDENT} =~ s/..$//;
1141             }
1142 1         11 my %dirInfo = (
1143             Parent => 'PNG',
1144             DataPt => \$buff,
1145             DataLen => $len,
1146             DirStart => 0,
1147             DirLen => $len,
1148             Base => 0,
1149             OutFile => $outBuff,
1150             );
1151 1         3 $$et{PROCESSED} = { }; # reset processed directory offsets
1152 1         4 my $processed = 0;
1153 1         4 my $oldChanged = $$et{CHANGED};
1154 1         4 my $exifTable = GetTagTable('Image::ExifTool::Exif::Main');
1155 1         4 my $editDirs = $$et{EDIT_DIRS};
1156              
1157 1 50       5 if ($tagTablePtr ne $exifTable) {
    0          
    0          
    0          
1158             # this is unfortunate, but the "IPTC" profile may be stored as either
1159             # IPTC IIM or a Photoshop IRB resource, so we must test for this
1160 1 50 33     41 if ($tagName eq 'IPTC_Profile' and $buff =~ /^\x1c/) {
1161 0         0 $tagTablePtr = GetTagTable('Image::ExifTool::IPTC::Main');
1162             }
1163             # process non-EXIF and non-APP1 profile as-is
1164 1 50       11 if ($outBuff) {
1165             # no need to rewrite this if not editing tags in this directory
1166 0         0 my $dir = $tagName;
1167 0 0       0 $dir =~ s/_Profile// unless $dir =~ /^ICC/;
1168 0 0       0 return 1 unless $$editDirs{$dir};
1169 0         0 $$outBuff = $et->WriteDirectory(\%dirInfo, $tagTablePtr);
1170 0         0 DoneDir($et, $dir, $outBuff, $$tagInfo{NonStandard});
1171             } else {
1172 1         15 $processed = $et->ProcessDirectory(\%dirInfo, $tagTablePtr);
1173             }
1174             } elsif ($buff =~ /^$Image::ExifTool::exifAPP1hdr/) {
1175             # APP1 EXIF information
1176 0 0 0     0 return 1 if $outBuff and not $$editDirs{IFD0};
1177 0         0 my $hdrLen = length($Image::ExifTool::exifAPP1hdr);
1178 0         0 $dirInfo{DirStart} += $hdrLen;
1179 0         0 $dirInfo{DirLen} -= $hdrLen;
1180 0 0       0 if ($outBuff) {
1181             # delete non-standard EXIF if recreating from scratch
1182 0 0 0     0 if ($$et{DEL_GROUP}{EXIF} or $$et{DEL_GROUP}{IFD0}) {
1183 0         0 $$outBuff = '';
1184 0         0 $et->VPrint(0, ' Deleting non-standard APP1 EXIF information');
1185 0         0 return 1;
1186             }
1187 0         0 $$outBuff = $et->WriteDirectory(\%dirInfo, $tagTablePtr,
1188             \&Image::ExifTool::WriteTIFF);
1189 0 0       0 $$outBuff = $Image::ExifTool::exifAPP1hdr . $$outBuff if $$outBuff;
1190 0         0 DoneDir($et, 'IFD0', $outBuff, $$tagInfo{NonStandard});
1191             } else {
1192 0         0 $processed = $et->ProcessTIFF(\%dirInfo);
1193             }
1194             } elsif ($buff =~ /^$Image::ExifTool::xmpAPP1hdr/) {
1195             # APP1 XMP information
1196 0         0 my $hdrLen = length($Image::ExifTool::xmpAPP1hdr);
1197 0         0 my $tagTablePtr = GetTagTable('Image::ExifTool::XMP::Main');
1198 0         0 $dirInfo{DirStart} += $hdrLen;
1199 0         0 $dirInfo{DirLen} -= $hdrLen;
1200 0 0       0 if ($outBuff) {
1201 0 0       0 return 1 unless $$editDirs{XMP};
1202 0         0 $$outBuff = $et->WriteDirectory(\%dirInfo, $tagTablePtr);
1203 0 0       0 $$outBuff and $$outBuff = $Image::ExifTool::xmpAPP1hdr . $$outBuff;
1204 0         0 DoneDir($et, 'XMP', $outBuff, $$tagInfo{NonStandard});
1205             } else {
1206 0         0 $processed = $et->ProcessDirectory(\%dirInfo, $tagTablePtr);
1207             }
1208             } elsif ($buff =~ /^(MM\0\x2a|II\x2a\0)/) {
1209             # TIFF information
1210 0 0 0     0 return 1 if $outBuff and not $$editDirs{IFD0};
1211 0 0       0 if ($outBuff) {
1212             # delete non-standard EXIF if recreating from scratch
1213 0 0 0     0 if ($$et{DEL_GROUP}{EXIF} or $$et{DEL_GROUP}{IFD0}) {
1214 0         0 $$outBuff = '';
1215 0         0 $et->VPrint(0, ' Deleting non-standard EXIF/TIFF information');
1216 0         0 return 1;
1217             }
1218 0         0 $$outBuff = $et->WriteDirectory(\%dirInfo, $tagTablePtr,
1219             \&Image::ExifTool::WriteTIFF);
1220 0         0 DoneDir($et, 'IFD0', $outBuff, $$tagInfo{NonStandard});
1221             } else {
1222 0         0 $processed = $et->ProcessTIFF(\%dirInfo);
1223             }
1224             } else {
1225 0         0 my $profName = $profileType;
1226 0         0 $profName =~ tr/\x00-\x1f\x7f-\xff/./;
1227 0         0 $et->Warn("Unknown raw profile '${profName}'");
1228             }
1229 1 0 33     9 if ($outBuff and defined $$outBuff and length $$outBuff) {
      33        
1230 0 0       0 if ($$et{CHANGED} != $oldChanged) {
1231 0         0 my $hdr = sprintf("\n%s\n%8d\n", $profileType, length($$outBuff));
1232             # hex encode the data
1233 0         0 $$outBuff = $hdr . HexEncode($outBuff);
1234             } else {
1235 0         0 undef $$outBuff;
1236             }
1237             }
1238 1         5 return $processed;
1239             }
1240              
1241             #------------------------------------------------------------------------------
1242             # Process PNG compressed zTXt or iCCP chunk
1243             # Inputs: 0) ExifTool object reference, 1) DirInfo reference, 2) Pointer to tag table
1244             # Returns: 1 on success
1245             # Notes: writes new chunk data to ${$$dirInfo{OutBuff}} if writing tag
1246             sub ProcessPNG_Compressed($$$)
1247             {
1248 2     2 0 7 my ($et, $dirInfo, $tagTablePtr) = @_;
1249 2         4 my ($tag, $val) = split /\0/, ${$$dirInfo{DataPt}}, 2;
  2         12  
1250 2 50       9 return 0 unless defined $val;
1251             # set compressed to 2 + compression method to decompress the data
1252 2         7 my $compressed = 2 + unpack('C', $val);
1253 2         10 my $hdr = $tag . "\0" . substr($val, 0, 1);
1254 2         7 $val = substr($val, 1); # remove compression method byte
1255 2         5 my $success;
1256 2         5 my $outBuff = $$dirInfo{OutBuff};
1257 2         6 my $tagInfo = $$dirInfo{TagInfo};
1258             # use the PNG chunk tag instead of the embedded tag name for iCCP chunks
1259 2 100 66     13 if ($tagInfo and $$tagInfo{Name} eq 'ICC_Profile') {
1260 1         8 $et->VerboseDir('iCCP');
1261 1         3 $tagTablePtr = \%Image::ExifTool::PNG::Main;
1262 1 50 33     11 FoundPNG($et, $tagTablePtr, 'iCCP-name', $tag) if length($tag) and not $outBuff;
1263 1         10 $success = FoundPNG($et, $tagTablePtr, 'iCCP', $val, $compressed, $outBuff);
1264 1 50 33     9 if ($outBuff and $$outBuff) {
1265 0         0 my $profileName = $et->GetNewValue($Image::ExifTool::PNG::Main{'iCCP-name'});
1266 0 0       0 if (defined $profileName) {
1267 0         0 $hdr = $profileName . substr($hdr, length $tag);
1268 0         0 $et->VerboseValue("+ PNG:ProfileName", $profileName);
1269             }
1270 0         0 $$outBuff = $hdr . $$outBuff;
1271             }
1272             } else {
1273 1         4 $success = FoundPNG($et, $tagTablePtr, $tag, $val, $compressed, $outBuff, 'Latin');
1274             }
1275 2         7 return $success;
1276             }
1277              
1278             #------------------------------------------------------------------------------
1279             # Process PNG tEXt chunk
1280             # Inputs: 0) ExifTool object reference, 1) DirInfo reference, 2) Pointer to tag table
1281             # Returns: 1 on success
1282             # Notes: writes new chunk data to ${$$dirInfo{OutBuff}} if writing tag
1283             sub ProcessPNG_tEXt($$$)
1284             {
1285 21     21 0 65 my ($et, $dirInfo, $tagTablePtr) = @_;
1286 21         41 my ($tag, $val) = split /\0/, ${$$dirInfo{DataPt}}, 2;
  21         131  
1287 21         55 my $outBuff = $$dirInfo{OutBuff};
1288 21 100       71 $$et{INDENT} = substr($$et{INDENT}, 0, -2) if $$et{OPTIONS}{Verbose};
1289 21         98 return FoundPNG($et, $tagTablePtr, $tag, $val, undef, $outBuff, 'Latin');
1290             }
1291              
1292             #------------------------------------------------------------------------------
1293             # Process PNG iTXt chunk
1294             # Inputs: 0) ExifTool object reference, 1) DirInfo reference, 2) Pointer to tag table
1295             # Returns: 1 on success
1296             # Notes: writes new chunk data to ${$$dirInfo{OutBuff}} if writing tag
1297             sub ProcessPNG_iTXt($$$)
1298             {
1299 12     12 0 54 my ($et, $dirInfo, $tagTablePtr) = @_;
1300 12         49 my ($tag, $dat) = split /\0/, ${$$dirInfo{DataPt}}, 2;
  12         82  
1301 12 50 33     79 return 0 unless defined $dat and length($dat) >= 4;
1302 12         54 my ($compressed, $meth) = unpack('CC', $dat);
1303 12         82 my ($lang, $trans, $val) = split /\0/, substr($dat, 2), 3;
1304             # set compressed flag so we will decompress it in FoundPNG()
1305 12 50       33 $compressed and $compressed = 2 + $meth;
1306 12         33 my $outBuff = $$dirInfo{OutBuff};
1307 12 100       60 $$et{INDENT} = substr($$et{INDENT}, 0, -2) if $$et{OPTIONS}{Verbose};
1308 12         40 return FoundPNG($et, $tagTablePtr, $tag, $val, $compressed, $outBuff, 'UTF8', $lang);
1309             }
1310              
1311             #------------------------------------------------------------------------------
1312             # Process PNG eXIf/zXIf chunk
1313             # Inputs: 0) ExifTool object reference, 1) DirInfo reference, 2) Pointer to tag table
1314             # Returns: 1 on success
1315             # Notes: writes new chunk data to ${$$dirInfo{OutBuff}} if writing tag
1316             sub ProcessPNG_eXIf($$$)
1317             {
1318 2     2 0 8 my ($et, $dirInfo, $tagTablePtr) = @_;
1319 2         10 my $outBuff = $$dirInfo{OutBuff};
1320 2         6 my $dataPt = $$dirInfo{DataPt};
1321 2         6 my $tagInfo = $$dirInfo{TagInfo};
1322 2         6 my $tag = $$tagInfo{TagID};
1323 2   33     10 my $del = $outBuff && ($$et{DEL_GROUP}{EXIF} or $$et{DEL_GROUP}{IFD0});
1324 2         4 my $type;
1325              
1326 2 50       11 if ($$dataPt =~ /^Exif\0\0/) {
1327 0         0 $et->Warn('Improper "Exif00" header in EXIF chunk');
1328 0         0 $$dataPt = substr($$dataPt, 6);
1329 0         0 $$dirInfo{DataLen} = length $$dataPt;
1330 0 0       0 $$dirInfo{DirLen} -= 6 if $$dirInfo{DirLen};
1331             }
1332 2 50       16 if ($$dataPt =~ /^(\0|II|MM)/) {
    0          
1333 2         9 $type = $1;
1334             } elsif ($del) {
1335 0         0 $et->VPrint(0, " Deleting invalid $tag chunk");
1336 0         0 $$outBuff = '';
1337 0         0 ++$$et{CHANGED};
1338 0         0 return 1;
1339             } else {
1340 0         0 $et->Warn("Invalid $tag chunk");
1341 0         0 return 0;
1342             }
1343 2 50 0     12 if ($type eq "\0") { # is this compressed EXIF?
    50          
    0          
    0          
1344 0         0 my $buf = substr($$dataPt, 5);
1345             # go around again to uncompress the data
1346 0         0 $tagTablePtr = GetTagTable('Image::ExifTool::PNG::Main');
1347 0         0 return FoundPNG($et, $tagTablePtr, $$tagInfo{TagID}, \$buf, 2, $outBuff);
1348             } elsif (not $outBuff) {
1349 2         10 return $et->ProcessTIFF($dirInfo);
1350             # (zxIf was not adopted)
1351             #} elsif ($del and ($et->Options('Compress') xor lc($tag) eq 'zxif')) {
1352             } elsif ($del and lc($tag) eq 'zxif') {
1353 0         0 $et->VPrint(0, " Deleting $tag chunk");
1354 0         0 $$outBuff = '';
1355 0         0 ++$$et{CHANGED};
1356             } elsif ($$et{EDIT_DIRS}{IFD0}) {
1357 0         0 $$outBuff = $et->WriteDirectory($dirInfo, $tagTablePtr,
1358             \&Image::ExifTool::WriteTIFF);
1359 0         0 DoneDir($et, 'IFD0', $outBuff, $$tagInfo{NonStandard});
1360             }
1361 0         0 return 1;
1362             }
1363              
1364             #------------------------------------------------------------------------------
1365             # Extract meta information from a PNG image
1366             # Inputs: 0) ExifTool object reference, 1) dirInfo reference
1367             # Returns: 1 on success, 0 if this wasn't a valid PNG image, or -1 on write error
1368             sub ProcessPNG($$)
1369             {
1370 12     12 0 37 my ($et, $dirInfo) = @_;
1371 12         58 my $outfile = $$dirInfo{OutFile};
1372 12         34 my $raf = $$dirInfo{RAF};
1373 12         27 my $datChunk = '';
1374 12         24 my $datCount = 0;
1375 12         23 my $datBytes = 0;
1376 12         45 my $fastScan = $et->Options('FastScan');
1377 12         49 my $md5 = $$et{ImageDataMD5};
1378 12         54 my ($n, $sig, $err, $hbuf, $dbuf, $cbuf);
1379 12         0 my ($wasHdr, $wasEnd, $wasDat, $doTxt, @txtOffset);
1380              
1381             # check to be sure this is a valid PNG/MNG/JNG image
1382 12 50 33     48 return 0 unless $raf->Read($sig,8) == 8 and $pngLookup{$sig};
1383              
1384 12 100       69 if ($outfile) {
1385 5         17 delete $$et{TextChunkType};
1386 5 50 50     40 Write($outfile, $sig) or $err = 1 if $outfile;
1387             # can only add tags in Main and TextualData tables
1388 5         44 $$et{ADD_PNG} = $et->GetNewTagInfoHash(
1389             \%Image::ExifTool::PNG::Main,
1390             \%Image::ExifTool::PNG::TextualData);
1391             # initialize with same directories, with PNG tags taking priority
1392 5         29 $et->InitWriteDirs(\%pngMap,'PNG');
1393             } else {
1394             # disable buffering in FastScan mode
1395 7 50       19 $$raf{NoBuffer} = 1 if $fastScan;
1396             }
1397 12         34 my ($fileType, $hdrChunk, $endChunk) = @{$pngLookup{$sig}};
  12         51  
1398 12         71 $et->SetFileType($fileType); # set the FileType tag
1399 12         96 SetByteOrder('MM'); # PNG files are big-endian
1400 12         930 my $tagTablePtr = GetTagTable('Image::ExifTool::PNG::Main');
1401 12         53 my $mngTablePtr;
1402 12 50       65 if ($fileType ne 'PNG') {
1403 0         0 $mngTablePtr = GetTagTable('Image::ExifTool::MNG::Main');
1404             }
1405 12         49 my $verbose = $et->Options('Verbose');
1406 12         66 my $validate = $et->Options('Validate');
1407 12         54 my $out = $et->Options('TextOut');
1408              
1409             # scan ahead to find offsets of all text chunks after IDAT
1410 12 100       73 if ($outfile) {
1411 5         29 while ($raf->Read($hbuf,8) == 8) {
1412 30         135 my ($len, $chunk) = unpack('Na4',$hbuf);
1413 30 50       76 last if $len > 0x7fffffff;
1414 30 100       89 if ($wasDat) {
    100          
1415 15 100       94 last if $noLeapFrog{$chunk}; # (don't move text across these chunks)
1416 10 50       60 push @txtOffset, $raf->Tell() - 8 if $isTxtChunk{$chunk};
1417             } elsif ($isDatChunk{$chunk}) {
1418 5         32 $wasDat = $chunk;
1419             }
1420 25 50       76 $raf->Seek($len + 4, 1) or last; # skip chunk data
1421             }
1422 5 50       24 $raf->Seek(8,0) or $et->Error('Error seeking in file'), return -1;
1423 5         17 undef $wasDat;
1424             }
1425              
1426             # process the PNG/MNG/JNG chunks
1427 12         38 undef $noCompressLib;
1428 12         120 for (;;) {
1429 110 100       338 if ($doTxt) {
1430             # read text chunks that were found after IDAT so we can write them before
1431 15 50       71 $raf->Seek(shift(@txtOffset), 0) or $et->Error('Seek error'), last;
1432             # (this is the IDAT offset if @txtOffset is now empty)
1433 15 100       54 undef $doTxt unless @txtOffset;
1434             }
1435 110         337 $n = $raf->Read($hbuf,8); # read chunk header
1436              
1437 110 100       369 if ($wasEnd) {
    50          
1438 7 50       27 last unless $n; # stop now if normal end of PNG
1439 0         0 $et->WarnOnce("Trailer data after $fileType $endChunk chunk", 1);
1440 0 0       0 last if $n < 8;
1441 0         0 $$et{SET_GROUP1} = 'Trailer';
1442             } elsif ($n != 8) {
1443 0 0       0 $et->Warn("Truncated $fileType image") unless $wasEnd;
1444 0         0 last;
1445             }
1446 103         396 my ($len, $chunk) = unpack('Na4',$hbuf);
1447 103 50       252 if ($len > 0x7fffffff) {
1448 0 0       0 $et->Warn("Invalid $fileType chunk size") unless $wasEnd;
1449 0         0 last;
1450             }
1451 103 100       221 if ($verbose) {
1452 9 100       43 print $out " Moving $chunk from after IDAT ($len bytes)\n" if $doTxt;
1453             # don't dump image data chunks in verbose mode (only give count instead)
1454 9 100 66     45 if ($datCount and $chunk ne $datChunk) {
1455 1 50       6 my $s = $datCount > 1 ? 's' : '';
1456 1         10 print $out "$fileType $datChunk ($datCount chunk$s, total $datBytes bytes)\n";
1457 1 50       8 print $out "$$et{INDENT}(ImageDataMD5: $datBytes bytes of $datChunk data)\n" if $md5;
1458 1         3 $datCount = $datBytes = 0;
1459             }
1460             }
1461 103 100       204 unless ($wasHdr) {
1462 12 50 0     34 if ($chunk eq $hdrChunk) {
    0          
1463 12         23 $wasHdr = 1;
1464             } elsif ($hdrChunk eq 'IHDR' and $chunk eq 'CgBI') {
1465 0         0 $et->Warn('Non-standard PNG image (Apple iPhone format)');
1466             } else {
1467 0         0 $et->WarnOnce("$fileType image did not start with $hdrChunk");
1468             }
1469             }
1470 103 100 100     428 if ($outfile and ($isDatChunk{$chunk} or $chunk eq $endChunk) and @txtOffset) {
      100        
      100        
1471             # continue processing here after we move the text chunks from after IDAT
1472 5         28 push @txtOffset, $raf->Tell() - 8;
1473 5         13 $doTxt = 1; # process text chunks now
1474 5         12 next;
1475             }
1476 98 100       221 if ($isDatChunk{$chunk}) {
1477 12 50 33     73 if ($fastScan and $fastScan >= 2) {
1478 0         0 $et->VPrint(0,"End processing at $chunk chunk due to FastScan=$fastScan setting");
1479 0         0 last;
1480             }
1481 12         31 $datChunk = $chunk;
1482 12         109 $datCount++;
1483 12         97 $datBytes += $len;
1484 12         25 $wasDat = $chunk;
1485             } else {
1486 86         145 $datChunk = '';
1487             }
1488 98 100       236 if ($outfile) {
1489             # add text chunks (including XMP) before any data chunk end chunk
1490 40 100 100     196 if ($datChunk or $chunk eq $endChunk) {
    50          
1491             # write iCCP chunk now if requested because AddChunks will try
1492             # to add it as a text profile chunk if this isn't successful
1493             # (ie. if Compress::Zlib wasn't available)
1494 10         60 Add_iCCP($et, $outfile);
1495 10 50       32 AddChunks($et, $outfile) or $err = 1; # add all text chunks
1496 10 50       46 AddChunks($et, $outfile, 'IFD0') or $err = 1; # and eXIf chunk
1497             } elsif ($chunk eq 'PLTE') {
1498             # iCCP chunk must come before PLTE (and IDAT, handled above)
1499             # (ignore errors -- will add later as text profile if this fails)
1500 0         0 Add_iCCP($et, $outfile);
1501             }
1502             }
1503 98 100       240 if ($chunk eq $endChunk) {
1504             # read CRC
1505 12 50       74 unless ($raf->Read($cbuf,4) == 4) {
1506 0 0       0 $et->Warn("Truncated $fileType $endChunk chunk") unless $wasEnd;
1507 0         0 last;
1508             }
1509 12 100       46 $verbose and print $out "$fileType $chunk (end of image)\n";
1510 12         29 $wasEnd = 1;
1511 12 100       39 if ($outfile) {
1512             # write the IEND/MEND chunk with CRC
1513 5 50       19 Write($outfile, $hbuf, $cbuf) or $err = 1;
1514 5 50       21 if ($$et{DEL_GROUP}{Trailer}) {
1515 0 0       0 if ($raf->Read($hbuf, 1)) {
1516 0 0       0 $verbose and printf $out " Deleting PNG trailer\n";
1517 0         0 ++$$et{CHANGED};
1518             }
1519             } else {
1520             # copy over any existing trailer data
1521 5         10 my $tot = 0;
1522 5         10 for (;;) {
1523 5 50       19 $n = $raf->Read($hbuf, 65536) or last;
1524 0         0 $tot += $n;
1525 0 0       0 Write($outfile, $hbuf) or $err = 1;
1526             }
1527 5 50 33     29 $tot and $verbose and printf $out " Copying PNG trailer ($tot bytes)\n";
1528             }
1529 5         19 last;
1530             }
1531 7         14 next;
1532             }
1533 86 100 66     309 if ($datChunk) {
    100          
1534 12         47 my $chunkSizeLimit = 10000000; # largest chunk to read into memory
1535 12 100 33     71 if ($outfile) {
    50          
1536             # avoid loading very large data chunks into memory
1537 5 50       29 if ($len > $chunkSizeLimit) {
1538 0 0       0 Write($outfile, $hbuf) or $err = 1;
1539 0 0       0 Image::ExifTool::CopyBlock($raf, $outfile, $len+4) or $et->Error("Error copying $datChunk");
1540 0         0 next;
1541             }
1542             # skip over data chunks if possible/necessary
1543             } elsif (not $validate or $len > $chunkSizeLimit) {
1544 7 50       29 if ($md5) {
1545 0         0 $et->ImageDataMD5($raf, $len);
1546 0 0       0 $raf->Read($cbuf, 4) == 4 or $et->Warn('Truncated data'), last;
1547             } else {
1548 7 50       31 $raf->Seek($len + 4, 1) or $et->Warn('Seek error'), last;
1549             }
1550 7         34 next;
1551             }
1552             } elsif ($wasDat and $isTxtChunk{$chunk}) {
1553 15         38 my $msg;
1554 15 100       48 if (not $outfile) {
    50          
1555 5         8 $msg = 'may be ignored by some readers';
1556             } elsif (defined $doTxt) { # $doTxt == 0 if we crossed a noLeapFrog chunk
1557 0         0 $msg = "can't be moved"; # (but could be deleted then added back again)
1558             } else {
1559 10         19 $msg = 'fixed';
1560             }
1561 15         108 $et->WarnOnce("Text/EXIF chunk(s) found after $$et{FileType} $wasDat ($msg)", 1);
1562             }
1563             # read chunk data and CRC
1564 79 50 33     201 unless ($raf->Read($dbuf,$len)==$len and $raf->Read($cbuf, 4)==4) {
1565 0 0       0 $et->Warn("Corrupted $fileType image") unless $wasEnd;
1566 0         0 last;
1567             }
1568 79 50 33     232 $md5->add($dbuf) if $md5 and $datChunk; # add to MD5 if necessary
1569 79 100 66     437 if ($verbose or $validate or ($outfile and not $fastScan)) {
      66        
      100        
1570             # check CRC when in verbose mode (since we don't care about speed)
1571 35         135 my $crc = CalculateCRC(\$hbuf, undef, 4);
1572 35         98 $crc = CalculateCRC(\$dbuf, $crc);
1573 35 50       143 unless ($crc == unpack('N',$cbuf)) {
1574 0         0 my $msg = "Bad CRC for $chunk chunk";
1575 0 0       0 $outfile ? $et->Error($msg, 1) : $et->Warn($msg);
1576             }
1577 35 100       78 if ($datChunk) {
1578 5 50 50     51 Write($outfile, $hbuf, $dbuf, $cbuf) or $err = 1 if $outfile;
1579 5         13 next;
1580             }
1581             # just skip over any text chunk found after IDAT
1582 30 100 66     125 if ($outfile and $wasDat) {
1583 10 50 33     72 if ($isTxtChunk{$chunk} and not defined $doTxt) {
1584 10 50       47 ++$$et{CHANGED} if $$et{FORCE_WRITE}{PNG};
1585 10 100       33 print $out " Deleting $chunk that was moved ($len bytes)\n" if $verbose;
1586 10         24 next;
1587             }
1588             # done moving text if we hit one of these chunks
1589 0 0       0 $doTxt = 0 if $noLeapFrog{$chunk};
1590             }
1591 20 100       47 if ($verbose) {
1592 4         15 print $out "$fileType $chunk ($len bytes):\n";
1593 4 50       28 $et->VerboseDump(\$dbuf, Addr => $raf->Tell() - $len - 4) if $verbose > 2;
1594             }
1595             }
1596             # translate case of chunk names that have changed since the first implementation
1597 64 50 33     268 if (not $$tagTablePtr{$chunk} and $stdCase{lc $chunk}) {
1598 0         0 my $stdChunk = $stdCase{lc $chunk};
1599 0 0 0     0 if ($outfile and ($$et{EDIT_DIRS}{IFD0} or $stdChunk !~ /^[ez]xif$/i)) {
      0        
1600 0         0 $et->Warn("Changed $chunk chunk to $stdChunk", 1);
1601 0         0 ++$$et{CHANGED};
1602             } else {
1603 0         0 $et->Warn("$chunk chunk should be $stdChunk", 1);
1604             }
1605 0         0 $chunk = $stdCase{lc $chunk};
1606             }
1607             # only extract information from chunks in our tables
1608 64         123 my ($theBuff, $outBuff);
1609 64 100       132 $outBuff = \$theBuff if $outfile;
1610 64 50 0     132 if ($$tagTablePtr{$chunk}) {
    0          
1611 64         168 FoundPNG($et, $tagTablePtr, $chunk, $dbuf, undef, $outBuff);
1612             } elsif ($mngTablePtr and $$mngTablePtr{$chunk}) {
1613 0         0 FoundPNG($et, $mngTablePtr, $chunk, $dbuf, undef, $outBuff);
1614             }
1615 64 100       177 if ($outfile) {
1616 20 100       59 if (defined $theBuff) {
1617 5 100       315 next unless length $theBuff; # empty if we deleted the information
1618             # change chunk type if necessary
1619 3 50       14 if ($$et{TextChunkType}) {
1620 3         9 $chunk = $$et{TextChunkType};
1621 3         11 delete $$et{TextChunkType};
1622             }
1623 3         23 $hbuf = pack('Na4', length($theBuff), $chunk);
1624 3         11 $dbuf = $theBuff;
1625 3         16 my $crc = CalculateCRC(\$hbuf, undef, 4);
1626 3         13 $crc = CalculateCRC(\$dbuf, $crc);
1627 3         16 $cbuf = pack('N', $crc);
1628             }
1629 18 50       75 Write($outfile, $hbuf, $dbuf, $cbuf) or $err = 1;
1630             }
1631             }
1632 12         27 delete $$et{SET_GROUP1};
1633 12 50 33     66 return -1 if $outfile and ($err or not $wasEnd);
      66        
1634 12         57 return 1; # this was a valid PNG/MNG/JNG image
1635             }
1636              
1637             1; # end
1638              
1639             __END__