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