| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | #------------------------------------------------------------------------------ | 
| 2 |  |  |  |  |  |  | # File:         Photoshop.pm | 
| 3 |  |  |  |  |  |  | # | 
| 4 |  |  |  |  |  |  | # Description:  Read/write Photoshop IRB meta information | 
| 5 |  |  |  |  |  |  | # | 
| 6 |  |  |  |  |  |  | # Revisions:    02/06/2004 - P. Harvey Created | 
| 7 |  |  |  |  |  |  | #               02/25/2004 - P. Harvey Added hack for problem with old photoshops | 
| 8 |  |  |  |  |  |  | #               10/04/2004 - P. Harvey Added a bunch of tags (ref Image::MetaData::JPEG) | 
| 9 |  |  |  |  |  |  | #                            but left most of them commented out until I have enough | 
| 10 |  |  |  |  |  |  | #                            information to write PrintConv routines for them to | 
| 11 |  |  |  |  |  |  | #                            display something useful | 
| 12 |  |  |  |  |  |  | #               07/08/2005 - P. Harvey Added support for reading PSD files | 
| 13 |  |  |  |  |  |  | #               01/07/2006 - P. Harvey Added PSD write support | 
| 14 |  |  |  |  |  |  | #               11/04/2006 - P. Harvey Added handling of resource name | 
| 15 |  |  |  |  |  |  | # | 
| 16 |  |  |  |  |  |  | # References:   1) http://www.fine-view.com/jp/lab/doc/ps6ffspecsv2.pdf | 
| 17 |  |  |  |  |  |  | #               2) http://www.ozhiker.com/electronics/pjmt/jpeg_info/irb_jpeg_qual.html | 
| 18 |  |  |  |  |  |  | #               3) Matt Mueller private communication (tests with PS CS2) | 
| 19 |  |  |  |  |  |  | #               4) http://www.fileformat.info/format/psd/egff.htm | 
| 20 |  |  |  |  |  |  | #               5) http://www.telegraphics.com.au/svn/psdparse/trunk/resources.c | 
| 21 |  |  |  |  |  |  | #               6) http://libpsd.graphest.com/files/Photoshop%20File%20Formats.pdf | 
| 22 |  |  |  |  |  |  | #               7) http://www.adobe.com/devnet-apps/photoshop/fileformatashtml/ | 
| 23 |  |  |  |  |  |  | #------------------------------------------------------------------------------ | 
| 24 |  |  |  |  |  |  |  | 
| 25 |  |  |  |  |  |  | package Image::ExifTool::Photoshop; | 
| 26 |  |  |  |  |  |  |  | 
| 27 | 23 |  |  | 23 |  | 4628 | use strict; | 
|  | 23 |  |  |  |  | 56 |  | 
|  | 23 |  |  |  |  | 975 |  | 
| 28 | 23 |  |  | 23 |  | 155 | use vars qw($VERSION $AUTOLOAD $iptcDigestInfo %printFlags); | 
|  | 23 |  |  |  |  | 50 |  | 
|  | 23 |  |  |  |  | 1813 |  | 
| 29 | 23 |  |  | 23 |  | 158 | use Image::ExifTool qw(:DataAccess :Utils); | 
|  | 23 |  |  |  |  | 57 |  | 
|  | 23 |  |  |  |  | 136159 |  | 
| 30 |  |  |  |  |  |  |  | 
| 31 |  |  |  |  |  |  | $VERSION = '1.69'; | 
| 32 |  |  |  |  |  |  |  | 
| 33 |  |  |  |  |  |  | sub ProcessPhotoshop($$$); | 
| 34 |  |  |  |  |  |  | sub WritePhotoshop($$$); | 
| 35 |  |  |  |  |  |  | sub ProcessLayers($$$); | 
| 36 |  |  |  |  |  |  |  | 
| 37 |  |  |  |  |  |  | # PrintFlags bit definitions (ref forum13785) | 
| 38 |  |  |  |  |  |  | %printFlags = ( | 
| 39 |  |  |  |  |  |  | 0 => 'Labels', | 
| 40 |  |  |  |  |  |  | 1 => 'Corner crop marks', | 
| 41 |  |  |  |  |  |  | 2 => 'Color bars', # (deprecated) | 
| 42 |  |  |  |  |  |  | 3 => 'Registration marks', | 
| 43 |  |  |  |  |  |  | 4 => 'Negative', | 
| 44 |  |  |  |  |  |  | 5 => 'Emulsion down', | 
| 45 |  |  |  |  |  |  | 6 => 'Interpolate', # (deprecated) | 
| 46 |  |  |  |  |  |  | 7 => 'Description', | 
| 47 |  |  |  |  |  |  | 8 => 'Print flags', | 
| 48 |  |  |  |  |  |  | ); | 
| 49 |  |  |  |  |  |  |  | 
| 50 |  |  |  |  |  |  | # map of where information is stored in PSD image | 
| 51 |  |  |  |  |  |  | my %psdMap = ( | 
| 52 |  |  |  |  |  |  | IPTC         => 'Photoshop', | 
| 53 |  |  |  |  |  |  | XMP          => 'Photoshop', | 
| 54 |  |  |  |  |  |  | EXIFInfo     => 'Photoshop', | 
| 55 |  |  |  |  |  |  | IFD0         => 'EXIFInfo', | 
| 56 |  |  |  |  |  |  | IFD1         => 'IFD0', | 
| 57 |  |  |  |  |  |  | ICC_Profile  => 'Photoshop', | 
| 58 |  |  |  |  |  |  | ExifIFD      => 'IFD0', | 
| 59 |  |  |  |  |  |  | GPS          => 'IFD0', | 
| 60 |  |  |  |  |  |  | SubIFD       => 'IFD0', | 
| 61 |  |  |  |  |  |  | GlobParamIFD => 'IFD0', | 
| 62 |  |  |  |  |  |  | PrintIM      => 'IFD0', | 
| 63 |  |  |  |  |  |  | InteropIFD   => 'ExifIFD', | 
| 64 |  |  |  |  |  |  | MakerNotes   => 'ExifIFD', | 
| 65 |  |  |  |  |  |  | ); | 
| 66 |  |  |  |  |  |  |  | 
| 67 |  |  |  |  |  |  | # tag information for PhotoshopThumbnail and PhotoshopBGRThumbnail | 
| 68 |  |  |  |  |  |  | my %thumbnailInfo = ( | 
| 69 |  |  |  |  |  |  | Writable => 'undef', | 
| 70 |  |  |  |  |  |  | Protected => 1, | 
| 71 |  |  |  |  |  |  | RawConv => 'my $img=substr($val,0x1c); $self->ValidateImage(\$img,$tag)', | 
| 72 |  |  |  |  |  |  | ValueConvInv => q{ | 
| 73 |  |  |  |  |  |  | my $et = new Image::ExifTool; | 
| 74 |  |  |  |  |  |  | my @tags = qw{ImageWidth ImageHeight FileType}; | 
| 75 |  |  |  |  |  |  | my $info = $et->ImageInfo(\$val, @tags); | 
| 76 |  |  |  |  |  |  | my ($w, $h, $type) = @$info{@tags}; | 
| 77 |  |  |  |  |  |  | $w and $h and $type and $type eq 'JPEG' or warn("Not a valid JPEG image\n"), return undef; | 
| 78 |  |  |  |  |  |  | my $wbytes = int(($w * 24 + 31) / 32) * 4; | 
| 79 |  |  |  |  |  |  | return pack('N6n2', 1, $w, $h, $wbytes, $wbytes * $h, length($val), 24, 1) . $val; | 
| 80 |  |  |  |  |  |  | }, | 
| 81 |  |  |  |  |  |  | ); | 
| 82 |  |  |  |  |  |  |  | 
| 83 |  |  |  |  |  |  | # tag info to decode Photoshop Unicode string | 
| 84 |  |  |  |  |  |  | my %unicodeString = ( | 
| 85 |  |  |  |  |  |  | ValueConv => sub { | 
| 86 |  |  |  |  |  |  | my ($val, $et) = @_; | 
| 87 |  |  |  |  |  |  | return '' if length($val) < 4; | 
| 88 |  |  |  |  |  |  | my $len = unpack('N', $val) * 2; | 
| 89 |  |  |  |  |  |  | return '' if length($val) < 4 + $len; | 
| 90 |  |  |  |  |  |  | return $et->Decode(substr($val, 4, $len), 'UCS2', 'MM'); | 
| 91 |  |  |  |  |  |  | }, | 
| 92 |  |  |  |  |  |  | ValueConvInv => sub { | 
| 93 |  |  |  |  |  |  | my ($val, $et) = @_; | 
| 94 |  |  |  |  |  |  | return pack('N', length $val) . $et->Encode($val, 'UCS2', 'MM'); | 
| 95 |  |  |  |  |  |  | }, | 
| 96 |  |  |  |  |  |  | ); | 
| 97 |  |  |  |  |  |  |  | 
| 98 |  |  |  |  |  |  | # Photoshop APP13 tag table | 
| 99 |  |  |  |  |  |  | # (set Unknown flag for information we don't want to display normally) | 
| 100 |  |  |  |  |  |  | %Image::ExifTool::Photoshop::Main = ( | 
| 101 |  |  |  |  |  |  | GROUPS => { 2 => 'Image' }, | 
| 102 |  |  |  |  |  |  | PROCESS_PROC => \&ProcessPhotoshop, | 
| 103 |  |  |  |  |  |  | WRITE_PROC => \&WritePhotoshop, | 
| 104 |  |  |  |  |  |  | 0x03e8 => { Unknown => 1, Name => 'Photoshop2Info' }, | 
| 105 |  |  |  |  |  |  | 0x03e9 => { Unknown => 1, Name => 'MacintoshPrintInfo' }, | 
| 106 |  |  |  |  |  |  | 0x03ea => { Unknown => 1, Name => 'XMLData', Binary => 1 }, #PH | 
| 107 |  |  |  |  |  |  | 0x03eb => { Unknown => 1, Name => 'Photoshop2ColorTable' }, | 
| 108 |  |  |  |  |  |  | 0x03ed => { | 
| 109 |  |  |  |  |  |  | Name => 'ResolutionInfo', | 
| 110 |  |  |  |  |  |  | SubDirectory => { | 
| 111 |  |  |  |  |  |  | TagTable => 'Image::ExifTool::Photoshop::Resolution', | 
| 112 |  |  |  |  |  |  | }, | 
| 113 |  |  |  |  |  |  | }, | 
| 114 |  |  |  |  |  |  | 0x03ee => { | 
| 115 |  |  |  |  |  |  | Name => 'AlphaChannelsNames', | 
| 116 |  |  |  |  |  |  | ValueConv => 'Image::ExifTool::Photoshop::ConvertPascalString($self,$val)', | 
| 117 |  |  |  |  |  |  | }, | 
| 118 |  |  |  |  |  |  | 0x03ef => { Unknown => 1, Name => 'DisplayInfo' }, | 
| 119 |  |  |  |  |  |  | 0x03f0 => { Unknown => 1, Name => 'PStringCaption' }, | 
| 120 |  |  |  |  |  |  | 0x03f1 => { Unknown => 1, Name => 'BorderInformation' }, | 
| 121 |  |  |  |  |  |  | 0x03f2 => { Unknown => 1, Name => 'BackgroundColor' }, | 
| 122 |  |  |  |  |  |  | 0x03f3 => { | 
| 123 |  |  |  |  |  |  | Unknown => 1, | 
| 124 |  |  |  |  |  |  | Name => 'PrintFlags', | 
| 125 |  |  |  |  |  |  | Format => 'int8u', | 
| 126 |  |  |  |  |  |  | PrintConv => q{ | 
| 127 |  |  |  |  |  |  | my $byte = 0; | 
| 128 |  |  |  |  |  |  | my @bits = $val =~ /\d+/g; | 
| 129 |  |  |  |  |  |  | $byte = ($byte << 1) | ($_ ? 1 : 0) foreach reverse @bits; | 
| 130 |  |  |  |  |  |  | return DecodeBits($byte, \%Image::ExifTool::Photoshop::printFlags); | 
| 131 |  |  |  |  |  |  | }, | 
| 132 |  |  |  |  |  |  | }, | 
| 133 |  |  |  |  |  |  | 0x03f4 => { Unknown => 1, Name => 'BW_HalftoningInfo' }, | 
| 134 |  |  |  |  |  |  | 0x03f5 => { Unknown => 1, Name => 'ColorHalftoningInfo' }, | 
| 135 |  |  |  |  |  |  | 0x03f6 => { Unknown => 1, Name => 'DuotoneHalftoningInfo' }, | 
| 136 |  |  |  |  |  |  | 0x03f7 => { Unknown => 1, Name => 'BW_TransferFunc' }, | 
| 137 |  |  |  |  |  |  | 0x03f8 => { Unknown => 1, Name => 'ColorTransferFuncs' }, | 
| 138 |  |  |  |  |  |  | 0x03f9 => { Unknown => 1, Name => 'DuotoneTransferFuncs' }, | 
| 139 |  |  |  |  |  |  | 0x03fa => { Unknown => 1, Name => 'DuotoneImageInfo' }, | 
| 140 |  |  |  |  |  |  | 0x03fb => { Unknown => 1, Name => 'EffectiveBW', Format => 'int8u' }, | 
| 141 |  |  |  |  |  |  | 0x03fc => { Unknown => 1, Name => 'ObsoletePhotoshopTag1' }, | 
| 142 |  |  |  |  |  |  | 0x03fd => { Unknown => 1, Name => 'EPSOptions' }, | 
| 143 |  |  |  |  |  |  | 0x03fe => { Unknown => 1, Name => 'QuickMaskInfo' }, | 
| 144 |  |  |  |  |  |  | 0x03ff => { Unknown => 1, Name => 'ObsoletePhotoshopTag2' }, | 
| 145 |  |  |  |  |  |  | 0x0400 => { Unknown => 1, Name => 'TargetLayerID', Format => 'int16u' }, # (LayerStateInfo) | 
| 146 |  |  |  |  |  |  | 0x0401 => { Unknown => 1, Name => 'WorkingPath' }, | 
| 147 |  |  |  |  |  |  | 0x0402 => { Unknown => 1, Name => 'LayersGroupInfo', Format => 'int16u' }, | 
| 148 |  |  |  |  |  |  | 0x0403 => { Unknown => 1, Name => 'ObsoletePhotoshopTag3' }, | 
| 149 |  |  |  |  |  |  | 0x0404 => { | 
| 150 |  |  |  |  |  |  | Name => 'IPTCData', | 
| 151 |  |  |  |  |  |  | SubDirectory => { | 
| 152 |  |  |  |  |  |  | DirName => 'IPTC', | 
| 153 |  |  |  |  |  |  | TagTable => 'Image::ExifTool::IPTC::Main', | 
| 154 |  |  |  |  |  |  | }, | 
| 155 |  |  |  |  |  |  | }, | 
| 156 |  |  |  |  |  |  | 0x0405 => { Unknown => 1, Name => 'RawImageMode' }, | 
| 157 |  |  |  |  |  |  | 0x0406 => { #2 | 
| 158 |  |  |  |  |  |  | Name => 'JPEG_Quality', | 
| 159 |  |  |  |  |  |  | SubDirectory => { | 
| 160 |  |  |  |  |  |  | TagTable => 'Image::ExifTool::Photoshop::JPEG_Quality', | 
| 161 |  |  |  |  |  |  | }, | 
| 162 |  |  |  |  |  |  | }, | 
| 163 |  |  |  |  |  |  | 0x0408 => { Unknown => 1, Name => 'GridGuidesInfo' }, | 
| 164 |  |  |  |  |  |  | 0x0409 => { | 
| 165 |  |  |  |  |  |  | Name => 'PhotoshopBGRThumbnail', | 
| 166 |  |  |  |  |  |  | Notes => 'this is a JPEG image, but in BGR format instead of RGB', | 
| 167 |  |  |  |  |  |  | %thumbnailInfo, | 
| 168 |  |  |  |  |  |  | Groups => { 2 => 'Preview' }, | 
| 169 |  |  |  |  |  |  | }, | 
| 170 |  |  |  |  |  |  | 0x040a => { | 
| 171 |  |  |  |  |  |  | Name => 'CopyrightFlag', | 
| 172 |  |  |  |  |  |  | Writable => 'int8u', | 
| 173 |  |  |  |  |  |  | Groups => { 2 => 'Author' }, | 
| 174 |  |  |  |  |  |  | ValueConv => 'join(" ",unpack("C*", $val))', | 
| 175 |  |  |  |  |  |  | ValueConvInv => 'pack("C*",split(" ",$val))', | 
| 176 |  |  |  |  |  |  | PrintConv => { #3 | 
| 177 |  |  |  |  |  |  | 0 => 'False', | 
| 178 |  |  |  |  |  |  | 1 => 'True', | 
| 179 |  |  |  |  |  |  | }, | 
| 180 |  |  |  |  |  |  | }, | 
| 181 |  |  |  |  |  |  | 0x040b => { | 
| 182 |  |  |  |  |  |  | Name => 'URL', | 
| 183 |  |  |  |  |  |  | Writable => 'string', | 
| 184 |  |  |  |  |  |  | Groups => { 2 => 'Author' }, | 
| 185 |  |  |  |  |  |  | }, | 
| 186 |  |  |  |  |  |  | 0x040c => { | 
| 187 |  |  |  |  |  |  | Name => 'PhotoshopThumbnail', | 
| 188 |  |  |  |  |  |  | %thumbnailInfo, | 
| 189 |  |  |  |  |  |  | Groups => { 2 => 'Preview' }, | 
| 190 |  |  |  |  |  |  | }, | 
| 191 |  |  |  |  |  |  | 0x040d => { | 
| 192 |  |  |  |  |  |  | Name => 'GlobalAngle', | 
| 193 |  |  |  |  |  |  | Writable => 'int32u', | 
| 194 |  |  |  |  |  |  | ValueConv => 'unpack("N",$val)', | 
| 195 |  |  |  |  |  |  | ValueConvInv => 'pack("N",$val)', | 
| 196 |  |  |  |  |  |  | }, | 
| 197 |  |  |  |  |  |  | 0x040e => { Unknown => 1, Name => 'ColorSamplersResource' }, | 
| 198 |  |  |  |  |  |  | 0x040f => { | 
| 199 |  |  |  |  |  |  | Name => 'ICC_Profile', | 
| 200 |  |  |  |  |  |  | SubDirectory => { | 
| 201 |  |  |  |  |  |  | TagTable => 'Image::ExifTool::ICC_Profile::Main', | 
| 202 |  |  |  |  |  |  | }, | 
| 203 |  |  |  |  |  |  | }, | 
| 204 |  |  |  |  |  |  | 0x0410 => { Unknown => 1, Name => 'Watermark', Format => 'int8u' }, | 
| 205 |  |  |  |  |  |  | 0x0411 => { Unknown => 1, Name => 'ICC_Untagged', Format => 'int8u' }, | 
| 206 |  |  |  |  |  |  | 0x0412 => { Unknown => 1, Name => 'EffectsVisible', Format => 'int8u' }, | 
| 207 |  |  |  |  |  |  | 0x0413 => { Unknown => 1, Name => 'SpotHalftone' }, | 
| 208 |  |  |  |  |  |  | 0x0414 => { Unknown => 1, Name => 'IDsBaseValue', Description => 'IDs Base Value', Format => 'int32u' }, | 
| 209 |  |  |  |  |  |  | 0x0415 => { Unknown => 1, Name => 'UnicodeAlphaNames' }, | 
| 210 |  |  |  |  |  |  | 0x0416 => { Unknown => 1, Name => 'IndexedColorTableCount', Format => 'int16u' }, | 
| 211 |  |  |  |  |  |  | 0x0417 => { Unknown => 1, Name => 'TransparentIndex', Format => 'int16u' }, | 
| 212 |  |  |  |  |  |  | 0x0419 => { | 
| 213 |  |  |  |  |  |  | Name => 'GlobalAltitude', | 
| 214 |  |  |  |  |  |  | Writable => 'int32u', | 
| 215 |  |  |  |  |  |  | ValueConv => 'unpack("N",$val)', | 
| 216 |  |  |  |  |  |  | ValueConvInv => 'pack("N",$val)', | 
| 217 |  |  |  |  |  |  | }, | 
| 218 |  |  |  |  |  |  | 0x041a => { | 
| 219 |  |  |  |  |  |  | Name => 'SliceInfo', | 
| 220 |  |  |  |  |  |  | SubDirectory => { TagTable => 'Image::ExifTool::Photoshop::SliceInfo' }, | 
| 221 |  |  |  |  |  |  | }, | 
| 222 |  |  |  |  |  |  | 0x041b => { Name => 'WorkflowURL', %unicodeString }, | 
| 223 |  |  |  |  |  |  | 0x041c => { Unknown => 1, Name => 'JumpToXPEP' }, | 
| 224 |  |  |  |  |  |  | 0x041d => { Unknown => 1, Name => 'AlphaIdentifiers' }, | 
| 225 |  |  |  |  |  |  | 0x041e => { | 
| 226 |  |  |  |  |  |  | Name => 'URL_List', | 
| 227 |  |  |  |  |  |  | List => 1, | 
| 228 |  |  |  |  |  |  | Writable => 1, | 
| 229 |  |  |  |  |  |  | ValueConv => sub { | 
| 230 |  |  |  |  |  |  | my ($val, $et) = @_; | 
| 231 |  |  |  |  |  |  | return '' if length($val) < 4; | 
| 232 |  |  |  |  |  |  | my $num = unpack('N', $val); | 
| 233 |  |  |  |  |  |  | my ($i, @vals); | 
| 234 |  |  |  |  |  |  | my $pos = 4; | 
| 235 |  |  |  |  |  |  | for ($i=0; $i<$num; ++$i) { | 
| 236 |  |  |  |  |  |  | $pos += 8;  # (skip word and ID) | 
| 237 |  |  |  |  |  |  | last if length($val) < $pos + 4; | 
| 238 |  |  |  |  |  |  | my $len = unpack("x${pos}N", $val) * 2; | 
| 239 |  |  |  |  |  |  | last if length($val) < $pos + 4 + $len; | 
| 240 |  |  |  |  |  |  | push @vals, $et->Decode(substr($val,$pos+4,$len), 'UCS2', 'MM'); | 
| 241 |  |  |  |  |  |  | $pos += 4 + $len; | 
| 242 |  |  |  |  |  |  | } | 
| 243 |  |  |  |  |  |  | return \@vals; | 
| 244 |  |  |  |  |  |  | }, | 
| 245 |  |  |  |  |  |  | # (this is tricky to make writable) | 
| 246 |  |  |  |  |  |  | }, | 
| 247 |  |  |  |  |  |  | 0x0421 => { | 
| 248 |  |  |  |  |  |  | Name => 'VersionInfo', | 
| 249 |  |  |  |  |  |  | SubDirectory => { | 
| 250 |  |  |  |  |  |  | TagTable => 'Image::ExifTool::Photoshop::VersionInfo', | 
| 251 |  |  |  |  |  |  | }, | 
| 252 |  |  |  |  |  |  | }, | 
| 253 |  |  |  |  |  |  | 0x0422 => { | 
| 254 |  |  |  |  |  |  | Name => 'EXIFInfo', #PH (Found in EPS and PSD files) | 
| 255 |  |  |  |  |  |  | SubDirectory => { | 
| 256 |  |  |  |  |  |  | TagTable=> 'Image::ExifTool::Exif::Main', | 
| 257 |  |  |  |  |  |  | ProcessProc => \&Image::ExifTool::ProcessTIFF, | 
| 258 |  |  |  |  |  |  | WriteProc => \&Image::ExifTool::WriteTIFF, | 
| 259 |  |  |  |  |  |  | }, | 
| 260 |  |  |  |  |  |  | }, | 
| 261 |  |  |  |  |  |  | 0x0423 => { Unknown => 1, Name => 'ExifInfo2', Binary => 1 }, #5 | 
| 262 |  |  |  |  |  |  | 0x0424 => { | 
| 263 |  |  |  |  |  |  | Name => 'XMP', | 
| 264 |  |  |  |  |  |  | SubDirectory => { | 
| 265 |  |  |  |  |  |  | TagTable => 'Image::ExifTool::XMP::Main', | 
| 266 |  |  |  |  |  |  | }, | 
| 267 |  |  |  |  |  |  | }, | 
| 268 |  |  |  |  |  |  | 0x0425 => { | 
| 269 |  |  |  |  |  |  | Name => 'IPTCDigest', | 
| 270 |  |  |  |  |  |  | Writable => 'string', | 
| 271 |  |  |  |  |  |  | Protected => 1, | 
| 272 |  |  |  |  |  |  | Notes => q{ | 
| 273 |  |  |  |  |  |  | this tag indicates provides a way for XMP-aware applications to indicate | 
| 274 |  |  |  |  |  |  | that the XMP is synchronized with the IPTC.  The MWG recommendation is to | 
| 275 |  |  |  |  |  |  | ignore the XMP if IPTCDigest exists and doesn't match the CurrentIPTCDigest. | 
| 276 |  |  |  |  |  |  | When writing, special values of "new" and "old" represent the digests of the | 
| 277 |  |  |  |  |  |  | IPTC from the edited and original files respectively, and are undefined if | 
| 278 |  |  |  |  |  |  | the IPTC does not exist in the respective file.  Set this to "new" as an | 
| 279 |  |  |  |  |  |  | indication that the XMP is synchronized with the IPTC | 
| 280 |  |  |  |  |  |  | }, | 
| 281 |  |  |  |  |  |  | # also note the 'new' feature requires that the IPTC comes before this tag is written | 
| 282 |  |  |  |  |  |  | ValueConv => 'unpack("H*", $val)', | 
| 283 |  |  |  |  |  |  | ValueConvInv => q{ | 
| 284 |  |  |  |  |  |  | if (lc($val) eq 'new' or lc($val) eq 'old') { | 
| 285 |  |  |  |  |  |  | { | 
| 286 |  |  |  |  |  |  | local $SIG{'__WARN__'} = sub { }; | 
| 287 |  |  |  |  |  |  | return lc($val) if eval { require Digest::MD5 }; | 
| 288 |  |  |  |  |  |  | } | 
| 289 |  |  |  |  |  |  | warn "Digest::MD5 must be installed\n"; | 
| 290 |  |  |  |  |  |  | return undef; | 
| 291 |  |  |  |  |  |  | } | 
| 292 |  |  |  |  |  |  | return pack('H*', $val) if $val =~ /^[0-9a-f]{32}$/i; | 
| 293 |  |  |  |  |  |  | warn "Value must be 'new', 'old' or 32 hexadecimal digits\n"; | 
| 294 |  |  |  |  |  |  | return undef; | 
| 295 |  |  |  |  |  |  | } | 
| 296 |  |  |  |  |  |  | }, | 
| 297 |  |  |  |  |  |  | 0x0426 => { | 
| 298 |  |  |  |  |  |  | Name => 'PrintScaleInfo', | 
| 299 |  |  |  |  |  |  | SubDirectory => { TagTable => 'Image::ExifTool::Photoshop::PrintScaleInfo' }, | 
| 300 |  |  |  |  |  |  | }, | 
| 301 |  |  |  |  |  |  | 0x0428 => { | 
| 302 |  |  |  |  |  |  | Name => 'PixelInfo', | 
| 303 |  |  |  |  |  |  | SubDirectory => { TagTable => 'Image::ExifTool::Photoshop::PixelInfo' }, | 
| 304 |  |  |  |  |  |  | }, | 
| 305 |  |  |  |  |  |  | 0x0429 => { Unknown => 1, Name => 'LayerComps' }, #5 | 
| 306 |  |  |  |  |  |  | 0x042a => { Unknown => 1, Name => 'AlternateDuotoneColors' }, #5 | 
| 307 |  |  |  |  |  |  | 0x042b => { Unknown => 1, Name => 'AlternateSpotColors' }, #5 | 
| 308 |  |  |  |  |  |  | 0x042d => { #7 | 
| 309 |  |  |  |  |  |  | Name => 'LayerSelectionIDs', | 
| 310 |  |  |  |  |  |  | Description => 'Layer Selection IDs', | 
| 311 |  |  |  |  |  |  | Unknown => 1, | 
| 312 |  |  |  |  |  |  | ValueConv => q{ | 
| 313 |  |  |  |  |  |  | my ($n, @a) = unpack("nN*",$val); | 
| 314 |  |  |  |  |  |  | $#a = $n - 1 if $n > @a; | 
| 315 |  |  |  |  |  |  | return join(' ', @a); | 
| 316 |  |  |  |  |  |  | }, | 
| 317 |  |  |  |  |  |  | }, | 
| 318 |  |  |  |  |  |  | 0x042e => { Unknown => 1, Name => 'HDRToningInfo' }, #7 | 
| 319 |  |  |  |  |  |  | 0x042f => { Unknown => 1, Name => 'PrintInfo' }, #7 | 
| 320 |  |  |  |  |  |  | 0x0430 => { Unknown => 1, Name => 'LayerGroupsEnabledID', Format => 'int8u' }, #7 | 
| 321 |  |  |  |  |  |  | 0x0431 => { Unknown => 1, Name => 'ColorSamplersResource2' }, #7 | 
| 322 |  |  |  |  |  |  | 0x0432 => { Unknown => 1, Name => 'MeasurementScale' }, #7 | 
| 323 |  |  |  |  |  |  | 0x0433 => { Unknown => 1, Name => 'TimelineInfo' }, #7 | 
| 324 |  |  |  |  |  |  | 0x0434 => { Unknown => 1, Name => 'SheetDisclosure' }, #7 | 
| 325 |  |  |  |  |  |  | 0x0435 => { Unknown => 1, Name => 'DisplayInfo' }, #7 | 
| 326 |  |  |  |  |  |  | 0x0436 => { Unknown => 1, Name => 'OnionSkins' }, #7 | 
| 327 |  |  |  |  |  |  | 0x0438 => { Unknown => 1, Name => 'CountInfo' }, #7 | 
| 328 |  |  |  |  |  |  | 0x043a => { Unknown => 1, Name => 'PrintInfo2' }, #7 | 
| 329 |  |  |  |  |  |  | 0x043b => { Unknown => 1, Name => 'PrintStyle' }, #7 | 
| 330 |  |  |  |  |  |  | 0x043c => { Unknown => 1, Name => 'MacintoshNSPrintInfo' }, #7 | 
| 331 |  |  |  |  |  |  | 0x043d => { Unknown => 1, Name => 'WindowsDEVMODE' }, #7 | 
| 332 |  |  |  |  |  |  | 0x043e => { Unknown => 1, Name => 'AutoSaveFilePath' }, #7 | 
| 333 |  |  |  |  |  |  | 0x043f => { Unknown => 1, Name => 'AutoSaveFormat' }, #7 | 
| 334 |  |  |  |  |  |  | 0x0440 => { Unknown => 1, Name => 'PathSelectionState' }, #7 | 
| 335 |  |  |  |  |  |  | # 0x07d0-0x0bb6 Path information | 
| 336 |  |  |  |  |  |  | 0x0bb7 => { | 
| 337 |  |  |  |  |  |  | Name => 'ClippingPathName', | 
| 338 |  |  |  |  |  |  | # convert from a Pascal string (ignoring 6 bytes of unknown data after string) | 
| 339 |  |  |  |  |  |  | ValueConv => q{ | 
| 340 |  |  |  |  |  |  | my $len = ord($val); | 
| 341 |  |  |  |  |  |  | $val = substr($val, 0, $len+1) if $len < length($val); | 
| 342 |  |  |  |  |  |  | return Image::ExifTool::Photoshop::ConvertPascalString($self,$val); | 
| 343 |  |  |  |  |  |  | }, | 
| 344 |  |  |  |  |  |  | }, | 
| 345 |  |  |  |  |  |  | 0x0bb8 => { Unknown => 1, Name => 'OriginPathInfo' }, #7 | 
| 346 |  |  |  |  |  |  | # 0x0fa0-0x1387 - plug-in resources (ref 7) | 
| 347 |  |  |  |  |  |  | 0x1b58 => { Unknown => 1, Name => 'ImageReadyVariables' }, #7 | 
| 348 |  |  |  |  |  |  | 0x1b59 => { Unknown => 1, Name => 'ImageReadyDataSets' }, #7 | 
| 349 |  |  |  |  |  |  | 0x1f40 => { Unknown => 1, Name => 'LightroomWorkflow' }, #7 | 
| 350 |  |  |  |  |  |  | 0x2710 => { Unknown => 1, Name => 'PrintFlagsInfo' }, | 
| 351 |  |  |  |  |  |  | ); | 
| 352 |  |  |  |  |  |  |  | 
| 353 |  |  |  |  |  |  | # Photoshop JPEG quality record (ref 2) | 
| 354 |  |  |  |  |  |  | %Image::ExifTool::Photoshop::JPEG_Quality = ( | 
| 355 |  |  |  |  |  |  | PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData, | 
| 356 |  |  |  |  |  |  | WRITE_PROC => \&Image::ExifTool::WriteBinaryData, | 
| 357 |  |  |  |  |  |  | CHECK_PROC => \&Image::ExifTool::CheckBinaryData, | 
| 358 |  |  |  |  |  |  | DATAMEMBER => [ 1 ], | 
| 359 |  |  |  |  |  |  | FORMAT => 'int16s', | 
| 360 |  |  |  |  |  |  | GROUPS => { 2 => 'Image' }, | 
| 361 |  |  |  |  |  |  | 0 => { | 
| 362 |  |  |  |  |  |  | Name => 'PhotoshopQuality', | 
| 363 |  |  |  |  |  |  | Writable => 1, | 
| 364 |  |  |  |  |  |  | PrintConv => '$val + 4', | 
| 365 |  |  |  |  |  |  | PrintConvInv => '$val - 4', | 
| 366 |  |  |  |  |  |  | }, | 
| 367 |  |  |  |  |  |  | 1 => { | 
| 368 |  |  |  |  |  |  | Name => 'PhotoshopFormat', | 
| 369 |  |  |  |  |  |  | RawConv => '$$self{PhotoshopFormat} = $val', | 
| 370 |  |  |  |  |  |  | PrintConv => { | 
| 371 |  |  |  |  |  |  | 0x0000 => 'Standard', | 
| 372 |  |  |  |  |  |  | 0x0001 => 'Optimized', | 
| 373 |  |  |  |  |  |  | 0x0101 => 'Progressive', | 
| 374 |  |  |  |  |  |  | }, | 
| 375 |  |  |  |  |  |  | }, | 
| 376 |  |  |  |  |  |  | 2 => { | 
| 377 |  |  |  |  |  |  | Name => 'ProgressiveScans', | 
| 378 |  |  |  |  |  |  | Condition => '$$self{PhotoshopFormat} == 0x0101', | 
| 379 |  |  |  |  |  |  | PrintConv => { | 
| 380 |  |  |  |  |  |  | 1 => '3 Scans', | 
| 381 |  |  |  |  |  |  | 2 => '4 Scans', | 
| 382 |  |  |  |  |  |  | 3 => '5 Scans', | 
| 383 |  |  |  |  |  |  | }, | 
| 384 |  |  |  |  |  |  | }, | 
| 385 |  |  |  |  |  |  | ); | 
| 386 |  |  |  |  |  |  |  | 
| 387 |  |  |  |  |  |  | # Photoshop Slices | 
| 388 |  |  |  |  |  |  | %Image::ExifTool::Photoshop::SliceInfo = ( | 
| 389 |  |  |  |  |  |  | PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData, | 
| 390 |  |  |  |  |  |  | 20 => { Name => 'SlicesGroupName', Format => 'var_ustr32' }, | 
| 391 |  |  |  |  |  |  | 24 => { Name => 'NumSlices',       Format => 'int32u' }, | 
| 392 |  |  |  |  |  |  | ); | 
| 393 |  |  |  |  |  |  |  | 
| 394 |  |  |  |  |  |  | # Photoshop resolution information #PH | 
| 395 |  |  |  |  |  |  | %Image::ExifTool::Photoshop::Resolution = ( | 
| 396 |  |  |  |  |  |  | PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData, | 
| 397 |  |  |  |  |  |  | WRITE_PROC => \&Image::ExifTool::WriteBinaryData, | 
| 398 |  |  |  |  |  |  | CHECK_PROC => \&Image::ExifTool::CheckBinaryData, | 
| 399 |  |  |  |  |  |  | FORMAT => 'int16u', | 
| 400 |  |  |  |  |  |  | FIRST_ENTRY => 0, | 
| 401 |  |  |  |  |  |  | WRITABLE => 1, | 
| 402 |  |  |  |  |  |  | GROUPS => { 2 => 'Image' }, | 
| 403 |  |  |  |  |  |  | 0 => { | 
| 404 |  |  |  |  |  |  | Name => 'XResolution', | 
| 405 |  |  |  |  |  |  | Format => 'int32u', | 
| 406 |  |  |  |  |  |  | Priority => 0, | 
| 407 |  |  |  |  |  |  | ValueConv => '$val / 0x10000', | 
| 408 |  |  |  |  |  |  | ValueConvInv => 'int($val * 0x10000 + 0.5)', | 
| 409 |  |  |  |  |  |  | PrintConv => 'int($val * 100 + 0.5) / 100', | 
| 410 |  |  |  |  |  |  | PrintConvInv => '$val', | 
| 411 |  |  |  |  |  |  | }, | 
| 412 |  |  |  |  |  |  | 2 => { | 
| 413 |  |  |  |  |  |  | Name => 'DisplayedUnitsX', | 
| 414 |  |  |  |  |  |  | PrintConv => { | 
| 415 |  |  |  |  |  |  | 1 => 'inches', | 
| 416 |  |  |  |  |  |  | 2 => 'cm', | 
| 417 |  |  |  |  |  |  | }, | 
| 418 |  |  |  |  |  |  | }, | 
| 419 |  |  |  |  |  |  | 4 => { | 
| 420 |  |  |  |  |  |  | Name => 'YResolution', | 
| 421 |  |  |  |  |  |  | Format => 'int32u', | 
| 422 |  |  |  |  |  |  | Priority => 0, | 
| 423 |  |  |  |  |  |  | ValueConv => '$val / 0x10000', | 
| 424 |  |  |  |  |  |  | ValueConvInv => 'int($val * 0x10000 + 0.5)', | 
| 425 |  |  |  |  |  |  | PrintConv => 'int($val * 100 + 0.5) / 100', | 
| 426 |  |  |  |  |  |  | PrintConvInv => '$val', | 
| 427 |  |  |  |  |  |  | }, | 
| 428 |  |  |  |  |  |  | 6 => { | 
| 429 |  |  |  |  |  |  | Name => 'DisplayedUnitsY', | 
| 430 |  |  |  |  |  |  | PrintConv => { | 
| 431 |  |  |  |  |  |  | 1 => 'inches', | 
| 432 |  |  |  |  |  |  | 2 => 'cm', | 
| 433 |  |  |  |  |  |  | }, | 
| 434 |  |  |  |  |  |  | }, | 
| 435 |  |  |  |  |  |  | ); | 
| 436 |  |  |  |  |  |  |  | 
| 437 |  |  |  |  |  |  | # Photoshop version information | 
| 438 |  |  |  |  |  |  | %Image::ExifTool::Photoshop::VersionInfo = ( | 
| 439 |  |  |  |  |  |  | PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData, | 
| 440 |  |  |  |  |  |  | WRITE_PROC => \&Image::ExifTool::WriteBinaryData, | 
| 441 |  |  |  |  |  |  | CHECK_PROC => \&Image::ExifTool::CheckBinaryData, | 
| 442 |  |  |  |  |  |  | FIRST_ENTRY => 0, | 
| 443 |  |  |  |  |  |  | GROUPS => { 2 => 'Image' }, | 
| 444 |  |  |  |  |  |  | # (always 1) 0 => { Name => 'PhotoshopVersion', Format => 'int32u' }, | 
| 445 |  |  |  |  |  |  | 4 => { Name => 'HasRealMergedData', Format => 'int8u', PrintConv => { 0 => 'No', 1 => 'Yes' } }, | 
| 446 |  |  |  |  |  |  | 5 => { Name => 'WriterName', Format => 'var_ustr32' }, | 
| 447 |  |  |  |  |  |  | 9 => { Name => 'ReaderName', Format => 'var_ustr32' }, | 
| 448 |  |  |  |  |  |  | # (always 1) 13 => { Name => 'FileVersion', Format => 'int32u' }, | 
| 449 |  |  |  |  |  |  | ); | 
| 450 |  |  |  |  |  |  |  | 
| 451 |  |  |  |  |  |  | # Print Scale | 
| 452 |  |  |  |  |  |  | %Image::ExifTool::Photoshop::PrintScaleInfo = ( | 
| 453 |  |  |  |  |  |  | PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData, | 
| 454 |  |  |  |  |  |  | WRITE_PROC => \&Image::ExifTool::WriteBinaryData, | 
| 455 |  |  |  |  |  |  | CHECK_PROC => \&Image::ExifTool::CheckBinaryData, | 
| 456 |  |  |  |  |  |  | FIRST_ENTRY => 0, | 
| 457 |  |  |  |  |  |  | GROUPS => { 2 => 'Image' }, | 
| 458 |  |  |  |  |  |  | 0 => { | 
| 459 |  |  |  |  |  |  | Name => 'PrintStyle', | 
| 460 |  |  |  |  |  |  | Format => 'int16u', | 
| 461 |  |  |  |  |  |  | PrintConv => { | 
| 462 |  |  |  |  |  |  | 0 => 'Centered', | 
| 463 |  |  |  |  |  |  | 1 => 'Size to Fit', | 
| 464 |  |  |  |  |  |  | 2 => 'User Defined', | 
| 465 |  |  |  |  |  |  | }, | 
| 466 |  |  |  |  |  |  | }, | 
| 467 |  |  |  |  |  |  | 2  => { Name => 'PrintPosition', Format => 'float[2]' }, | 
| 468 |  |  |  |  |  |  | 10 => { Name => 'PrintScale',    Format => 'float' }, | 
| 469 |  |  |  |  |  |  | ); | 
| 470 |  |  |  |  |  |  |  | 
| 471 |  |  |  |  |  |  | # Pixel Aspect Ratio | 
| 472 |  |  |  |  |  |  | %Image::ExifTool::Photoshop::PixelInfo = ( | 
| 473 |  |  |  |  |  |  | PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData, | 
| 474 |  |  |  |  |  |  | WRITE_PROC => \&Image::ExifTool::WriteBinaryData, | 
| 475 |  |  |  |  |  |  | CHECK_PROC => \&Image::ExifTool::CheckBinaryData, | 
| 476 |  |  |  |  |  |  | FIRST_ENTRY => 0, | 
| 477 |  |  |  |  |  |  | GROUPS => { 2 => 'Image' }, | 
| 478 |  |  |  |  |  |  | # 0 - version | 
| 479 |  |  |  |  |  |  | 4 => { Name => 'PixelAspectRatio', Format => 'double' }, | 
| 480 |  |  |  |  |  |  | ); | 
| 481 |  |  |  |  |  |  |  | 
| 482 |  |  |  |  |  |  | # Photoshop PSD file header | 
| 483 |  |  |  |  |  |  | %Image::ExifTool::Photoshop::Header = ( | 
| 484 |  |  |  |  |  |  | PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData, | 
| 485 |  |  |  |  |  |  | FORMAT => 'int16u', | 
| 486 |  |  |  |  |  |  | GROUPS => { 2 => 'Image' }, | 
| 487 |  |  |  |  |  |  | NOTES => 'This information is found in the PSD file header.', | 
| 488 |  |  |  |  |  |  | 6 => 'NumChannels', | 
| 489 |  |  |  |  |  |  | 7 => { Name => 'ImageHeight', Format => 'int32u' }, | 
| 490 |  |  |  |  |  |  | 9 => { Name => 'ImageWidth', Format => 'int32u' }, | 
| 491 |  |  |  |  |  |  | 11 => 'BitDepth', | 
| 492 |  |  |  |  |  |  | 12 => { | 
| 493 |  |  |  |  |  |  | Name => 'ColorMode', | 
| 494 |  |  |  |  |  |  | PrintConvColumns => 2, | 
| 495 |  |  |  |  |  |  | PrintConv => { | 
| 496 |  |  |  |  |  |  | 0 => 'Bitmap', | 
| 497 |  |  |  |  |  |  | 1 => 'Grayscale', | 
| 498 |  |  |  |  |  |  | 2 => 'Indexed', | 
| 499 |  |  |  |  |  |  | 3 => 'RGB', | 
| 500 |  |  |  |  |  |  | 4 => 'CMYK', | 
| 501 |  |  |  |  |  |  | 7 => 'Multichannel', | 
| 502 |  |  |  |  |  |  | 8 => 'Duotone', | 
| 503 |  |  |  |  |  |  | 9 => 'Lab', | 
| 504 |  |  |  |  |  |  | }, | 
| 505 |  |  |  |  |  |  | }, | 
| 506 |  |  |  |  |  |  | ); | 
| 507 |  |  |  |  |  |  |  | 
| 508 |  |  |  |  |  |  | # Layer information | 
| 509 |  |  |  |  |  |  | %Image::ExifTool::Photoshop::Layers = ( | 
| 510 |  |  |  |  |  |  | PROCESS_PROC => \&ProcessLayers, | 
| 511 |  |  |  |  |  |  | GROUPS => { 2 => 'Image' }, | 
| 512 |  |  |  |  |  |  | NOTES => 'Tags extracted from Photoshop layer information.', | 
| 513 |  |  |  |  |  |  | # tags extracted from layer information | 
| 514 |  |  |  |  |  |  | # (tag ID's are for convenience only) | 
| 515 |  |  |  |  |  |  | _xcnt => { Name => 'LayerCount', Format => 'int16u' }, | 
| 516 |  |  |  |  |  |  | _xrct => { | 
| 517 |  |  |  |  |  |  | Name => 'LayerRectangles', | 
| 518 |  |  |  |  |  |  | Format => 'int32u', | 
| 519 |  |  |  |  |  |  | Count => 4, | 
| 520 |  |  |  |  |  |  | List => 1, | 
| 521 |  |  |  |  |  |  | Notes => 'top left bottom right', | 
| 522 |  |  |  |  |  |  | }, | 
| 523 |  |  |  |  |  |  | _xnam => { Name => 'LayerNames', | 
| 524 |  |  |  |  |  |  | Format => 'string', | 
| 525 |  |  |  |  |  |  | List => 1, | 
| 526 |  |  |  |  |  |  | ValueConv => q{ | 
| 527 |  |  |  |  |  |  | my $charset = $self->Options('CharsetPhotoshop') || 'Latin'; | 
| 528 |  |  |  |  |  |  | return $self->Decode($val, $charset); | 
| 529 |  |  |  |  |  |  | }, | 
| 530 |  |  |  |  |  |  | }, | 
| 531 |  |  |  |  |  |  | _xbnd => { | 
| 532 |  |  |  |  |  |  | Name => 'LayerBlendModes', | 
| 533 |  |  |  |  |  |  | Format => 'undef', | 
| 534 |  |  |  |  |  |  | List => 1, | 
| 535 |  |  |  |  |  |  | RawConv => 'GetByteOrder() eq "II" ? pack "N*", unpack "V*", $val : $val', | 
| 536 |  |  |  |  |  |  | PrintConv => { | 
| 537 |  |  |  |  |  |  | pass => 'Pass Through', | 
| 538 |  |  |  |  |  |  | norm => 'Normal', | 
| 539 |  |  |  |  |  |  | diss => 'Dissolve', | 
| 540 |  |  |  |  |  |  | dark => 'Darken', | 
| 541 |  |  |  |  |  |  | 'mul '=> 'Multiply', | 
| 542 |  |  |  |  |  |  | idiv => 'Color Burn', | 
| 543 |  |  |  |  |  |  | lbrn => 'Linear Burn', | 
| 544 |  |  |  |  |  |  | dkCl => 'Darker Color', | 
| 545 |  |  |  |  |  |  | lite => 'Lighten', | 
| 546 |  |  |  |  |  |  | scrn => 'Screen', | 
| 547 |  |  |  |  |  |  | 'div '=> 'Color Dodge', | 
| 548 |  |  |  |  |  |  | lddg => 'Linear Dodge', | 
| 549 |  |  |  |  |  |  | lgCl => 'Lighter Color', | 
| 550 |  |  |  |  |  |  | over => 'Overlay', | 
| 551 |  |  |  |  |  |  | sLit => 'Soft Light', | 
| 552 |  |  |  |  |  |  | hLit => 'Hard Light', | 
| 553 |  |  |  |  |  |  | vLit => 'Vivid Light', | 
| 554 |  |  |  |  |  |  | lLit => 'Linear Light', | 
| 555 |  |  |  |  |  |  | pLit => 'Pin Light', | 
| 556 |  |  |  |  |  |  | hMix => 'Hard Mix', | 
| 557 |  |  |  |  |  |  | diff => 'Difference', | 
| 558 |  |  |  |  |  |  | smud => 'Exclusion', | 
| 559 |  |  |  |  |  |  | fsub => 'Subtract', | 
| 560 |  |  |  |  |  |  | fdiv => 'Divide', | 
| 561 |  |  |  |  |  |  | 'hue '=> 'Hue', | 
| 562 |  |  |  |  |  |  | 'sat '=> 'Saturation', | 
| 563 |  |  |  |  |  |  | colr => 'Color', | 
| 564 |  |  |  |  |  |  | 'lum '=> 'Luminosity', | 
| 565 |  |  |  |  |  |  | }, | 
| 566 |  |  |  |  |  |  | }, | 
| 567 |  |  |  |  |  |  | _xopc  => { | 
| 568 |  |  |  |  |  |  | Name => 'LayerOpacities', | 
| 569 |  |  |  |  |  |  | Format => 'int8u', | 
| 570 |  |  |  |  |  |  | List => 1, | 
| 571 |  |  |  |  |  |  | ValueConv => '100 * $val / 255', | 
| 572 |  |  |  |  |  |  | PrintConv => 'sprintf("%d%%",$val)', | 
| 573 |  |  |  |  |  |  | }, | 
| 574 |  |  |  |  |  |  | _xvis  => { | 
| 575 |  |  |  |  |  |  | Name => 'LayerVisible', | 
| 576 |  |  |  |  |  |  | Format => 'int8u', | 
| 577 |  |  |  |  |  |  | List => 1, | 
| 578 |  |  |  |  |  |  | ValueConv => '$val & 0x02', | 
| 579 |  |  |  |  |  |  | PrintConv => { 0x02 => 'No', 0x00 => 'Yes' }, | 
| 580 |  |  |  |  |  |  | }, | 
| 581 |  |  |  |  |  |  | # tags extracted from additional layer information (tag ID's are real) | 
| 582 |  |  |  |  |  |  | # - must be able to accommodate a blank entry to preserve the list ordering | 
| 583 |  |  |  |  |  |  | luni => { | 
| 584 |  |  |  |  |  |  | Name => 'LayerUnicodeNames', | 
| 585 |  |  |  |  |  |  | List => 1, | 
| 586 |  |  |  |  |  |  | RawConv => q{ | 
| 587 |  |  |  |  |  |  | return '' if length($val) < 4; | 
| 588 |  |  |  |  |  |  | my $len = Get32u(\$val, 0); | 
| 589 |  |  |  |  |  |  | return $self->Decode(substr($val, 4, $len * 2), 'UCS2'); | 
| 590 |  |  |  |  |  |  | }, | 
| 591 |  |  |  |  |  |  | }, | 
| 592 |  |  |  |  |  |  | lyid => { | 
| 593 |  |  |  |  |  |  | Name => 'LayerIDs', | 
| 594 |  |  |  |  |  |  | Description => 'Layer IDs', | 
| 595 |  |  |  |  |  |  | Format => 'int32u', | 
| 596 |  |  |  |  |  |  | List => 1, | 
| 597 |  |  |  |  |  |  | Unknown => 1, | 
| 598 |  |  |  |  |  |  | }, | 
| 599 |  |  |  |  |  |  | lclr => { | 
| 600 |  |  |  |  |  |  | Name => 'LayerColors', | 
| 601 |  |  |  |  |  |  | Format => 'int16u', | 
| 602 |  |  |  |  |  |  | Count => 1, | 
| 603 |  |  |  |  |  |  | List => 1, | 
| 604 |  |  |  |  |  |  | PrintConv => { | 
| 605 |  |  |  |  |  |  | 0=>'None',  1=>'Red',  2=>'Orange', 3=>'Yellow', | 
| 606 |  |  |  |  |  |  | 4=>'Green', 5=>'Blue', 6=>'Violet', 7=>'Gray', | 
| 607 |  |  |  |  |  |  | }, | 
| 608 |  |  |  |  |  |  | }, | 
| 609 |  |  |  |  |  |  | shmd => { # layer metadata (undocumented structure) | 
| 610 |  |  |  |  |  |  | # (for now, only extract layerTime.  May also contain "layerXMP" -- | 
| 611 |  |  |  |  |  |  | #  it would be nice to decode this but I need a sample) | 
| 612 |  |  |  |  |  |  | Name => 'LayerModifyDates', | 
| 613 |  |  |  |  |  |  | Groups => { 2 => 'Time' }, | 
| 614 |  |  |  |  |  |  | List => 1, | 
| 615 |  |  |  |  |  |  | RawConv => q{ | 
| 616 |  |  |  |  |  |  | return '' unless $val =~ /layerTime(doub|buod)(.{8})/s; | 
| 617 |  |  |  |  |  |  | my $tmp = $2; | 
| 618 |  |  |  |  |  |  | return GetDouble(\$tmp, 0); | 
| 619 |  |  |  |  |  |  | }, | 
| 620 |  |  |  |  |  |  | ValueConv => 'length $val ? ConvertUnixTime($val,1) : ""', | 
| 621 |  |  |  |  |  |  | PrintConv => 'length $val ? $self->ConvertDateTime($val) : ""', | 
| 622 |  |  |  |  |  |  | }, | 
| 623 |  |  |  |  |  |  | lsct => { | 
| 624 |  |  |  |  |  |  | Name => 'LayerSections', | 
| 625 |  |  |  |  |  |  | Format => 'int32u', | 
| 626 |  |  |  |  |  |  | Count => 1, | 
| 627 |  |  |  |  |  |  | List => 1, | 
| 628 |  |  |  |  |  |  | PrintConv => { 0 => 'Layer', 1 => 'Folder (open)', 2 => 'Folder (closed)', 3 => 'Divider' }, | 
| 629 |  |  |  |  |  |  | }, | 
| 630 |  |  |  |  |  |  | ); | 
| 631 |  |  |  |  |  |  |  | 
| 632 |  |  |  |  |  |  | # tags extracted from ImageSourceData found in TIFF images (ref PH) | 
| 633 |  |  |  |  |  |  | %Image::ExifTool::Photoshop::DocumentData = ( | 
| 634 |  |  |  |  |  |  | PROCESS_PROC => \&ProcessDocumentData, | 
| 635 |  |  |  |  |  |  | GROUPS => { 2 => 'Image' }, | 
| 636 |  |  |  |  |  |  | Layr => { | 
| 637 |  |  |  |  |  |  | Name => 'Layers', | 
| 638 |  |  |  |  |  |  | SubDirectory => { TagTable => 'Image::ExifTool::Photoshop::Layers' }, | 
| 639 |  |  |  |  |  |  | }, | 
| 640 |  |  |  |  |  |  | Lr16 => { # (NC) | 
| 641 |  |  |  |  |  |  | Name => 'Layers', | 
| 642 |  |  |  |  |  |  | SubDirectory => { TagTable => 'Image::ExifTool::Photoshop::Layers' }, | 
| 643 |  |  |  |  |  |  | }, | 
| 644 |  |  |  |  |  |  | ); | 
| 645 |  |  |  |  |  |  |  | 
| 646 |  |  |  |  |  |  | # image data | 
| 647 |  |  |  |  |  |  | %Image::ExifTool::Photoshop::ImageData = ( | 
| 648 |  |  |  |  |  |  | PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData, | 
| 649 |  |  |  |  |  |  | GROUPS => { 2 => 'Image' }, | 
| 650 |  |  |  |  |  |  | 0 => { | 
| 651 |  |  |  |  |  |  | Name => 'Compression', | 
| 652 |  |  |  |  |  |  | Format => 'int16u', | 
| 653 |  |  |  |  |  |  | PrintConv => { | 
| 654 |  |  |  |  |  |  | 0 => 'Uncompressed', | 
| 655 |  |  |  |  |  |  | 1 => 'RLE', | 
| 656 |  |  |  |  |  |  | 2 => 'ZIP without prediction', | 
| 657 |  |  |  |  |  |  | 3 => 'ZIP with prediction', | 
| 658 |  |  |  |  |  |  | }, | 
| 659 |  |  |  |  |  |  | }, | 
| 660 |  |  |  |  |  |  | ); | 
| 661 |  |  |  |  |  |  |  | 
| 662 |  |  |  |  |  |  | # tags for unknown resource types | 
| 663 |  |  |  |  |  |  | %Image::ExifTool::Photoshop::Unknown = ( | 
| 664 |  |  |  |  |  |  | GROUPS => { 2 => 'Unknown' }, | 
| 665 |  |  |  |  |  |  | ); | 
| 666 |  |  |  |  |  |  |  | 
| 667 |  |  |  |  |  |  | # define reference to IPTCDigest tagInfo hash for convenience | 
| 668 |  |  |  |  |  |  | $iptcDigestInfo = $Image::ExifTool::Photoshop::Main{0x0425}; | 
| 669 |  |  |  |  |  |  |  | 
| 670 |  |  |  |  |  |  |  | 
| 671 |  |  |  |  |  |  | #------------------------------------------------------------------------------ | 
| 672 |  |  |  |  |  |  | # AutoLoad our writer routines when necessary | 
| 673 |  |  |  |  |  |  | # | 
| 674 |  |  |  |  |  |  | sub AUTOLOAD | 
| 675 |  |  |  |  |  |  | { | 
| 676 | 15 |  |  | 15 |  | 96 | return Image::ExifTool::DoAutoLoad($AUTOLOAD, @_); | 
| 677 |  |  |  |  |  |  | } | 
| 678 |  |  |  |  |  |  |  | 
| 679 |  |  |  |  |  |  | #------------------------------------------------------------------------------ | 
| 680 |  |  |  |  |  |  | # Convert pascal string(s) to something we can use | 
| 681 |  |  |  |  |  |  | # Inputs: 1) Pascal string data | 
| 682 |  |  |  |  |  |  | # Returns: Strings, concatenated with ', ' | 
| 683 |  |  |  |  |  |  | sub ConvertPascalString($$) | 
| 684 |  |  |  |  |  |  | { | 
| 685 | 0 |  |  | 0 | 0 | 0 | my ($et, $inStr) = @_; | 
| 686 | 0 |  |  |  |  | 0 | my $outStr = ''; | 
| 687 | 0 |  |  |  |  | 0 | my $len = length($inStr); | 
| 688 | 0 |  |  |  |  | 0 | my $i=0; | 
| 689 | 0 |  |  |  |  | 0 | while ($i < $len) { | 
| 690 | 0 |  |  |  |  | 0 | my $n = ord(substr($inStr, $i, 1)); | 
| 691 | 0 | 0 |  |  |  | 0 | last if $i + $n >= $len; | 
| 692 | 0 | 0 |  |  |  | 0 | $i and $outStr .= ', '; | 
| 693 | 0 |  |  |  |  | 0 | $outStr .= substr($inStr, $i+1, $n); | 
| 694 | 0 |  |  |  |  | 0 | $i += $n + 1; | 
| 695 |  |  |  |  |  |  | } | 
| 696 | 0 |  | 0 |  |  | 0 | my $charset = $et->Options('CharsetPhotoshop') || 'Latin'; | 
| 697 | 0 |  |  |  |  | 0 | return $et->Decode($outStr, $charset); | 
| 698 |  |  |  |  |  |  | } | 
| 699 |  |  |  |  |  |  |  | 
| 700 |  |  |  |  |  |  | #------------------------------------------------------------------------------ | 
| 701 |  |  |  |  |  |  | # Process Photoshop layers and mask information section of PSD/PSB file | 
| 702 |  |  |  |  |  |  | # Inputs: 0) ExifTool ref, 1) DirInfo ref, 2) tag table ref | 
| 703 |  |  |  |  |  |  | # Returns: 1 on success (and seeks to the end of this section) | 
| 704 |  |  |  |  |  |  | sub ProcessLayersAndMask($$$) | 
| 705 |  |  |  |  |  |  | { | 
| 706 | 4 |  |  | 4 | 0 | 8 | local $_; | 
| 707 | 4 |  |  |  |  | 18 | my ($et, $dirInfo, $tagTablePtr) = @_; | 
| 708 | 4 |  |  |  |  | 13 | my $raf = $$dirInfo{RAF}; | 
| 709 | 4 |  |  |  |  | 10 | my $fileType = $$et{FileType}; | 
| 710 | 4 |  |  |  |  | 9 | my $data; | 
| 711 |  |  |  |  |  |  |  | 
| 712 | 4 | 50 | 33 |  |  | 20 | return 0 unless $fileType eq 'PSD' or $fileType eq 'PSB';   # (no layer section in CS1 files) | 
| 713 |  |  |  |  |  |  |  | 
| 714 |  |  |  |  |  |  | # (some words are 4 bytes in PSD files and 8 bytes in PSB) | 
| 715 | 4 | 50 |  |  |  | 22 | my ($psb, $psiz) = $fileType eq 'PSB' ? (1, 8) : (undef, 4); | 
| 716 |  |  |  |  |  |  |  | 
| 717 |  |  |  |  |  |  | # read the layer information header | 
| 718 | 4 |  |  |  |  | 14 | my $n = $psiz * 2 + 2; | 
| 719 | 4 | 50 |  |  |  | 27 | $raf->Read($data, $n) == $n or return 0; | 
| 720 | 4 | 50 |  |  |  | 26 | my $tot = $psb ? Get64u(\$data, 0) : Get32u(\$data, 0); # length of layer and mask info | 
| 721 | 4 | 50 |  |  |  | 15 | return 1 if $tot == 0; | 
| 722 | 4 |  |  |  |  | 32 | my $end = $raf->Tell() - $psiz - 2 + $tot; | 
| 723 | 4 |  |  |  |  | 22 | $data = substr $data, $psiz; | 
| 724 | 4 | 50 |  |  |  | 19 | my $len = $psb ? Get64u(\$data, 0) : Get32u(\$data, 0); # length of layer info section | 
| 725 | 4 |  |  |  |  | 21 | my $num = Get16s(\$data, $psiz); | 
| 726 |  |  |  |  |  |  | # check for Lr16 block if layers length is 0 (ref https://forums.adobe.com/thread/1540914) | 
| 727 | 4 | 50 | 33 |  |  | 31 | if ($len == 0 and $num == 0) { | 
| 728 | 4 | 50 |  |  |  | 38 | $raf->Read($data,10) == 10 or return 0; | 
| 729 | 4 | 50 |  |  |  | 31 | if ($data =~ /^..8BIMLr16/s) { | 
|  |  | 50 |  |  |  |  |  | 
| 730 | 0 | 0 |  |  |  | 0 | $raf->Read($data, $psiz+2) == $psiz+2 or return 0; | 
| 731 | 0 | 0 |  |  |  | 0 | $len = $psb ? Get64u(\$data, 0) : Get32u(\$data, 0); | 
| 732 |  |  |  |  |  |  | } elsif ($data =~ /^..8BIMMt16/s) { # (have seen Mt16 before Lr16, ref PH) | 
| 733 | 0 | 0 |  |  |  | 0 | $raf->Read($data, $psiz) == $psiz or return 0; | 
| 734 | 0 | 0 |  |  |  | 0 | $raf->Read($data, 8) == 8 or return 0; | 
| 735 | 0 | 0 |  |  |  | 0 | if ($data eq '8BIMLr16') { | 
| 736 | 0 | 0 |  |  |  | 0 | $raf->Read($data, $psiz+2) == $psiz+2 or return 0; | 
| 737 | 0 | 0 |  |  |  | 0 | $len = $psb ? Get64u(\$data, 0) : Get32u(\$data, 0); | 
| 738 |  |  |  |  |  |  | } else { | 
| 739 | 0 | 0 |  |  |  | 0 | $raf->Seek(-18-$psiz, 1) or return 0; | 
| 740 |  |  |  |  |  |  | } | 
| 741 |  |  |  |  |  |  | } else { | 
| 742 | 4 | 50 |  |  |  | 24 | $raf->Seek(-10, 1) or return 0; | 
| 743 |  |  |  |  |  |  | } | 
| 744 |  |  |  |  |  |  | } | 
| 745 | 4 |  |  |  |  | 16 | $len += 2;  # include layer count with layer info section | 
| 746 | 4 | 50 |  |  |  | 20 | $raf->Seek(-2, 1) or return 0; | 
| 747 | 4 |  |  |  |  | 49 | my %dinfo = ( | 
| 748 |  |  |  |  |  |  | RAF => $raf, | 
| 749 |  |  |  |  |  |  | DirLen => $len, | 
| 750 |  |  |  |  |  |  | ); | 
| 751 | 4 |  |  |  |  | 19 | $$et{IsPSB} = $psb; # set PSB flag | 
| 752 | 4 |  |  |  |  | 25 | ProcessLayers($et, \%dinfo, $tagTablePtr); | 
| 753 |  |  |  |  |  |  |  | 
| 754 |  |  |  |  |  |  | # seek to the end of this section and return success flag | 
| 755 | 4 | 50 |  |  |  | 18 | return $raf->Seek($end, 0) ? 1 : 0; | 
| 756 |  |  |  |  |  |  | } | 
| 757 |  |  |  |  |  |  |  | 
| 758 |  |  |  |  |  |  | #------------------------------------------------------------------------------ | 
| 759 |  |  |  |  |  |  | # Process Photoshop layers (beginning with layer count) | 
| 760 |  |  |  |  |  |  | # Inputs: 0) ExifTool ref, 1) DirInfo ref, 2) tag table ref | 
| 761 |  |  |  |  |  |  | # Returns: 1 on success | 
| 762 |  |  |  |  |  |  | # Notes: Uses ExifTool IsPSB member to determine whether file is PSB format | 
| 763 |  |  |  |  |  |  | sub ProcessLayers($$$) | 
| 764 |  |  |  |  |  |  | { | 
| 765 | 4 |  |  | 4 | 0 | 8 | local $_; | 
| 766 | 4 |  |  |  |  | 14 | my ($et, $dirInfo, $tagTablePtr) = @_; | 
| 767 | 4 |  |  |  |  | 13 | my ($i, $n, %count, $buff, $buf2); | 
| 768 | 4 |  |  |  |  | 11 | my $raf = $$dirInfo{RAF}; | 
| 769 | 4 |  |  |  |  | 13 | my $dirLen = $$dirInfo{DirLen}; | 
| 770 | 4 |  |  |  |  | 12 | my $verbose = $$et{OPTIONS}{Verbose}; | 
| 771 | 4 |  |  |  |  | 18 | my %dinfo = ( DataPt => \$buff, Base => $raf->Tell() ); | 
| 772 | 4 |  |  |  |  | 12 | my $pos = 0; | 
| 773 | 4 | 50 |  |  |  | 41 | return 0 if $dirLen < 2; | 
| 774 | 4 | 50 |  |  |  | 18 | $raf->Read($buff, 2) == 2 or return 0; | 
| 775 | 4 |  |  |  |  | 20 | my $num = Get16s(\$buff, 0);    # number of layers | 
| 776 | 4 | 50 |  |  |  | 27 | $num = -$num if $num < 0;       # (first channel is transparency data if negative) | 
| 777 | 4 |  |  |  |  | 27 | $et->VerboseDir('Layers', $num, $dirLen); | 
| 778 | 4 |  |  |  |  | 31 | $et->HandleTag($tagTablePtr, '_xcnt', $num, Start => $pos, Size => 2, %dinfo); # LayerCount | 
| 779 | 4 |  |  |  |  | 17 | my $oldIndent = $$et{INDENT}; | 
| 780 | 4 |  |  |  |  | 20 | $$et{INDENT} .= '| '; | 
| 781 | 4 |  |  |  |  | 9 | $pos += 2; | 
| 782 | 4 |  |  |  |  | 12 | my $psb = $$et{IsPSB};  # is PSB format? | 
| 783 | 4 | 50 |  |  |  | 13 | my $psiz = $psb ? 8 : 4; | 
| 784 | 4 |  |  |  |  | 20 | for ($i=0; $i<$num; ++$i) { # process each layer | 
| 785 | 0 |  |  |  |  | 0 | $et->VPrint(0, $oldIndent.'+ [Layer '.($i+1)." of $num]\n"); | 
| 786 | 0 | 0 |  |  |  | 0 | last if $pos + 18 > $dirLen; | 
| 787 | 0 | 0 |  |  |  | 0 | $raf->Read($buff, 18) == 18 or last; | 
| 788 | 0 |  |  |  |  | 0 | $dinfo{DataPos} = $pos; | 
| 789 |  |  |  |  |  |  | # save the layer rectangle | 
| 790 | 0 |  |  |  |  | 0 | $et->HandleTag($tagTablePtr, '_xrct', undef, Start => 0, Size => 16, %dinfo); | 
| 791 | 0 |  |  |  |  | 0 | my $numChannels = Get16u(\$buff, 16); | 
| 792 | 0 |  |  |  |  | 0 | $n = (2 + $psiz) * $numChannels;    # size of channel information | 
| 793 | 0 | 0 |  |  |  | 0 | $raf->Seek($n, 1) or last; | 
| 794 | 0 |  |  |  |  | 0 | $pos += 18 + $n; | 
| 795 | 0 | 0 |  |  |  | 0 | last if $pos + 20 > $dirLen; | 
| 796 | 0 | 0 |  |  |  | 0 | $raf->Read($buff, 20) == 20 or last; | 
| 797 | 0 |  |  |  |  | 0 | $dinfo{DataPos} = $pos; | 
| 798 | 0 |  |  |  |  | 0 | my $sig = substr($buff, 0, 4); | 
| 799 | 0 | 0 |  |  |  | 0 | $sig =~ /^(8BIM|MIB8)$/ or last;    # verify signature | 
| 800 | 0 |  |  |  |  | 0 | $et->HandleTag($tagTablePtr, '_xbnd', undef, Start => 4, Size => 4, %dinfo); | 
| 801 | 0 |  |  |  |  | 0 | $et->HandleTag($tagTablePtr, '_xopc', undef, Start => 8, Size => 1, %dinfo); | 
| 802 | 0 |  |  |  |  | 0 | $et->HandleTag($tagTablePtr, '_xvis', undef, Start =>10, Size => 1, %dinfo); | 
| 803 | 0 |  |  |  |  | 0 | my $nxt = $pos + 16 + Get32u(\$buff, 12); | 
| 804 | 0 |  |  |  |  | 0 | $n = Get32u(\$buff, 16);        # get size of layer mask data | 
| 805 | 0 |  |  |  |  | 0 | $pos += 20 + $n;                # skip layer mask data | 
| 806 | 0 | 0 |  |  |  | 0 | last if $pos + 4 > $dirLen; | 
| 807 | 0 | 0 | 0 |  |  | 0 | $raf->Seek($n, 1) and $raf->Read($buff, 4) == 4 or last; | 
| 808 | 0 |  |  |  |  | 0 | $n = Get32u(\$buff, 0);         # get size of layer blending ranges | 
| 809 | 0 |  |  |  |  | 0 | $pos += 4 + $n;                 # skip layer blending ranges data | 
| 810 | 0 | 0 |  |  |  | 0 | last if $pos + 1 > $dirLen; | 
| 811 | 0 | 0 | 0 |  |  | 0 | $raf->Seek($n, 1) and $raf->Read($buff, 1) == 1 or last; | 
| 812 | 0 |  |  |  |  | 0 | $n = Get8u(\$buff, 0);          # get length of layer name | 
| 813 | 0 | 0 |  |  |  | 0 | last if $pos + 1 + $n > $dirLen; | 
| 814 | 0 | 0 |  |  |  | 0 | $raf->Read($buff, $n) == $n or last; | 
| 815 | 0 |  |  |  |  | 0 | $dinfo{DataPos} = $pos + 1; | 
| 816 | 0 |  |  |  |  | 0 | $et->HandleTag($tagTablePtr, '_xnam', undef, Start => 0, Size => $n, %dinfo); | 
| 817 | 0 |  |  |  |  | 0 | my $frag = ($n + 1) & 0x3; | 
| 818 | 0 | 0 | 0 |  |  | 0 | $raf->Seek(4 - $frag, 1) or last if $frag; | 
| 819 | 0 |  |  |  |  | 0 | $n = ($n + 4) & 0xfffffffc;     # +1 for length byte then pad to multiple of 4 bytes | 
| 820 | 0 |  |  |  |  | 0 | $pos += $n; | 
| 821 |  |  |  |  |  |  | # process additional layer info | 
| 822 | 0 |  |  |  |  | 0 | while ($pos + 12 <= $nxt) { | 
| 823 | 0 | 0 |  |  |  | 0 | $raf->Read($buff, 12) == 12 or last; | 
| 824 | 0 |  |  |  |  | 0 | my $dat = substr($buff, 0, 8); | 
| 825 | 0 | 0 |  |  |  | 0 | $dat = pack 'N*', unpack 'V*', $dat if GetByteOrder() eq 'II'; | 
| 826 | 0 |  |  |  |  | 0 | my $sig = substr($dat, 0, 4); | 
| 827 | 0 | 0 | 0 |  |  | 0 | last unless $sig eq '8BIM' or $sig eq '8B64';   # verify signature | 
| 828 | 0 |  |  |  |  | 0 | my $tag = substr($dat, 4, 4); | 
| 829 |  |  |  |  |  |  | # (some structures have an 8-byte size word [augh!] | 
| 830 |  |  |  |  |  |  | # --> it would be great if '8B64' indicated a 64-bit version, and this may well | 
| 831 |  |  |  |  |  |  | # be the case, but it is not mentioned in the Photoshop file format specification) | 
| 832 | 0 | 0 | 0 |  |  | 0 | if ($psb and $tag =~ /^(LMsk|Lr16|Lr32|Layr|Mt16|Mt32|Mtrn|Alph|FMsk|lnk2|FEid|FXid|PxSD)$/) { | 
| 833 | 0 | 0 |  |  |  | 0 | last if $pos + 16 > $nxt; | 
| 834 | 0 | 0 |  |  |  | 0 | $raf->Read($buf2, 4) == 4 or last; | 
| 835 | 0 |  |  |  |  | 0 | $buff .= $buf2; | 
| 836 | 0 |  |  |  |  | 0 | $n = Get64u(\$buff, 8); | 
| 837 | 0 |  |  |  |  | 0 | $pos += 4; | 
| 838 |  |  |  |  |  |  | } else { | 
| 839 | 0 |  |  |  |  | 0 | $n = Get32u(\$buff, 8); | 
| 840 |  |  |  |  |  |  | } | 
| 841 | 0 |  |  |  |  | 0 | $pos += 12; | 
| 842 | 0 | 0 |  |  |  | 0 | last if $pos + $n > $nxt; | 
| 843 | 0 |  |  |  |  | 0 | $frag = $n & 0x3; | 
| 844 | 0 | 0 | 0 |  |  | 0 | if ($$tagTablePtr{$tag} or $verbose) { | 
| 845 |  |  |  |  |  |  | # pad with empty entries if necessary to keep the same index for each item in the layer | 
| 846 | 0 | 0 |  |  |  | 0 | $count{$tag} = 0 unless defined $count{$tag}; | 
| 847 | 0 | 0 |  |  |  | 0 | $raf->Read($buff, $n) == $n or last; | 
| 848 | 0 |  |  |  |  | 0 | $dinfo{DataPos} = $pos; | 
| 849 | 0 |  |  |  |  | 0 | while ($count{$tag} < $i) { | 
| 850 | 0 | 0 |  |  |  | 0 | $et->HandleTag($tagTablePtr, $tag, $tag eq 'lsct' ? 0 : ''); | 
| 851 | 0 |  |  |  |  | 0 | ++$count{$tag}; | 
| 852 |  |  |  |  |  |  | } | 
| 853 | 0 |  |  |  |  | 0 | $et->HandleTag($tagTablePtr, $tag, undef, Start => 0, Size => $n, %dinfo); | 
| 854 | 0 |  |  |  |  | 0 | ++$count{$tag}; | 
| 855 | 0 | 0 |  |  |  | 0 | if ($frag) { | 
| 856 | 0 | 0 |  |  |  | 0 | $raf->Seek(4 - $frag, 1) or last; | 
| 857 | 0 |  |  |  |  | 0 | $n += 4 - $frag;    # pad to multiple of 4 bytes (PH NC) | 
| 858 |  |  |  |  |  |  | } | 
| 859 |  |  |  |  |  |  | } else { | 
| 860 | 0 | 0 |  |  |  | 0 | $n += 4 - $frag if $frag; | 
| 861 | 0 | 0 |  |  |  | 0 | $raf->Seek($n, 1) or last; | 
| 862 |  |  |  |  |  |  | } | 
| 863 | 0 |  |  |  |  | 0 | $pos += $n; # step to start of next structure | 
| 864 |  |  |  |  |  |  | } | 
| 865 | 0 |  |  |  |  | 0 | $pos = $nxt; | 
| 866 |  |  |  |  |  |  | } | 
| 867 |  |  |  |  |  |  | # pad lists if necessary to have an entry for each layer | 
| 868 | 4 |  |  |  |  | 20 | foreach (sort keys %count) { | 
| 869 | 0 |  |  |  |  | 0 | while ($count{$_} < $num) { | 
| 870 | 0 | 0 |  |  |  | 0 | $et->HandleTag($tagTablePtr, $_, $_ eq 'lsct' ? 0 : ''); | 
| 871 | 0 |  |  |  |  | 0 | ++$count{$_}; | 
| 872 |  |  |  |  |  |  | } | 
| 873 |  |  |  |  |  |  | } | 
| 874 | 4 |  |  |  |  | 12 | $$et{INDENT} = $oldIndent; | 
| 875 | 4 |  |  |  |  | 13 | return 1; | 
| 876 |  |  |  |  |  |  | } | 
| 877 |  |  |  |  |  |  |  | 
| 878 |  |  |  |  |  |  | #------------------------------------------------------------------------------ | 
| 879 |  |  |  |  |  |  | # Process Photoshop ImageSourceData | 
| 880 |  |  |  |  |  |  | # Inputs: 0) ExifTool ref, 1) dirInfo ref, 2) tag table ref | 
| 881 |  |  |  |  |  |  | # Returns: 1 on success | 
| 882 |  |  |  |  |  |  | sub ProcessDocumentData($$$) | 
| 883 |  |  |  |  |  |  | { | 
| 884 | 0 |  |  | 0 | 0 | 0 | my ($et, $dirInfo, $tagTablePtr) = @_; | 
| 885 | 0 |  |  |  |  | 0 | my $verbose = $$et{OPTIONS}{Verbose}; | 
| 886 | 0 |  |  |  |  | 0 | my $raf = $$dirInfo{RAF}; | 
| 887 | 0 |  |  |  |  | 0 | my $dirLen = $$dirInfo{DirLen}; | 
| 888 | 0 |  |  |  |  | 0 | my $pos = 36;   # length of header | 
| 889 | 0 |  |  |  |  | 0 | my ($buff, $n, $err); | 
| 890 |  |  |  |  |  |  |  | 
| 891 | 0 |  |  |  |  | 0 | $et->VerboseDir('Photoshop Document Data', undef, $dirLen); | 
| 892 | 0 | 0 |  |  |  | 0 | unless ($raf) { | 
| 893 | 0 |  |  |  |  | 0 | my $dataPt = $$dirInfo{DataPt}; | 
| 894 | 0 |  | 0 |  |  | 0 | my $start = $$dirInfo{DirStart} || 0; | 
| 895 | 0 |  |  |  |  | 0 | $raf = new File::RandomAccess($dataPt); | 
| 896 | 0 | 0 |  |  |  | 0 | $raf->Seek($start, 0) if $start; | 
| 897 | 0 | 0 |  |  |  | 0 | $dirLen = length $$dataPt - $start unless defined $dirLen; | 
| 898 | 0 |  |  |  |  | 0 | $et->VerboseDump($dataPt, Start => $start, Len => $dirLen, Base => $$dirInfo{Base}); | 
| 899 |  |  |  |  |  |  | } | 
| 900 | 0 | 0 | 0 |  |  | 0 | unless ($raf->Read($buff, $pos) == $pos and | 
| 901 |  |  |  |  |  |  | $buff =~ /^Adobe Photoshop Document Data (Block|V0002)\0/) | 
| 902 |  |  |  |  |  |  | { | 
| 903 | 0 |  |  |  |  | 0 | $et->Warn('Invalid Photoshop Document Data'); | 
| 904 | 0 |  |  |  |  | 0 | return 0; | 
| 905 |  |  |  |  |  |  | } | 
| 906 | 0 |  |  |  |  | 0 | my $psb = ($1 eq 'V0002'); | 
| 907 | 0 |  |  |  |  | 0 | my %dinfo = ( DataPt => \$buff ); | 
| 908 | 0 |  |  |  |  | 0 | $$et{IsPSB} = $psb; # set PSB flag (needed when handling Layers directory) | 
| 909 | 0 |  |  |  |  | 0 | while ($pos + 12 <= $dirLen) { | 
| 910 | 0 | 0 |  |  |  | 0 | $raf->Read($buff, 8) == 8 or $err = 'Error reading document data', last; | 
| 911 |  |  |  |  |  |  | # set byte order according to byte order of first signature | 
| 912 | 0 | 0 |  |  |  | 0 | SetByteOrder($buff =~ /^(8BIM|8B64)/ ? 'MM' : 'II') if $pos == 36; | 
|  |  | 0 |  |  |  |  |  | 
| 913 | 0 | 0 |  |  |  | 0 | $buff = pack 'N*', unpack 'V*', $buff if GetByteOrder() eq 'II'; | 
| 914 | 0 |  |  |  |  | 0 | my $sig = substr($buff, 0, 4); | 
| 915 | 0 | 0 | 0 |  |  | 0 | $sig eq '8BIM' or $sig eq '8B64' or $err = 'Bad photoshop resource', last; # verify signature | 
| 916 | 0 |  |  |  |  | 0 | my $tag = substr($buff, 4, 4); | 
| 917 | 0 | 0 | 0 |  |  | 0 | if ($psb and $tag =~ /^(LMsk|Lr16|Lr32|Layr|Mt16|Mt32|Mtrn|Alph|FMsk|lnk2|FEid|FXid|PxSD)$/) { | 
| 918 | 0 | 0 |  |  |  | 0 | $pos + 16 > $dirLen and $err = 'Short PSB resource', last; | 
| 919 | 0 | 0 |  |  |  | 0 | $raf->Read($buff, 8) == 8 or $err = 'Error reading PSB resource', last; | 
| 920 | 0 |  |  |  |  | 0 | $n = Get64u(\$buff, 0); | 
| 921 | 0 |  |  |  |  | 0 | $pos += 4; | 
| 922 |  |  |  |  |  |  | } else { | 
| 923 | 0 | 0 |  |  |  | 0 | $raf->Read($buff, 4) == 4 or $err = 'Error reading PSD resource', last; | 
| 924 | 0 |  |  |  |  | 0 | $n = Get32u(\$buff, 0); | 
| 925 |  |  |  |  |  |  | } | 
| 926 | 0 |  |  |  |  | 0 | $pos += 12; | 
| 927 | 0 | 0 |  |  |  | 0 | $pos + $n > $dirLen and $err = 'Truncated photoshop resource', last; | 
| 928 | 0 |  |  |  |  | 0 | my $pad = (4 - ($n & 3)) & 3;   # number of padding bytes | 
| 929 | 0 |  |  |  |  | 0 | my $tagInfo = $$tagTablePtr{$tag}; | 
| 930 | 0 | 0 | 0 |  |  | 0 | if ($tagInfo or $verbose) { | 
| 931 | 0 | 0 | 0 |  |  | 0 | if ($tagInfo and $$tagInfo{SubDirectory}) { | 
| 932 | 0 |  |  |  |  | 0 | my $fpos = $raf->Tell() + $n + $pad; | 
| 933 | 0 |  |  |  |  | 0 | my $subTable = GetTagTable($$tagInfo{SubDirectory}{TagTable}); | 
| 934 | 0 |  |  |  |  | 0 | $et->ProcessDirectory({ RAF => $raf, DirLen => $n }, $subTable); | 
| 935 | 0 | 0 |  |  |  | 0 | $raf->Seek($fpos, 0) or $err = 'Seek error', last; | 
| 936 |  |  |  |  |  |  | } else { | 
| 937 | 0 |  |  |  |  | 0 | $dinfo{DataPos} = $raf->Tell(); | 
| 938 | 0 |  |  |  |  | 0 | $dinfo{Start} = 0; | 
| 939 | 0 |  |  |  |  | 0 | $dinfo{Size} = $n; | 
| 940 | 0 | 0 |  |  |  | 0 | $raf->Read($buff, $n) == $n or $err = 'Error reading photoshop resource', last; | 
| 941 | 0 |  |  |  |  | 0 | $et->HandleTag($tagTablePtr, $tag, undef, %dinfo); | 
| 942 | 0 | 0 |  |  |  | 0 | $raf->Seek($pad, 1) or $err = 'Seek error', last; | 
| 943 |  |  |  |  |  |  | } | 
| 944 |  |  |  |  |  |  | } else { | 
| 945 | 0 | 0 |  |  |  | 0 | $raf->Seek($n + $pad, 1) or $err = 'Seek error', last; | 
| 946 |  |  |  |  |  |  | } | 
| 947 | 0 |  |  |  |  | 0 | $pos += $n + $pad;              # step to start of next structure | 
| 948 |  |  |  |  |  |  | } | 
| 949 | 0 | 0 |  |  |  | 0 | $err and $et->Warn($err); | 
| 950 | 0 |  |  |  |  | 0 | return 1; | 
| 951 |  |  |  |  |  |  | } | 
| 952 |  |  |  |  |  |  |  | 
| 953 |  |  |  |  |  |  | #------------------------------------------------------------------------------ | 
| 954 |  |  |  |  |  |  | # Process Photoshop APP13 record | 
| 955 |  |  |  |  |  |  | # Inputs: 0) ExifTool object reference, 1) Reference to directory information | 
| 956 |  |  |  |  |  |  | #         2) Tag table reference | 
| 957 |  |  |  |  |  |  | # Returns: 1 on success | 
| 958 |  |  |  |  |  |  | sub ProcessPhotoshop($$$) | 
| 959 |  |  |  |  |  |  | { | 
| 960 | 93 |  |  | 93 | 0 | 376 | my ($et, $dirInfo, $tagTablePtr) = @_; | 
| 961 | 93 |  |  |  |  | 275 | my $dataPt = $$dirInfo{DataPt}; | 
| 962 | 93 |  |  |  |  | 289 | my $pos = $$dirInfo{DirStart}; | 
| 963 | 93 |  |  |  |  | 255 | my $dirEnd = $pos + $$dirInfo{DirLen}; | 
| 964 | 93 |  |  |  |  | 399 | my $verbose = $et->Options('Verbose'); | 
| 965 | 93 |  |  |  |  | 318 | my $success = 0; | 
| 966 |  |  |  |  |  |  |  | 
| 967 |  |  |  |  |  |  | # ignore non-standard XMP while in strict MWG compatibility mode | 
| 968 | 93 | 100 | 66 |  |  | 836 | if (($Image::ExifTool::MWG::strict or $et->Options('Validate')) and | 
|  |  |  | 66 |  |  |  |  | 
| 969 |  |  |  |  |  |  | $$et{FILE_TYPE} =~ /^(JPEG|TIFF|PSD)$/) | 
| 970 |  |  |  |  |  |  | { | 
| 971 | 5 |  |  |  |  | 20 | my $path = $et->MetadataPath(); | 
| 972 | 5 | 50 |  |  |  | 87 | unless ($path =~ /^(JPEG-APP13-Photoshop|TIFF-IFD0-Photoshop|PSD)$/) { | 
| 973 | 0 | 0 |  |  |  | 0 | if ($Image::ExifTool::MWG::strict) { | 
| 974 | 0 |  |  |  |  | 0 | $et->Warn("Ignored non-standard Photoshop at $path"); | 
| 975 | 0 |  |  |  |  | 0 | return 1; | 
| 976 |  |  |  |  |  |  | } else { | 
| 977 | 0 |  |  |  |  | 0 | $et->Warn("Non-standard Photoshop at $path", 1); | 
| 978 |  |  |  |  |  |  | } | 
| 979 |  |  |  |  |  |  | } | 
| 980 |  |  |  |  |  |  | } | 
| 981 | 93 | 50 | 66 |  |  | 734 | if ($$et{FILE_TYPE} eq 'JPEG' and $$dirInfo{Parent} ne 'APP13') { | 
| 982 | 0 |  |  |  |  | 0 | $$et{LOW_PRIORITY_DIR}{'*'} = 1;    # lower priority of all these tags | 
| 983 |  |  |  |  |  |  | } | 
| 984 | 93 |  |  |  |  | 450 | SetByteOrder('MM');     # Photoshop is always big-endian | 
| 985 | 93 | 50 |  |  |  | 506 | $verbose and $et->VerboseDir('Photoshop', 0, $$dirInfo{DirLen}); | 
| 986 |  |  |  |  |  |  |  | 
| 987 |  |  |  |  |  |  | # scan through resource blocks: | 
| 988 |  |  |  |  |  |  | # Format: 0) Type, 4 bytes - '8BIM' (or the rare 'PHUT', 'DCSR', 'AgHg' or 'MeSa') | 
| 989 |  |  |  |  |  |  | #         1) TagID,2 bytes | 
| 990 |  |  |  |  |  |  | #         2) Name, pascal string padded to even no. bytes | 
| 991 |  |  |  |  |  |  | #         3) Size, 4 bytes - N | 
| 992 |  |  |  |  |  |  | #         4) Data, N bytes | 
| 993 | 93 |  |  |  |  | 413 | while ($pos + 8 < $dirEnd) { | 
| 994 | 1182 |  |  |  |  | 2462 | my $type = substr($$dataPt, $pos, 4); | 
| 995 | 1182 |  |  |  |  | 2023 | my ($ttPtr, $extra, $val, $name); | 
| 996 | 1182 | 50 |  |  |  | 2285 | if ($type eq '8BIM') { | 
|  |  | 0 |  |  |  |  |  | 
| 997 | 1182 |  |  |  |  | 1784 | $ttPtr = $tagTablePtr; | 
| 998 |  |  |  |  |  |  | } elsif ($type =~ /^(PHUT|DCSR|AgHg|MeSa)$/) { # (PHUT~ImageReady, MeSa~PhotoDeluxe) | 
| 999 | 0 |  |  |  |  | 0 | $ttPtr = GetTagTable('Image::ExifTool::Photoshop::Unknown'); | 
| 1000 |  |  |  |  |  |  | } else { | 
| 1001 | 0 |  |  |  |  | 0 | $type =~ s/([^\w])/sprintf("\\x%.2x",ord($1))/ge; | 
|  | 0 |  |  |  |  | 0 |  | 
| 1002 | 0 |  |  |  |  | 0 | $et->Warn(qq{Bad Photoshop IRB resource "$type"}); | 
| 1003 | 0 |  |  |  |  | 0 | last; | 
| 1004 |  |  |  |  |  |  | } | 
| 1005 | 1182 |  |  |  |  | 3290 | my $tag = Get16u($dataPt, $pos + 4); | 
| 1006 | 1182 |  |  |  |  | 2219 | $pos += 6;  # point to start of name | 
| 1007 | 1182 |  |  |  |  | 2828 | my $nameLen = Get8u($dataPt, $pos); | 
| 1008 | 1182 |  |  |  |  | 2576 | my $namePos = ++$pos; | 
| 1009 |  |  |  |  |  |  | # skip resource block name (pascal string, padded to an even # of bytes) | 
| 1010 | 1182 |  |  |  |  | 1750 | $pos += $nameLen; | 
| 1011 | 1182 | 50 |  |  |  | 2618 | ++$pos unless $nameLen & 0x01; | 
| 1012 | 1182 | 50 |  |  |  | 2576 | if ($pos + 4 > $dirEnd) { | 
| 1013 | 0 |  |  |  |  | 0 | $et->Warn("Bad Photoshop resource block"); | 
| 1014 | 0 |  |  |  |  | 0 | last; | 
| 1015 |  |  |  |  |  |  | } | 
| 1016 | 1182 |  |  |  |  | 2651 | my $size = Get32u($dataPt, $pos); | 
| 1017 | 1182 |  |  |  |  | 1917 | $pos += 4; | 
| 1018 | 1182 | 50 |  |  |  | 2463 | if ($size + $pos > $dirEnd) { | 
| 1019 | 0 |  |  |  |  | 0 | $et->Warn("Bad Photoshop resource data size $size"); | 
| 1020 | 0 |  |  |  |  | 0 | last; | 
| 1021 |  |  |  |  |  |  | } | 
| 1022 | 1182 |  |  |  |  | 1719 | $success = 1; | 
| 1023 | 1182 | 50 |  |  |  | 2224 | if ($nameLen) { | 
| 1024 | 0 |  |  |  |  | 0 | $name = substr($$dataPt, $namePos, $nameLen); | 
| 1025 | 0 |  |  |  |  | 0 | $extra = qq{, Name="$name"}; | 
| 1026 |  |  |  |  |  |  | } else { | 
| 1027 | 1182 |  |  |  |  | 1949 | $name = ''; | 
| 1028 |  |  |  |  |  |  | } | 
| 1029 | 1182 |  |  |  |  | 3069 | my $tagInfo = $et->GetTagInfo($ttPtr, $tag); | 
| 1030 |  |  |  |  |  |  | # append resource name to value if requested (braced by "/#...#/") | 
| 1031 | 1182 | 0 | 66 |  |  | 4836 | if ($tagInfo and defined $$tagInfo{SetResourceName} and | 
|  |  |  | 33 |  |  |  |  | 
|  |  |  | 33 |  |  |  |  | 
| 1032 |  |  |  |  |  |  | $$tagInfo{SetResourceName} eq '1' and $name !~ m{/#}) | 
| 1033 |  |  |  |  |  |  | { | 
| 1034 | 0 |  |  |  |  | 0 | $val = substr($$dataPt, $pos, $size) . '/#' . $name . '#/'; | 
| 1035 |  |  |  |  |  |  | } | 
| 1036 |  |  |  |  |  |  | $et->HandleTag($ttPtr, $tag, $val, | 
| 1037 |  |  |  |  |  |  | TagInfo => $tagInfo, | 
| 1038 |  |  |  |  |  |  | Extra   => $extra, | 
| 1039 |  |  |  |  |  |  | DataPt  => $dataPt, | 
| 1040 |  |  |  |  |  |  | DataPos => $$dirInfo{DataPos}, | 
| 1041 |  |  |  |  |  |  | Size    => $size, | 
| 1042 |  |  |  |  |  |  | Start   => $pos, | 
| 1043 |  |  |  |  |  |  | Base    => $$dirInfo{Base}, | 
| 1044 |  |  |  |  |  |  | Parent  => $$dirInfo{DirName}, | 
| 1045 | 1182 |  |  |  |  | 5837 | ); | 
| 1046 | 1182 | 100 |  |  |  | 3849 | $size += 1 if $size & 0x01; # size is padded to an even # bytes | 
| 1047 | 1182 |  |  |  |  | 3411 | $pos += $size; | 
| 1048 |  |  |  |  |  |  | } | 
| 1049 |  |  |  |  |  |  | # warn about incorrect IPTCDigest | 
| 1050 | 93 | 100 | 100 |  |  | 968 | if ($$et{VALUE}{IPTCDigest} and $$et{VALUE}{CurrentIPTCDigest} and | 
|  |  |  | 100 |  |  |  |  | 
| 1051 |  |  |  |  |  |  | $$et{VALUE}{IPTCDigest} ne $$et{VALUE}{CurrentIPTCDigest}) | 
| 1052 |  |  |  |  |  |  | { | 
| 1053 | 32 |  |  |  |  | 199 | $et->WarnOnce('IPTCDigest is not current. XMP may be out of sync'); | 
| 1054 |  |  |  |  |  |  | } | 
| 1055 | 93 |  |  |  |  | 272 | delete $$et{LOW_PRIORITY_DIR}{'*'}; | 
| 1056 | 93 |  |  |  |  | 320 | return $success; | 
| 1057 |  |  |  |  |  |  | } | 
| 1058 |  |  |  |  |  |  |  | 
| 1059 |  |  |  |  |  |  | #------------------------------------------------------------------------------ | 
| 1060 |  |  |  |  |  |  | # extract information from Photoshop PSD file | 
| 1061 |  |  |  |  |  |  | # Inputs: 0) ExifTool object reference, 1) dirInfo reference | 
| 1062 |  |  |  |  |  |  | # Returns: 1 if this was a valid PSD file, -1 on write error | 
| 1063 |  |  |  |  |  |  | sub ProcessPSD($$) | 
| 1064 |  |  |  |  |  |  | { | 
| 1065 | 5 |  |  | 5 | 0 | 19 | my ($et, $dirInfo) = @_; | 
| 1066 | 5 |  |  |  |  | 16 | my $raf = $$dirInfo{RAF}; | 
| 1067 | 5 |  |  |  |  | 15 | my $outfile = $$dirInfo{OutFile}; | 
| 1068 | 5 |  |  |  |  | 12 | my ($data, $err, $tagTablePtr); | 
| 1069 |  |  |  |  |  |  |  | 
| 1070 | 5 | 50 |  |  |  | 18 | $raf->Read($data, 30) == 30 or return 0; | 
| 1071 | 5 | 50 |  |  |  | 37 | $data =~ /^8BPS\0([\x01\x02])/ or return 0; | 
| 1072 | 5 |  |  |  |  | 26 | SetByteOrder('MM'); | 
| 1073 | 5 | 50 |  |  |  | 40 | $et->SetFileType($1 eq "\x01" ? 'PSD' : 'PSB'); # set the FileType tag | 
| 1074 | 5 |  |  |  |  | 30 | my %dirInfo = ( | 
| 1075 |  |  |  |  |  |  | DataPt => \$data, | 
| 1076 |  |  |  |  |  |  | DirStart => 0, | 
| 1077 |  |  |  |  |  |  | DirName => 'Photoshop', | 
| 1078 |  |  |  |  |  |  | ); | 
| 1079 | 5 |  |  |  |  | 23 | my $len = Get32u(\$data, 26); | 
| 1080 | 5 | 100 |  |  |  | 20 | if ($outfile) { | 
| 1081 | 1 | 50 |  |  |  | 7 | Write($outfile, $data) or $err = 1; | 
| 1082 | 1 | 50 |  |  |  | 6 | $raf->Read($data, $len) == $len or return -1; | 
| 1083 | 1 | 50 |  |  |  | 3 | Write($outfile, $data) or $err = 1; # write color mode data | 
| 1084 |  |  |  |  |  |  | # initialize map of where things are written | 
| 1085 | 1 |  |  |  |  | 7 | $et->InitWriteDirs(\%psdMap); | 
| 1086 |  |  |  |  |  |  | } else { | 
| 1087 |  |  |  |  |  |  | # process the header | 
| 1088 | 4 |  |  |  |  | 15 | $tagTablePtr = GetTagTable('Image::ExifTool::Photoshop::Header'); | 
| 1089 | 4 |  |  |  |  | 15 | $dirInfo{DirLen} = 30; | 
| 1090 | 4 |  |  |  |  | 23 | $et->ProcessDirectory(\%dirInfo, $tagTablePtr); | 
| 1091 | 4 | 50 |  |  |  | 20 | $raf->Seek($len, 1) or $err = 1;    # skip over color mode data | 
| 1092 |  |  |  |  |  |  | } | 
| 1093 |  |  |  |  |  |  | # read image resource section | 
| 1094 | 5 | 50 |  |  |  | 28 | $raf->Read($data, 4) == 4 or $err = 1; | 
| 1095 | 5 |  |  |  |  | 26 | $len = Get32u(\$data, 0); | 
| 1096 | 5 | 50 |  |  |  | 22 | $raf->Read($data, $len) == $len or $err = 1; | 
| 1097 | 5 |  |  |  |  | 24 | $tagTablePtr = GetTagTable('Image::ExifTool::Photoshop::Main'); | 
| 1098 | 5 |  |  |  |  | 19 | $dirInfo{DirLen} = $len; | 
| 1099 | 5 |  |  |  |  | 13 | my $rtnVal = 1; | 
| 1100 | 5 | 100 |  |  |  | 20 | if ($outfile) { | 
|  |  | 50 |  |  |  |  |  | 
| 1101 |  |  |  |  |  |  | # rewrite IRB resources | 
| 1102 | 1 |  |  |  |  | 12 | $data = WritePhotoshop($et, \%dirInfo, $tagTablePtr); | 
| 1103 | 1 | 50 |  |  |  | 9 | if ($data) { | 
| 1104 | 1 |  |  |  |  | 8 | $len = Set32u(length $data); | 
| 1105 | 1 | 50 |  |  |  | 8 | Write($outfile, $len, $data) or $err = 1; | 
| 1106 |  |  |  |  |  |  | # look for trailer and edit if necessary | 
| 1107 | 1 |  |  |  |  | 10 | my $trailInfo = Image::ExifTool::IdentifyTrailer($raf); | 
| 1108 | 1 | 50 |  |  |  | 5 | if ($trailInfo) { | 
| 1109 | 1 |  |  |  |  | 5 | my $tbuf = ''; | 
| 1110 | 1 |  |  |  |  | 4 | $$trailInfo{OutFile} = \$tbuf;  # rewrite trailer(s) | 
| 1111 |  |  |  |  |  |  | # rewrite all trailers to buffer | 
| 1112 | 1 | 50 |  |  |  | 6 | if ($et->ProcessTrailers($trailInfo)) { | 
| 1113 | 1 |  |  |  |  | 7 | my $copyBytes = $$trailInfo{DataPos} - $raf->Tell(); | 
| 1114 | 1 | 50 |  |  |  | 8 | if ($copyBytes >= 0) { | 
| 1115 |  |  |  |  |  |  | # copy remaining PSD file up to start of trailer | 
| 1116 | 1 |  |  |  |  | 5 | while ($copyBytes) { | 
| 1117 | 1 | 50 |  |  |  | 5 | my $n = ($copyBytes > 65536) ? 65536 : $copyBytes; | 
| 1118 | 1 | 50 |  |  |  | 4 | $raf->Read($data, $n) == $n or $err = 1; | 
| 1119 | 1 | 50 |  |  |  | 14 | Write($outfile, $data) or $err = 1; | 
| 1120 | 1 |  |  |  |  | 9 | $copyBytes -= $n; | 
| 1121 |  |  |  |  |  |  | } | 
| 1122 |  |  |  |  |  |  | # write the trailer (or not) | 
| 1123 | 1 | 50 |  |  |  | 7 | $et->WriteTrailerBuffer($trailInfo, $outfile) or $err = 1; | 
| 1124 |  |  |  |  |  |  | } else { | 
| 1125 | 0 |  |  |  |  | 0 | $et->Warn('Overlapping trailer'); | 
| 1126 | 0 |  |  |  |  | 0 | undef $trailInfo; | 
| 1127 |  |  |  |  |  |  | } | 
| 1128 |  |  |  |  |  |  | } else { | 
| 1129 | 0 |  |  |  |  | 0 | undef $trailInfo; | 
| 1130 |  |  |  |  |  |  | } | 
| 1131 |  |  |  |  |  |  | } | 
| 1132 | 1 | 50 |  |  |  | 9 | unless ($trailInfo) { | 
| 1133 |  |  |  |  |  |  | # copy over the rest of the file | 
| 1134 | 0 |  |  |  |  | 0 | while ($raf->Read($data, 65536)) { | 
| 1135 | 0 | 0 |  |  |  | 0 | Write($outfile, $data) or $err = 1; | 
| 1136 |  |  |  |  |  |  | } | 
| 1137 |  |  |  |  |  |  | } | 
| 1138 |  |  |  |  |  |  | } else { | 
| 1139 | 0 |  |  |  |  | 0 | $err = 1; | 
| 1140 |  |  |  |  |  |  | } | 
| 1141 | 1 | 50 |  |  |  | 4 | $rtnVal = -1 if $err; | 
| 1142 |  |  |  |  |  |  | } elsif ($err) { | 
| 1143 | 0 |  |  |  |  | 0 | $et->Warn('File format error'); | 
| 1144 |  |  |  |  |  |  | } else { | 
| 1145 |  |  |  |  |  |  | # read IRB resources | 
| 1146 | 4 |  |  |  |  | 26 | ProcessPhotoshop($et, \%dirInfo, $tagTablePtr); | 
| 1147 |  |  |  |  |  |  | # read layer and mask information section | 
| 1148 | 4 |  |  |  |  | 14 | $dirInfo{RAF} = $raf; | 
| 1149 | 4 |  |  |  |  | 15 | $tagTablePtr = GetTagTable('Image::ExifTool::Photoshop::Layers'); | 
| 1150 | 4 |  |  |  |  | 16 | my $oldIndent = $$et{INDENT}; | 
| 1151 | 4 |  |  |  |  | 13 | $$et{INDENT} .= '| '; | 
| 1152 | 4 | 50 | 33 |  |  | 25 | if (ProcessLayersAndMask($et, \%dirInfo, $tagTablePtr) and | 
| 1153 |  |  |  |  |  |  | # read compression mode from image data section | 
| 1154 |  |  |  |  |  |  | $raf->Read($data,2) == 2) | 
| 1155 |  |  |  |  |  |  | { | 
| 1156 | 4 |  |  |  |  | 32 | my %dirInfo = ( | 
| 1157 |  |  |  |  |  |  | DataPt  => \$data, | 
| 1158 |  |  |  |  |  |  | DataPos => $raf->Tell() - 2, | 
| 1159 |  |  |  |  |  |  | ); | 
| 1160 | 4 |  |  |  |  | 25 | $tagTablePtr = GetTagTable('Image::ExifTool::Photoshop::ImageData'); | 
| 1161 | 4 |  |  |  |  | 30 | $et->ProcessDirectory(\%dirInfo, $tagTablePtr); | 
| 1162 |  |  |  |  |  |  | } | 
| 1163 | 4 |  |  |  |  | 21 | $$et{INDENT} = $oldIndent; | 
| 1164 |  |  |  |  |  |  | # process trailers if they exist | 
| 1165 | 4 |  |  |  |  | 36 | my $trailInfo = Image::ExifTool::IdentifyTrailer($raf); | 
| 1166 | 4 | 50 |  |  |  | 38 | $et->ProcessTrailers($trailInfo) if $trailInfo; | 
| 1167 |  |  |  |  |  |  | } | 
| 1168 | 5 |  |  |  |  | 46 | return $rtnVal; | 
| 1169 |  |  |  |  |  |  | } | 
| 1170 |  |  |  |  |  |  |  | 
| 1171 |  |  |  |  |  |  | 1; # end | 
| 1172 |  |  |  |  |  |  |  | 
| 1173 |  |  |  |  |  |  |  | 
| 1174 |  |  |  |  |  |  | __END__ |