File Coverage

blib/lib/Image/ExifTool/Photoshop.pm
Criterion Covered Total %
statement 155 334 46.4
branch 58 234 24.7
condition 19 69 27.5
subroutine 8 11 72.7
pod 0 7 0.0
total 240 655 36.6


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