File Coverage

blib/lib/Image/ExifTool/Photoshop.pm
Criterion Covered Total %
statement 155 324 47.8
branch 58 234 24.7
condition 19 69 27.5
subroutine 8 10 80.0
pod 0 6 0.0
total 240 643 37.3


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__