File Coverage

blib/lib/Image/ExifTool/InDesign.pm
Criterion Covered Total %
statement 87 129 67.4
branch 49 114 42.9
condition 9 20 45.0
subroutine 4 4 100.0
pod 0 1 0.0
total 149 268 55.6


line stmt bran cond sub pod time code
1             #------------------------------------------------------------------------------
2             # File: InDesign.pm
3             #
4             # Description: Read/write meta information in Adobe InDesign files
5             #
6             # Revisions: 2009-06-17 - P. Harvey Created
7             #
8             # References: 1) http://www.adobe.com/devnet/xmp/pdfs/XMPSpecificationPart3.pdf
9             #------------------------------------------------------------------------------
10              
11             package Image::ExifTool::InDesign;
12              
13 1     1   3866 use strict;
  1         3  
  1         31  
14 1     1   5 use vars qw($VERSION);
  1         1  
  1         42  
15 1     1   4 use Image::ExifTool qw(:DataAccess :Utils);
  1         3  
  1         1386  
16              
17             $VERSION = '1.06';
18              
19             # map for writing metadata to InDesign files (currently only write XMP)
20             my %indMap = (
21             XMP => 'IND',
22             );
23              
24             # GUID's used in InDesign files
25             my $masterPageGUID = "\x06\x06\xed\xf5\xd8\x1d\x46\xe5\xbd\x31\xef\xe7\xfe\x74\xb7\x1d";
26             my $objectHeaderGUID = "\xde\x39\x39\x79\x51\x88\x4b\x6c\x8E\x63\xee\xf8\xae\xe0\xdd\x38";
27             my $objectTrailerGUID = "\xfd\xce\xdb\x70\xf7\x86\x4b\x4f\xa4\xd3\xc7\x28\xb3\x41\x71\x06";
28              
29             #------------------------------------------------------------------------------
30             # Read or write meta information in an InDesign file
31             # Inputs: 0) ExifTool object reference, 1) dirInfo reference
32             # Returns: 1 on success, 0 if this wasn't a valid InDesign file, or -1 on write error
33             sub ProcessIND($$)
34             {
35 5     5 0 9 my ($et, $dirInfo) = @_;
36 5         10 my $raf = $$dirInfo{RAF};
37 5         8 my $outfile = $$dirInfo{OutFile};
38 5         7 my ($hdr, $buff, $buf2, $err, $writeLen, $foundXMP);
39              
40             # validate the InDesign file
41 5 50       12 return 0 unless $raf->Read($hdr, 16) == 16;
42 5 50       12 return 0 unless $hdr eq $masterPageGUID;
43 5 50       12 return 0 unless $raf->Read($buff, 8) == 8;
44 5 50       22 $et->SetFileType($buff eq 'DOCUMENT' ? 'INDD' : 'IND'); # set the FileType tag
45              
46             # read the master pages
47 5 50       14 $raf->Seek(0, 0) or $err = 'Seek error', goto DONE;
48 5 50 33     14 unless ($raf->Read($buff, 4096) == 4096 and
49             $raf->Read($buf2, 4096) == 4096)
50             {
51 0         0 $err = 'Unexpected end of file';
52 0         0 goto DONE; # (goto's can be our friend)
53             }
54 5         17 SetByteOrder('II');
55 5 50       61 unless ($buf2 =~ /^\Q$masterPageGUID/) {
56 0         0 $err = 'Second master page is invalid';
57 0         0 goto DONE;
58             }
59 5         21 my $seq1 = Get64u(\$buff, 264);
60 5         12 my $seq2 = Get64u(\$buf2, 264);
61             # take the most current master page
62 5 50       12 my $curPage = $seq2 > $seq1 ? \$buf2 : \$buff;
63             # byte order of stream data may be different than headers
64 5         12 my $streamInt32u = Get8u($curPage, 24);
65 5 50       14 if ($streamInt32u == 1) {
    50          
66 0         0 $streamInt32u = 'V'; # little-endian int32u
67             } elsif ($streamInt32u == 2) {
68 5         7 $streamInt32u = 'N'; # big-endian int32u
69             } else {
70 0         0 $err = 'Invalid stream byte order';
71 0         0 goto DONE;
72             }
73 5         18 my $pages = Get32u($curPage, 280);
74 5 50       12 $pages < 2 and $err = 'Invalid page count', goto DONE;
75 5         19 my $pos = $pages * 4096;
76 5 50 33     15 if ($pos > 0x7fffffff and not $et->Options('LargeFileSupport')) {
77 0         0 $err = 'InDesign files larger than 2 GB not supported (LargeFileSupport not set)';
78 0         0 goto DONE;
79             }
80 5 100       18 if ($outfile) {
81             # make XMP the preferred group for writing
82 2         7 $et->InitWriteDirs(\%indMap, 'XMP');
83              
84 2 50       8 Write($outfile, $buff, $buf2) or $err = 1, goto DONE;
85 2         24 my $result = Image::ExifTool::CopyBlock($raf, $outfile, $pos - 8192);
86 2 50       5 unless ($result) {
87 0 0       0 $err = defined $result ? 'Error reading InDesign database' : 1;
88 0         0 goto DONE;
89             }
90 2         4 $writeLen = 0;
91             } else {
92 3 50       10 $raf->Seek($pos, 0) or $err = 'Seek error', goto DONE;
93             }
94             # scan through the contiguous objects for XMP
95 5         16 my $verbose = $et->Options('Verbose');
96 5         31 my $out = $et->Options('TextOut');
97 5         7 for (;;) {
98 10 50       23 $raf->Read($hdr, 32) or last;
99 10 100 66     104 unless (length($hdr) == 32 and $hdr =~ /^\Q$objectHeaderGUID/) {
100             # this must be null padding or we have an error
101 5 50       20 $hdr =~ /^\0+$/ or $err = 'Corrupt file or unsupported InDesign version';
102 5         9 last;
103             }
104 5         16 my $len = Get32u(\$hdr, 24);
105 5 50       12 if ($verbose) {
106 0         0 printf $out "Contiguous object at offset 0x%x (%d bytes):\n", $raf->Tell(), $len;
107 0 0       0 if ($verbose > 2) {
108 0 0       0 my $len2 = $len < 1024000 ? $len : 1024000;
109 0 0       0 $raf->Seek(-$raf->Read($buff, $len2), 1) or $err = 1;
110 0         0 $et->VerboseDump(\$buff, Addr => $raf->Tell());
111             }
112             }
113             # check for XMP if stream data is long enough
114             # (56 bytes is just enough for XMP header)
115 5 50       14 if ($len > 56) {
116 5 50       13 $raf->Read($buff, 56) == 56 or $err = 'Unexpected end of file', last;
117 5 50       28 if ($buff =~ /^(....)<\?xpacket begin=(['"])\xef\xbb\xbf\2 id=(['"])W5M0MpCehiHzreSzNTczkc9d\3/s) {
118 5         14 my $lenWord = $1; # save length word for writing later
119 5         8 $len -= 4; # get length of XMP only
120 5         9 $foundXMP = 1;
121             # I have a sample where the XMP is 107 MB, and ActivePerl may run into
122             # memory troubles (with its apparent 1 GB limit) if the XMP is larger
123             # than about 400 MB, so guard against this
124 5 50       12 if ($len > 300 * 1024 * 1024) {
125 0         0 my $msg = sprintf('Insanely large XMP (%.0f MB)', $len / (1024 * 1024));
126 0 0       0 if ($outfile) {
    0          
127 0 0       0 $et->Error($msg, 2) and $err = 1, last;
128             } elsif ($et->Options('IgnoreMinorErrors')) {
129 0         0 $et->Warn($msg);
130             } else {
131 0         0 $et->Warn("$msg. Ignored.", 1);
132 0         0 $err = 1;
133 0         0 last;
134             }
135             }
136             # load and parse the XMP data
137 5 50 33     12 unless ($raf->Seek(-52, 1) and $raf->Read($buff, $len) == $len) {
138 0         0 $err = 'Error reading XMP stream';
139 0         0 last;
140             }
141 5         22 my %dirInfo = (
142             DataPt => \$buff,
143             Parent => 'IND',
144             NoDelete => 1, # do not allow this to be deleted when writing
145             );
146             # validate xmp data length (should be same as length in header - 4)
147 5         14 my $xmpLen = unpack($streamInt32u, $lenWord);
148 5 50       13 unless ($xmpLen == $len) {
149 0 0       0 if ($xmpLen < $len) {
150 0         0 $dirInfo{DirLen} = $xmpLen;
151             } else {
152 0         0 $err = 'Truncated XMP stream (missing ' . ($xmpLen - $len) . ' bytes)';
153             }
154             }
155 5         13 my $tagTablePtr = GetTagTable('Image::ExifTool::XMP::Main');
156 5 100       24 if ($outfile) {
157 2 50       5 last if $err;
158             # make sure that XMP is writable
159 2         6 my $classID = Get32u(\$hdr, 20);
160 2 50       7 $classID & 0x40000000 or $err = 'XMP stream is not writable', last;
161 2         11 my $xmp = $et->WriteDirectory(\%dirInfo, $tagTablePtr);
162 2 50 33     10 if ($xmp and length $xmp) {
163             # write new xmp with leading length word
164 2         12 $buff = pack($streamInt32u, length $xmp) . $xmp;
165             # update header with new length and invalid checksum
166 2         28 Set32u(length($buff), \$hdr, 24);
167 2         5 Set32u(0xffffffff, \$hdr, 28);
168             } else {
169 0         0 $$et{CHANGED} = 0; # didn't change anything
170 0 0       0 $et->Warn("Can't delete XMP as a block from InDesign file") if defined $xmp;
171             # put length word back at start of stream
172 0         0 $buff = $lenWord . $buff;
173             }
174             } else {
175 3         11 $et->ProcessDirectory(\%dirInfo, $tagTablePtr);
176             }
177 5         14 $len = 0; # we got the full stream (nothing left to read)
178             } else {
179 0         0 $len -= 56; # we got 56 bytes of the stream
180             }
181             } else {
182 0         0 $buff = ''; # must reset this for writing later
183             }
184 5 100       18 if ($outfile) {
    50          
185             # write object header and data
186 2 50       6 Write($outfile, $hdr, $buff) or $err = 1, last;
187 2         6 my $result = Image::ExifTool::CopyBlock($raf, $outfile, $len);
188 2 50       6 unless ($result) {
189 0 0       0 $err = defined $result ? 'Truncated stream data' : 1;
190 0         0 last;
191             }
192 2         5 $writeLen += 32 + length($buff) + $len;
193             } elsif ($len) {
194             # skip over remaining stream data
195 0 0       0 $raf->Seek($len, 1) or $err = 'Seek error', last;
196             }
197 5 50       14 $raf->Read($buff, 32) == 32 or $err = 'Unexpected end of file', last;
198 5 50       66 unless ($buff =~ /^\Q$objectTrailerGUID/) {
199 0         0 $err = 'Invalid object trailer';
200 0         0 last;
201             }
202 5 100       14 if ($outfile) {
203             # make sure object UID and ClassID are the same in the trailer
204 2 50       9 substr($hdr,16,8) eq substr($buff,16,8) or $err = 'Non-matching object trailer', last;
205             # write object trailer
206 2 50       8 Write($outfile, $objectTrailerGUID, substr($hdr,16)) or $err = 1, last;
207 2         5 $writeLen += 32;
208             }
209             }
210 5 100       12 if ($outfile) {
211             # write null padding if necessary
212             # (InDesign files must be an even number of 4096-byte blocks)
213 2         6 my $part = $writeLen % 4096;
214 2 50 50     11 Write($outfile, "\0" x (4096 - $part)) or $err = 1 if $part;
215             }
216             DONE:
217 5 50       17 if (not $err) {
    0          
    0          
218 5 50 66     17 $et->Warn('No XMP stream to edit') if $outfile and not $foundXMP;
219 5         17 return 1; # success!
220             } elsif (not $outfile) {
221             # issue warning on read error
222 0 0         $et->Warn($err) unless $err eq '1';
223             } elsif ($err ne '1') {
224             # set error and return success code
225 0           $et->Error($err);
226             } else {
227 0           return -1; # write error
228             }
229 0           return 1;
230             }
231              
232             1; # end
233              
234             __END__