File Coverage

blib/lib/Image/ExifTool/PNG.pm
Criterion Covered Total %
statement 304 512 59.3
branch 179 412 43.4
condition 96 233 41.2
subroutine 13 15 86.6
pod 0 11 0.0
total 592 1183 50.0


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