line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
2
|
|
|
|
|
|
|
# File: WritePDF.pl |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# Description: Write PDF meta information |
5
|
|
|
|
|
|
|
# |
6
|
|
|
|
|
|
|
# Revisions: 12/08/2007 - P. Harvey Created |
7
|
|
|
|
|
|
|
# |
8
|
|
|
|
|
|
|
# References: 1) http://partners.adobe.com/public/developer/pdf/index_reference.html |
9
|
|
|
|
|
|
|
# |
10
|
|
|
|
|
|
|
# Notes: The special "PDF-update" group can be deleted to revert exiftool updates |
11
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
12
|
|
|
|
|
|
|
package Image::ExifTool::PDF; |
13
|
|
|
|
|
|
|
|
14
|
19
|
|
|
19
|
|
130
|
use strict; |
|
19
|
|
|
|
|
40
|
|
|
19
|
|
|
|
|
652
|
|
15
|
19
|
|
|
19
|
|
101
|
use vars qw($lastFetched); |
|
19
|
|
|
|
|
52
|
|
|
19
|
|
|
|
|
76212
|
|
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
sub WriteObject($$); |
18
|
|
|
|
|
|
|
sub EncodeString($); |
19
|
|
|
|
|
|
|
sub CryptObject($); |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
# comments to mark beginning and end of ExifTool incremental update |
22
|
|
|
|
|
|
|
my $beginComment = '%BeginExifToolUpdate'; |
23
|
|
|
|
|
|
|
my $endComment = '%EndExifToolUpdate '; |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
my $keyExt; # crypt key extension |
26
|
|
|
|
|
|
|
my $pdfVer; # version of PDF file we are currently writing |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
# internal tags used in dictionary objects |
29
|
|
|
|
|
|
|
my %myDictTags = ( |
30
|
|
|
|
|
|
|
_tags => 1, _stream => 1, _decrypted => 1, _needCrypt => 1, |
31
|
|
|
|
|
|
|
_filtered => 1, _entry_size => 1, _table => 1, |
32
|
|
|
|
|
|
|
); |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
# map for directories that we can add |
35
|
|
|
|
|
|
|
my %pdfMap = ( |
36
|
|
|
|
|
|
|
XMP => 'PDF', |
37
|
|
|
|
|
|
|
); |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
40
|
|
|
|
|
|
|
# Validate raw PDF values for writing (string date integer real boolean name) |
41
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref, 1) tagInfo hash ref, 2) raw value ref |
42
|
|
|
|
|
|
|
# Returns: error string or undef (and possibly changes value) on success |
43
|
|
|
|
|
|
|
sub CheckPDF($$$) |
44
|
|
|
|
|
|
|
{ |
45
|
97
|
|
|
97
|
0
|
269
|
my ($et, $tagInfo, $valPtr) = @_; |
46
|
97
|
|
66
|
|
|
495
|
my $format = $$tagInfo{Writable} || $tagInfo->{Table}->{WRITABLE}; |
47
|
97
|
50
|
|
|
|
464
|
if (not $format) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
48
|
0
|
|
|
|
|
0
|
return 'No writable format'; |
49
|
|
|
|
|
|
|
} elsif ($format eq 'string') { |
50
|
|
|
|
|
|
|
# (encode later because list-type string tags need to be encoded as a unit) |
51
|
|
|
|
|
|
|
} elsif ($format eq 'date') { |
52
|
|
|
|
|
|
|
# be flexible about this for now |
53
|
31
|
50
|
|
|
|
158
|
return 'Bad date format' unless $$valPtr =~ /^\d{4}/; |
54
|
|
|
|
|
|
|
} elsif ($format eq 'integer') { |
55
|
0
|
0
|
|
|
|
0
|
return 'Not an integer' unless Image::ExifTool::IsInt($$valPtr); |
56
|
|
|
|
|
|
|
} elsif ($format eq 'real') { |
57
|
0
|
0
|
|
|
|
0
|
return 'Not a real number' unless $$valPtr =~ /^[+-]?(?=\d|\.\d)\d*(\.\d*)?$/; |
58
|
|
|
|
|
|
|
} elsif ($format eq 'boolean') { |
59
|
0
|
0
|
0
|
|
|
0
|
$$valPtr = ($$valPtr and $$valPtr !~ /^f/i) ? 'true' : 'false'; |
60
|
|
|
|
|
|
|
} elsif ($format eq 'name') { |
61
|
0
|
0
|
|
|
|
0
|
return 'Invalid PDF name' if $$valPtr =~ /\0/; |
62
|
|
|
|
|
|
|
} else { |
63
|
0
|
|
|
|
|
0
|
return "Invalid PDF format '${format}'"; |
64
|
|
|
|
|
|
|
} |
65
|
97
|
|
|
|
|
339
|
return undef; # value is OK |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
69
|
|
|
|
|
|
|
# Format value for writing to PDF file |
70
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) value, 2) format string (string,date,integer,real,boolean,name) |
71
|
|
|
|
|
|
|
# Returns: formatted value or undef on error |
72
|
|
|
|
|
|
|
# Notes: Called at write time, so $pdfVer may be checked |
73
|
|
|
|
|
|
|
sub WritePDFValue($$$) |
74
|
|
|
|
|
|
|
{ |
75
|
13
|
|
|
13
|
0
|
30
|
my ($et, $val, $format) = @_; |
76
|
13
|
50
|
|
|
|
34
|
if (not $format) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
77
|
0
|
|
|
|
|
0
|
return undef; |
78
|
|
|
|
|
|
|
} elsif ($format eq 'string') { |
79
|
|
|
|
|
|
|
# encode as UCS2 if it contains any special characters |
80
|
11
|
50
|
|
|
|
28
|
$val = "\xfe\xff" . $et->Encode($val,'UCS2','MM') if $val =~ /[\x80-\xff]/; |
81
|
11
|
|
|
|
|
24
|
EncodeString(\$val); |
82
|
|
|
|
|
|
|
} elsif ($format eq 'date') { |
83
|
|
|
|
|
|
|
# convert date to "D:YYYYmmddHHMMSS+-HH'MM'" format |
84
|
2
|
|
|
|
|
18
|
$val =~ s/([-+]\d{2}):(\d{2})/${1}'${2}'/; # change timezone delimiters if necessary |
85
|
2
|
|
|
|
|
6
|
$val =~ tr/ ://d; # remove spaces and colons |
86
|
2
|
|
|
|
|
4
|
$val = "D:$val"; # add leading "D:" |
87
|
2
|
|
|
|
|
6
|
EncodeString(\$val); |
88
|
|
|
|
|
|
|
} elsif ($format =~ /^(integer|real|boolean)$/) { |
89
|
|
|
|
|
|
|
# no reformatting necessary |
90
|
|
|
|
|
|
|
} elsif ($format eq 'name') { |
91
|
0
|
0
|
|
|
|
0
|
return undef if $val =~ /\0/; |
92
|
0
|
0
|
|
|
|
0
|
if ($pdfVer >= 1.2) { |
93
|
0
|
|
|
|
|
0
|
$val =~ s/([\t\n\f\r ()<>[\]{}\/%#])/sprintf('#%.2x',ord $1)/sge; |
|
0
|
|
|
|
|
0
|
|
94
|
|
|
|
|
|
|
} else { |
95
|
0
|
0
|
|
|
|
0
|
return undef if $val =~ /[\t\n\f\r ()<>[\]{}\/%]/; |
96
|
|
|
|
|
|
|
} |
97
|
0
|
|
|
|
|
0
|
$val = "/$val"; # add leading '/' |
98
|
|
|
|
|
|
|
} else { |
99
|
0
|
|
|
|
|
0
|
return undef; |
100
|
|
|
|
|
|
|
} |
101
|
13
|
|
|
|
|
26
|
return $val; |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
105
|
|
|
|
|
|
|
# Encode PDF string |
106
|
|
|
|
|
|
|
# Inputs: 0) reference to PDF string |
107
|
|
|
|
|
|
|
# Returns: (updates string with encoded data) |
108
|
|
|
|
|
|
|
sub EncodeString($) |
109
|
|
|
|
|
|
|
{ |
110
|
13
|
|
|
13
|
0
|
16
|
my $strPt = shift; |
111
|
13
|
50
|
|
|
|
29
|
if (ref $$strPt eq 'ARRAY') { |
112
|
0
|
|
|
|
|
0
|
my $str; |
113
|
0
|
|
|
|
|
0
|
foreach $str (@{$$strPt}) { |
|
0
|
|
|
|
|
0
|
|
114
|
0
|
|
|
|
|
0
|
EncodeString(\$str); |
115
|
|
|
|
|
|
|
} |
116
|
0
|
|
|
|
|
0
|
return; |
117
|
|
|
|
|
|
|
} |
118
|
13
|
|
|
|
|
44
|
Crypt($strPt, $keyExt, 1); # encrypt if necessary |
119
|
|
|
|
|
|
|
# encode as hex if we have any control characters (except tab) |
120
|
13
|
50
|
|
|
|
28
|
if ($$strPt=~/[\x00-\x08\x0a-\x1f\x7f\xff]/) { |
121
|
|
|
|
|
|
|
# encode as hex |
122
|
0
|
|
|
|
|
0
|
my $str=''; |
123
|
0
|
|
|
|
|
0
|
my $len = length $$strPt; |
124
|
0
|
|
|
|
|
0
|
my $i = 0; |
125
|
0
|
|
|
|
|
0
|
for (;;) { |
126
|
0
|
0
|
|
|
|
0
|
my $n = $len - $i or last; |
127
|
0
|
0
|
|
|
|
0
|
$n = 40 if $n > 40; # break into reasonable-length lines |
128
|
0
|
0
|
|
|
|
0
|
$str .= $/ if $i; |
129
|
0
|
|
|
|
|
0
|
$str .= unpack('H*', substr($$strPt, $i, $n)); |
130
|
0
|
|
|
|
|
0
|
$i += $n; |
131
|
|
|
|
|
|
|
} |
132
|
0
|
|
|
|
|
0
|
$$strPt = "<$str>"; |
133
|
|
|
|
|
|
|
} else { |
134
|
13
|
|
|
|
|
23
|
$$strPt =~ s/([()\\])/\\$1/g; # must escape round brackets and backslashes |
135
|
13
|
|
|
|
|
31
|
$$strPt = "($$strPt)"; |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
140
|
|
|
|
|
|
|
# Encrypt an object |
141
|
|
|
|
|
|
|
# Inputs: 0) PDF object (encrypts in place) |
142
|
|
|
|
|
|
|
# Notes: Encrypts according to "_needCrypt" dictionary entry, |
143
|
|
|
|
|
|
|
# then deletes "_needCrypt" when done |
144
|
|
|
|
|
|
|
sub CryptObject($) |
145
|
|
|
|
|
|
|
{ |
146
|
0
|
|
|
0
|
0
|
0
|
my $obj = $_[0]; |
147
|
0
|
0
|
|
|
|
0
|
if (not ref $obj) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
148
|
|
|
|
|
|
|
# only literal strings and hex strings are encrypted |
149
|
0
|
0
|
|
|
|
0
|
if ($obj =~ /^[(<]/) { |
150
|
0
|
|
|
|
|
0
|
undef $lastFetched; # (reset this just in case) |
151
|
0
|
|
|
|
|
0
|
my $val = ReadPDFValue($obj); |
152
|
0
|
|
|
|
|
0
|
EncodeString(\$val); |
153
|
0
|
|
|
|
|
0
|
$_[0] = $val; |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
} elsif (ref $obj eq 'HASH') { |
156
|
0
|
|
|
|
|
0
|
my $tag; |
157
|
0
|
|
|
|
|
0
|
my $needCrypt = $$obj{_needCrypt}; |
158
|
0
|
|
|
|
|
0
|
foreach $tag (keys %$obj) { |
159
|
0
|
0
|
|
|
|
0
|
next if $myDictTags{$tag}; |
160
|
|
|
|
|
|
|
# re-encrypt necessary objects only (others are still encrypted) |
161
|
|
|
|
|
|
|
# (this is really annoying, but is necessary because objects stored |
162
|
|
|
|
|
|
|
# in encrypted streams are decrypted when extracting, but strings stored |
163
|
|
|
|
|
|
|
# as direct objects are decrypted later since they must be decoded |
164
|
|
|
|
|
|
|
# before being decrypted) |
165
|
0
|
0
|
|
|
|
0
|
if ($needCrypt) { |
166
|
0
|
0
|
|
|
|
0
|
next unless defined $$needCrypt{$tag} ? $$needCrypt{$tag} : $$needCrypt{'*'}; |
|
|
0
|
|
|
|
|
|
167
|
|
|
|
|
|
|
} |
168
|
0
|
|
|
|
|
0
|
CryptObject($$obj{$tag}); |
169
|
|
|
|
|
|
|
} |
170
|
0
|
|
|
|
|
0
|
delete $$obj{_needCrypt}; # avoid re-re-crypting |
171
|
|
|
|
|
|
|
} elsif (ref $obj eq 'ARRAY') { |
172
|
0
|
|
|
|
|
0
|
my $val; |
173
|
0
|
|
|
|
|
0
|
foreach $val (@$obj) { |
174
|
0
|
|
|
|
|
0
|
CryptObject($val); |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
180
|
|
|
|
|
|
|
# Get free entries from xref stream dictionary that we wrote previously |
181
|
|
|
|
|
|
|
# Inputs: 0) xref dictionary reference |
182
|
|
|
|
|
|
|
# Returns: free entry hash (keys are object numbers, values are xref entry list refs) |
183
|
|
|
|
|
|
|
sub GetFreeEntries($) |
184
|
|
|
|
|
|
|
{ |
185
|
0
|
|
|
0
|
0
|
0
|
my $dict = shift; |
186
|
0
|
|
|
|
|
0
|
my %xrefFree; |
187
|
|
|
|
|
|
|
# from the start we have only written xref stream entries in 'CNn' format, |
188
|
|
|
|
|
|
|
# so we can simplify things for now and only support this type of entry |
189
|
0
|
|
|
|
|
0
|
my $w = $$dict{W}; |
190
|
0
|
0
|
0
|
|
|
0
|
if (ref $w eq 'ARRAY' and "@$w" eq '1 4 2') { |
191
|
0
|
|
|
|
|
0
|
my $size = $$dict{_entry_size}; # this will be 7 for 'CNn' |
192
|
0
|
|
|
|
|
0
|
my $index = $$dict{Index}; |
193
|
0
|
|
|
|
|
0
|
my $len = length $$dict{_stream}; |
194
|
|
|
|
|
|
|
# scan the table for free objects |
195
|
0
|
|
|
|
|
0
|
my $num = scalar(@$index) / 2; |
196
|
0
|
|
|
|
|
0
|
my $pos = 0; |
197
|
0
|
|
|
|
|
0
|
my ($i, $j); |
198
|
0
|
|
|
|
|
0
|
for ($i=0; $i<$num; ++$i) { |
199
|
0
|
|
|
|
|
0
|
my $start = $$index[$i*2]; |
200
|
0
|
|
|
|
|
0
|
my $count = $$index[$i*2+1]; |
201
|
0
|
|
|
|
|
0
|
for ($j=0; $j<$count; ++$j) { |
202
|
0
|
0
|
|
|
|
0
|
last if $pos + $size > $len; |
203
|
0
|
|
|
|
|
0
|
my @t = unpack("x$pos CNn", $$dict{_stream}); |
204
|
|
|
|
|
|
|
# add entry if object was free |
205
|
0
|
0
|
|
|
|
0
|
$xrefFree{$start+$j} = [ $t[1], $t[2], 'f' ] if $t[0] == 0; |
206
|
0
|
|
|
|
|
0
|
$pos += $size; # step to next entry |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
} |
210
|
0
|
|
|
|
|
0
|
return \%xrefFree; |
211
|
|
|
|
|
|
|
} |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
214
|
|
|
|
|
|
|
# Write PDF object |
215
|
|
|
|
|
|
|
# Inputs: 0) output file or scalar ref, 1) PDF object |
216
|
|
|
|
|
|
|
# Returns: true on success |
217
|
|
|
|
|
|
|
# Notes: inserts white space before object, but none afterward |
218
|
|
|
|
|
|
|
sub WriteObject($$) |
219
|
|
|
|
|
|
|
{ |
220
|
208
|
|
|
208
|
0
|
311
|
my ($outfile, $obj) = @_; |
221
|
208
|
100
|
|
|
|
479
|
if (ref $obj eq 'SCALAR') { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
222
|
43
|
50
|
|
|
|
94
|
Write($outfile, ' ', $$obj) or return 0; |
223
|
|
|
|
|
|
|
} elsif (ref $obj eq 'ARRAY') { |
224
|
|
|
|
|
|
|
# write array |
225
|
12
|
50
|
|
|
|
45
|
Write($outfile, @$obj > 10 ? $/ : ' ', '[') or return 0; |
|
|
50
|
|
|
|
|
|
226
|
12
|
|
|
|
|
19
|
my $item; |
227
|
12
|
|
|
|
|
24
|
foreach $item (@$obj) { |
228
|
22
|
50
|
|
|
|
44
|
WriteObject($outfile, $item) or return 0; |
229
|
|
|
|
|
|
|
} |
230
|
12
|
50
|
|
|
|
25
|
Write($outfile, ' ]') or return 0; |
231
|
|
|
|
|
|
|
} elsif (ref $obj eq 'HASH') { |
232
|
|
|
|
|
|
|
# write dictionary |
233
|
47
|
|
|
|
|
56
|
my $tag; |
234
|
47
|
50
|
|
|
|
79
|
Write($outfile, $/, '<<') or return 0; |
235
|
|
|
|
|
|
|
# prepare object as required if it has a stream |
236
|
47
|
100
|
|
|
|
102
|
if ($$obj{_stream}) { |
237
|
|
|
|
|
|
|
# encrypt stream if necessary (must be done before determining Length) |
238
|
9
|
50
|
|
|
|
40
|
CryptStream($obj, $keyExt) if $$obj{_decrypted}; |
239
|
|
|
|
|
|
|
# write "Length" entry in dictionary |
240
|
9
|
|
|
|
|
17
|
$$obj{Length} = length $$obj{_stream}; |
241
|
9
|
|
|
|
|
13
|
push @{$$obj{_tags}}, 'Length'; |
|
9
|
|
|
|
|
24
|
|
242
|
|
|
|
|
|
|
# delete Filter-related entries since we don't yet write filtered streams |
243
|
9
|
|
|
|
|
14
|
delete $$obj{Filter}; |
244
|
9
|
|
|
|
|
14
|
delete $$obj{DecodeParms}; |
245
|
9
|
|
|
|
|
14
|
delete $$obj{DL}; |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
# don't write my internal entries |
248
|
47
|
|
|
|
|
175
|
my %wrote = %myDictTags; |
249
|
|
|
|
|
|
|
# write tags in original order, adding new ones later alphabetically |
250
|
47
|
|
|
|
|
81
|
foreach $tag (@{$$obj{_tags}}, sort keys %$obj) { |
|
47
|
|
|
|
|
189
|
|
251
|
|
|
|
|
|
|
# ignore already-written or missing entries |
252
|
339
|
100
|
100
|
|
|
778
|
next if $wrote{$tag} or not defined $$obj{$tag}; |
253
|
139
|
50
|
|
|
|
301
|
Write($outfile, $/, "/$tag") or return 0; |
254
|
139
|
50
|
|
|
|
268
|
WriteObject($outfile, $$obj{$tag}) or return 0; |
255
|
139
|
|
|
|
|
242
|
$wrote{$tag} = 1; |
256
|
|
|
|
|
|
|
} |
257
|
47
|
50
|
|
|
|
124
|
Write($outfile, $/, '>>') or return 0; |
258
|
47
|
100
|
|
|
|
124
|
if ($$obj{_stream}) { |
259
|
|
|
|
|
|
|
# write object stream |
260
|
|
|
|
|
|
|
# (a single 0x0d may not follow 'stream', so use 0x0d+0x0a here to be sure) |
261
|
9
|
50
|
|
|
|
27
|
Write($outfile, $/, "stream\x0d\x0a") or return 0; |
262
|
9
|
50
|
|
|
|
27
|
Write($outfile, $$obj{_stream}, $/, 'endstream') or return 0; |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
} else { |
265
|
|
|
|
|
|
|
# write string, number, name or object reference |
266
|
106
|
|
|
|
|
151
|
Write($outfile, ' ', $obj); |
267
|
|
|
|
|
|
|
} |
268
|
208
|
|
|
|
|
374
|
return 1; |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
272
|
|
|
|
|
|
|
# Write PDF File |
273
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) dirInfo reference |
274
|
|
|
|
|
|
|
# Returns: 1 on success, 0 if not valid PDF file, -1 on write error |
275
|
|
|
|
|
|
|
# Notes: dictionary structure: Main --+--> Info |
276
|
|
|
|
|
|
|
# +--> Root --> Metadata |
277
|
|
|
|
|
|
|
sub WritePDF($$) |
278
|
|
|
|
|
|
|
{ |
279
|
19
|
|
|
19
|
0
|
39
|
my ($et, $dirInfo) = @_; |
280
|
19
|
|
|
|
|
39
|
my $raf = $$dirInfo{RAF}; |
281
|
19
|
|
|
|
|
30
|
my $outfile = $$dirInfo{OutFile}; |
282
|
19
|
|
|
|
|
47
|
my ($buff, %capture, %newXRef, %newObj, $objRef); |
283
|
19
|
|
|
|
|
0
|
my ($out, $id, $gen, $obj); |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
# make sure this is a PDF file |
286
|
19
|
|
|
|
|
54
|
my $pos = $raf->Tell(); |
287
|
19
|
50
|
|
|
|
58
|
$raf->Read($buff, 1024) >= 8 or return 0; |
288
|
19
|
50
|
|
|
|
114
|
$buff =~ /^(\s*)%PDF-(\d+\.\d+)/ or return 0; |
289
|
19
|
|
|
|
|
61
|
$$et{PDFBase} = length $1; |
290
|
19
|
|
|
|
|
60
|
$raf->Seek($pos, 0); |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
# create a new ExifTool object and use it to read PDF and XMP information |
293
|
19
|
|
|
|
|
114
|
my $newTool = new Image::ExifTool; |
294
|
19
|
|
|
|
|
59
|
$newTool->Options(List => 1); |
295
|
19
|
|
|
|
|
48
|
$newTool->Options(Password => $et->Options('Password')); |
296
|
19
|
|
|
|
|
54
|
$newTool->Options(NoPDFList => $et->Options('NoPDFList')); |
297
|
19
|
|
|
|
|
42
|
$$newTool{PDF_CAPTURE} = \%capture; |
298
|
19
|
|
|
|
|
50
|
my $info = $newTool->ImageInfo($raf, 'XMP', 'PDF:*', 'Error', 'Warning'); |
299
|
|
|
|
|
|
|
# not a valid PDF file unless we got a version number |
300
|
|
|
|
|
|
|
# (note: can't just check $$info{PDFVersion} due to possibility of XMP-pdf:PDFVersion) |
301
|
19
|
|
|
|
|
59
|
my $vers = $newTool->GetInfo('PDF:PDFVersion'); |
302
|
|
|
|
|
|
|
# take highest version number if multiple versions in an incremental save |
303
|
19
|
|
|
|
|
77
|
($pdfVer) = sort { $b <=> $a } values %$vers; |
|
0
|
|
|
|
|
0
|
|
304
|
19
|
50
|
|
|
|
51
|
$pdfVer or $et->Error('Missing PDF:PDFVersion'), return 0; |
305
|
|
|
|
|
|
|
# check version number |
306
|
19
|
50
|
|
|
|
42
|
if ($pdfVer > 1.7) { |
307
|
0
|
|
|
|
|
0
|
$et->Warn("The PDF $pdfVer specification is not freely available", 1); |
308
|
|
|
|
|
|
|
# (so writing by ExifTool is based on trial and error) |
309
|
|
|
|
|
|
|
} |
310
|
|
|
|
|
|
|
# fail if we had any serious errors while extracting information |
311
|
19
|
50
|
33
|
|
|
71
|
if ($capture{Error} or $$info{Error}) { |
312
|
0
|
|
0
|
|
|
0
|
$et->Error($capture{Error} || $$info{Error}); |
313
|
0
|
|
|
|
|
0
|
return 1; |
314
|
|
|
|
|
|
|
} |
315
|
|
|
|
|
|
|
# make sure we have everything we need to rewrite this file |
316
|
19
|
|
|
|
|
39
|
foreach $obj (qw(Main Root xref)) { |
317
|
57
|
50
|
|
|
|
117
|
next if $capture{$obj}; |
318
|
|
|
|
|
|
|
# any warning we received may give a clue about why this object is missing |
319
|
0
|
0
|
|
|
|
0
|
$et->Error($$info{Warning}) if $$info{Warning}; |
320
|
0
|
|
|
|
|
0
|
$et->Error("Can't find $obj object"); |
321
|
0
|
|
|
|
|
0
|
return 1; |
322
|
|
|
|
|
|
|
} |
323
|
19
|
|
|
|
|
75
|
$et->InitWriteDirs(\%pdfMap, 'XMP'); |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
# copy file up to start of previous exiftool update or end of file |
326
|
|
|
|
|
|
|
# (comment, startxref & EOF with 11-digit offsets and 2-byte newlines is 63 bytes) |
327
|
19
|
50
|
33
|
|
|
67
|
$raf->Seek(-64,2) and $raf->Read($buff,64) and $raf->Seek(0,0) or return -1; |
|
|
|
33
|
|
|
|
|
328
|
19
|
|
|
|
|
46
|
my $rtn = 1; |
329
|
19
|
|
|
|
|
28
|
my $prevUpdate; |
330
|
|
|
|
|
|
|
# (now $endComment is before "startxref", but pre-7.41 we wrote it after the EOF) |
331
|
19
|
100
|
|
|
|
181
|
if ($buff =~ /$endComment(\d+)\s+(startxref\s+\d+\s+%%EOF\s+)?$/s) { |
|
|
50
|
|
|
|
|
|
332
|
16
|
|
|
|
|
42
|
$prevUpdate = $1; |
333
|
|
|
|
|
|
|
# rewrite the file up to the original EOF |
334
|
16
|
50
|
|
|
|
92
|
Image::ExifTool::CopyBlock($raf, $outfile, $prevUpdate + $$et{PDFBase}) or $rtn = -1; |
335
|
|
|
|
|
|
|
# verify that we are now at the start of an ExifTool update |
336
|
16
|
50
|
33
|
|
|
60
|
unless ($raf->Read($buff, length $beginComment) and $buff eq $beginComment) { |
337
|
0
|
|
|
|
|
0
|
$et->Error('Previous ExifTool update is corrupted'); |
338
|
0
|
|
|
|
|
0
|
return $rtn; |
339
|
|
|
|
|
|
|
} |
340
|
16
|
50
|
|
|
|
53
|
$raf->Seek($prevUpdate+$$et{PDFBase}, 0) or $rtn = -1; |
341
|
16
|
100
|
|
|
|
57
|
if ($$et{DEL_GROUP}{'PDF-update'}) { |
342
|
2
|
|
|
|
|
9
|
$et->VPrint(0, " Reverted previous ExifTool updates\n"); |
343
|
2
|
|
|
|
|
4
|
++$$et{CHANGED}; |
344
|
2
|
|
|
|
|
27
|
return $rtn; |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
} elsif ($$et{DEL_GROUP}{'PDF-update'}) { |
347
|
0
|
|
|
|
|
0
|
$et->Error('File contains no previous ExifTool update'); |
348
|
0
|
|
|
|
|
0
|
return $rtn; |
349
|
|
|
|
|
|
|
} else { |
350
|
|
|
|
|
|
|
# rewrite the whole file |
351
|
3
|
|
|
|
|
11
|
while ($raf->Read($buff, 65536)) { |
352
|
3
|
50
|
|
|
|
15
|
Write($outfile, $buff) or $rtn = -1; |
353
|
|
|
|
|
|
|
} |
354
|
|
|
|
|
|
|
} |
355
|
17
|
50
|
|
|
|
64
|
$out = $et->Options('TextOut') if $et->Options('Verbose'); |
356
|
|
|
|
|
|
|
# |
357
|
|
|
|
|
|
|
# create our new PDF objects to write |
358
|
|
|
|
|
|
|
# |
359
|
17
|
|
|
|
|
35
|
my $xref = $capture{xref}; |
360
|
17
|
|
|
|
|
28
|
my $mainDict = $capture{Main}; |
361
|
17
|
|
|
|
|
30
|
my $metaRef = $capture{Root}->{Metadata}; |
362
|
17
|
|
|
|
|
32
|
my $nextObject; |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
# start by finding reference for info object in case it was deleted |
365
|
|
|
|
|
|
|
# in a previous edit so we can re-use it here if adding PDF Info |
366
|
|
|
|
|
|
|
my $prevInfoRef; |
367
|
17
|
100
|
|
|
|
40
|
if ($prevUpdate) { |
368
|
14
|
50
|
|
|
|
38
|
unless ($capture{Prev}) { |
369
|
0
|
|
|
|
|
0
|
$et->Error("Can't locate trailer dictionary prior to last edit"); |
370
|
0
|
|
|
|
|
0
|
return $rtn; |
371
|
|
|
|
|
|
|
} |
372
|
14
|
|
|
|
|
24
|
$prevInfoRef = $capture{Prev}->{Info}; |
373
|
|
|
|
|
|
|
# start from previous size so the xref table doesn't continue |
374
|
|
|
|
|
|
|
# to grow if we repeatedly add and delete the Metadata object |
375
|
14
|
|
|
|
|
26
|
$nextObject = $capture{Prev}->{Size}; |
376
|
|
|
|
|
|
|
# don't re-use Meta reference if object was added in a previous update |
377
|
14
|
100
|
66
|
|
|
120
|
undef $metaRef if $metaRef and $$metaRef=~/^(\d+)/ and $1 >= $nextObject; |
|
|
|
100
|
|
|
|
|
378
|
|
|
|
|
|
|
} else { |
379
|
3
|
|
|
|
|
6
|
$prevInfoRef = $$mainDict{Info}; |
380
|
3
|
|
|
|
|
6
|
$nextObject = $$mainDict{Size}; |
381
|
|
|
|
|
|
|
} |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
# delete entire PDF group if specified |
384
|
17
|
|
|
|
|
31
|
my $infoChanged = 0; |
385
|
17
|
100
|
100
|
|
|
50
|
if ($$et{DEL_GROUP}{PDF} and $capture{Info}) { |
386
|
4
|
|
|
|
|
16
|
delete $capture{Info}; |
387
|
4
|
|
|
|
|
16
|
$info = { XMP => $$info{XMP} }; # remove extracted PDF tags |
388
|
4
|
50
|
|
|
|
12
|
print $out " Deleting PDF Info dictionary\n" if $out; |
389
|
4
|
|
|
|
|
7
|
++$infoChanged; |
390
|
|
|
|
|
|
|
} |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
# create new Info dictionary if necessary |
393
|
17
|
100
|
|
|
|
58
|
$capture{Info} = { _tags => [ ] } unless $capture{Info}; |
394
|
17
|
|
|
|
|
28
|
my $infoDict = $capture{Info}; |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
# must pre-determine Info reference to be used in encryption |
397
|
17
|
|
100
|
|
|
69
|
my $infoRef = $prevInfoRef || \ "$nextObject 0 R"; |
398
|
17
|
|
|
|
|
33
|
$keyExt = $$infoRef; |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
# must encrypt all values in dictionary if they came from an encrypted stream |
401
|
17
|
50
|
|
|
|
37
|
CryptObject($infoDict) if $$infoDict{_needCrypt}; |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
# must set line separator before calling WritePDFValue() |
404
|
17
|
|
|
|
|
70
|
local $/ = $capture{newline}; |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
# rewrite PDF Info tags |
407
|
17
|
|
|
|
|
68
|
my $newTags = $et->GetNewTagInfoHash(\%Image::ExifTool::PDF::Info); |
408
|
17
|
|
|
|
|
27
|
my $tagID; |
409
|
17
|
|
|
|
|
59
|
foreach $tagID (sort keys %$newTags) { |
410
|
11
|
|
|
|
|
21
|
my $tagInfo = $$newTags{$tagID}; |
411
|
11
|
|
|
|
|
28
|
my $nvHash = $et->GetNewValueHash($tagInfo); |
412
|
11
|
|
|
|
|
17
|
my (@vals, $deleted); |
413
|
11
|
|
|
|
|
19
|
my $tag = $$tagInfo{Name}; |
414
|
11
|
|
|
|
|
18
|
my $val = $$info{$tag}; |
415
|
11
|
|
|
|
|
18
|
my $tagKey = $tag; |
416
|
11
|
100
|
|
|
|
24
|
unless (defined $val) { |
417
|
|
|
|
|
|
|
# must check for tag key with copy number |
418
|
9
|
|
|
|
|
122
|
($tagKey) = grep /^$tag/, keys %$info; |
419
|
9
|
100
|
|
|
|
31
|
$val = $$info{$tagKey} if $tagKey; |
420
|
|
|
|
|
|
|
} |
421
|
11
|
100
|
|
|
|
31
|
if (defined $val) { |
|
|
50
|
|
|
|
|
|
422
|
7
|
|
|
|
|
9
|
my @oldVals; |
423
|
7
|
100
|
|
|
|
16
|
if (ref $val eq 'ARRAY') { |
424
|
3
|
|
|
|
|
8
|
@oldVals = @$val; |
425
|
3
|
|
|
|
|
6
|
$val = shift @oldVals; |
426
|
|
|
|
|
|
|
} |
427
|
7
|
|
|
|
|
9
|
for (;;) { |
428
|
11
|
100
|
|
|
|
29
|
if ($et->IsOverwriting($nvHash, $val) > 0) { |
429
|
5
|
|
|
|
|
7
|
$deleted = 1; |
430
|
5
|
|
|
|
|
20
|
$et->VerboseValue("- PDF:$tag", $val); |
431
|
5
|
|
|
|
|
6
|
++$infoChanged; |
432
|
|
|
|
|
|
|
} else { |
433
|
6
|
|
|
|
|
12
|
push @vals, $val; |
434
|
|
|
|
|
|
|
} |
435
|
11
|
100
|
|
|
|
22
|
last unless @oldVals; |
436
|
4
|
|
|
|
|
6
|
$val = shift @oldVals; |
437
|
|
|
|
|
|
|
} |
438
|
|
|
|
|
|
|
# don't write this out if we deleted all values |
439
|
7
|
100
|
|
|
|
19
|
delete $$infoDict{$tagID} unless @vals; |
440
|
|
|
|
|
|
|
} elsif ($$nvHash{EditOnly}) { |
441
|
0
|
|
|
|
|
0
|
next; |
442
|
|
|
|
|
|
|
} |
443
|
|
|
|
|
|
|
# decide whether we want to write this tag |
444
|
|
|
|
|
|
|
# (native PDF information is always preferred, so don't check IsCreating) |
445
|
11
|
50
|
100
|
|
|
41
|
next unless $deleted or $$tagInfo{List} or not exists $$infoDict{$tagID}; |
|
|
|
66
|
|
|
|
|
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
# add new values to existing ones |
448
|
11
|
|
|
|
|
29
|
my @newVals = $et->GetNewValue($nvHash); |
449
|
11
|
100
|
|
|
|
27
|
if (@newVals) { |
450
|
9
|
|
|
|
|
26
|
push @vals, @newVals; |
451
|
9
|
|
|
|
|
17
|
++$infoChanged; |
452
|
9
|
50
|
|
|
|
19
|
if ($out) { |
453
|
0
|
|
|
|
|
0
|
foreach $val (@newVals) { |
454
|
0
|
|
|
|
|
0
|
$et->VerboseValue("+ PDF:$tag", $val); |
455
|
|
|
|
|
|
|
} |
456
|
|
|
|
|
|
|
} |
457
|
|
|
|
|
|
|
} |
458
|
11
|
50
|
|
|
|
22
|
unless (@vals) { |
459
|
|
|
|
|
|
|
# remove this entry from the Info dictionary if no values remain |
460
|
0
|
|
|
|
|
0
|
delete $$infoDict{$tagID}; |
461
|
0
|
|
|
|
|
0
|
next; |
462
|
|
|
|
|
|
|
} |
463
|
|
|
|
|
|
|
# format value(s) for writing to PDF file |
464
|
11
|
|
66
|
|
|
37
|
my $writable = $$tagInfo{Writable} || $Image::ExifTool::PDF::Info{WRITABLE}; |
465
|
11
|
100
|
|
|
|
26
|
if (not $$tagInfo{List}) { |
|
|
100
|
|
|
|
|
|
466
|
5
|
|
|
|
|
13
|
$val = WritePDFValue($et, shift(@vals), $writable); |
467
|
|
|
|
|
|
|
} elsif ($$tagInfo{List} eq 'array') { |
468
|
3
|
|
|
|
|
8
|
foreach $val (@vals) { |
469
|
5
|
|
|
|
|
11
|
$val = WritePDFValue($et, $val, $writable); |
470
|
5
|
50
|
|
|
|
13
|
defined $val or undef(@vals), last; |
471
|
|
|
|
|
|
|
} |
472
|
3
|
50
|
|
|
|
10
|
$val = @vals ? \@vals : undef; |
473
|
|
|
|
|
|
|
} else { |
474
|
3
|
|
|
|
|
10
|
$val = WritePDFValue($et, join($et->Options('ListSep'), @vals), $writable); |
475
|
|
|
|
|
|
|
} |
476
|
11
|
50
|
|
|
|
31
|
if (defined $val) { |
477
|
11
|
|
|
|
|
24
|
$$infoDict{$tagID} = $val; |
478
|
11
|
|
|
|
|
28
|
++$infoChanged; |
479
|
|
|
|
|
|
|
} else { |
480
|
0
|
|
|
|
|
0
|
$et->Warn("Error converting $$tagInfo{Name} value"); |
481
|
|
|
|
|
|
|
} |
482
|
|
|
|
|
|
|
} |
483
|
17
|
100
|
|
|
|
63
|
if ($infoChanged) { |
|
|
100
|
|
|
|
|
|
484
|
10
|
|
|
|
|
23
|
$$et{CHANGED} += $infoChanged; |
485
|
|
|
|
|
|
|
} elsif ($prevUpdate) { |
486
|
|
|
|
|
|
|
# must still write Info dictionary if it was previously updated |
487
|
6
|
|
|
|
|
22
|
my $oldPos = LocateObject($xref, $$infoRef); |
488
|
6
|
100
|
66
|
|
|
41
|
$infoChanged = 1 if $oldPos and $oldPos > $prevUpdate; |
489
|
|
|
|
|
|
|
} |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
# create new Info dictionary if necessary |
492
|
17
|
100
|
|
|
|
38
|
if ($infoChanged) { |
493
|
|
|
|
|
|
|
# increment object count if we used a new object here |
494
|
14
|
100
|
|
|
|
18
|
if (scalar(keys %{$capture{Info}}) > 1) { |
|
14
|
|
|
|
|
52
|
|
495
|
10
|
|
|
|
|
29
|
$newObj{$$infoRef} = $capture{Info};# save to write later |
496
|
10
|
|
|
|
|
21
|
$$mainDict{Info} = $infoRef; # add reference to trailer dictionary |
497
|
10
|
100
|
|
|
|
24
|
++$nextObject unless $prevInfoRef; |
498
|
|
|
|
|
|
|
} else { |
499
|
|
|
|
|
|
|
# remove Info from Main (trailer) dictionary |
500
|
4
|
|
|
|
|
9
|
delete $$mainDict{Info}; |
501
|
|
|
|
|
|
|
# write free entry in xref table if Info existed prior to all edits |
502
|
4
|
100
|
|
|
|
14
|
$newObj{$$infoRef} = '' if $prevInfoRef; |
503
|
|
|
|
|
|
|
} |
504
|
|
|
|
|
|
|
} |
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
# rewrite XMP |
507
|
|
|
|
|
|
|
my %xmpInfo = ( |
508
|
|
|
|
|
|
|
DataPt => $$info{XMP}, |
509
|
17
|
|
|
|
|
62
|
Parent => 'PDF', |
510
|
|
|
|
|
|
|
); |
511
|
17
|
|
|
|
|
50
|
my $xmpTable = Image::ExifTool::GetTagTable('Image::ExifTool::XMP::Main'); |
512
|
17
|
|
|
|
|
37
|
my $oldChanged = $$et{CHANGED}; |
513
|
17
|
|
|
|
|
64
|
my $newXMP = $et->WriteDirectory(\%xmpInfo, $xmpTable); |
514
|
17
|
100
|
|
|
|
51
|
$newXMP = $$info{XMP} ? ${$$info{XMP}} : '' unless defined $newXMP; |
|
4
|
100
|
|
|
|
8
|
|
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
# WriteDirectory() will increment CHANGED erroneously if non-existent |
517
|
|
|
|
|
|
|
# XMP is deleted as a block -- so check for this |
518
|
17
|
100
|
100
|
|
|
51
|
unless ($newXMP or $$info{XMP}) { |
519
|
3
|
|
|
|
|
5
|
$$et{CHANGED} = $oldChanged; |
520
|
3
|
|
|
|
|
10
|
$et->VPrint(0, " (XMP not changed -- still empty)\n"); |
521
|
|
|
|
|
|
|
} |
522
|
17
|
|
|
|
|
32
|
my ($metaChanged, $rootChanged); |
523
|
|
|
|
|
|
|
|
524
|
17
|
100
|
66
|
|
|
87
|
if ($$et{CHANGED} != $oldChanged and defined $newXMP) { |
|
|
100
|
33
|
|
|
|
|
525
|
10
|
|
|
|
|
18
|
$metaChanged = 1; |
526
|
|
|
|
|
|
|
} elsif ($prevUpdate and $capture{Root}->{Metadata}) { |
527
|
|
|
|
|
|
|
# must still write Metadata dictionary if it was previously updated |
528
|
4
|
|
|
|
|
8
|
my $oldPos = LocateObject($xref, ${$capture{Root}->{Metadata}}); |
|
4
|
|
|
|
|
15
|
|
529
|
4
|
50
|
33
|
|
|
21
|
$metaChanged = 1 if $oldPos and $oldPos > $prevUpdate; |
530
|
|
|
|
|
|
|
} |
531
|
17
|
100
|
|
|
|
37
|
if ($metaChanged) { |
532
|
14
|
100
|
|
|
|
37
|
if ($newXMP) { |
|
|
50
|
|
|
|
|
|
533
|
9
|
100
|
|
|
|
19
|
unless ($metaRef) { |
534
|
|
|
|
|
|
|
# allocate new PDF object |
535
|
5
|
|
|
|
|
15
|
$metaRef = \ "$nextObject 0 R"; |
536
|
5
|
|
|
|
|
9
|
++$nextObject; |
537
|
5
|
|
|
|
|
12
|
$capture{Root}->{Metadata} = $metaRef; |
538
|
5
|
|
|
|
|
35
|
$rootChanged = 1; # set flag to replace Root dictionary |
539
|
|
|
|
|
|
|
} |
540
|
|
|
|
|
|
|
# create the new metadata dictionary to write later |
541
|
9
|
|
|
|
|
56
|
$newObj{$$metaRef} = { |
542
|
|
|
|
|
|
|
Type => '/Metadata', |
543
|
|
|
|
|
|
|
Subtype => '/XML', |
544
|
|
|
|
|
|
|
# Length => length $newXMP, (set by WriteObject) |
545
|
|
|
|
|
|
|
_tags => [ qw(Type Subtype) ], |
546
|
|
|
|
|
|
|
_stream => $newXMP, |
547
|
|
|
|
|
|
|
_decrypted => 1, # (this will be ignored if EncryptMetadata is false) |
548
|
|
|
|
|
|
|
}; |
549
|
|
|
|
|
|
|
} elsif ($capture{Root}->{Metadata}) { |
550
|
|
|
|
|
|
|
# free existing metadata object |
551
|
5
|
|
|
|
|
8
|
$newObj{${$capture{Root}->{Metadata}}} = ''; |
|
5
|
|
|
|
|
14
|
|
552
|
5
|
|
|
|
|
11
|
delete $capture{Root}->{Metadata}; |
553
|
5
|
|
|
|
|
8
|
$rootChanged = 1; # set flag to replace Root dictionary |
554
|
|
|
|
|
|
|
} |
555
|
|
|
|
|
|
|
} |
556
|
|
|
|
|
|
|
# add new Root dictionary if necessary |
557
|
17
|
|
|
|
|
36
|
my $rootRef = $$mainDict{Root}; |
558
|
17
|
50
|
|
|
|
38
|
unless ($rootRef) { |
559
|
0
|
|
|
|
|
0
|
$et->Error("Can't find Root dictionary"); |
560
|
0
|
|
|
|
|
0
|
return $rtn; |
561
|
|
|
|
|
|
|
} |
562
|
17
|
100
|
100
|
|
|
53
|
if (not $rootChanged and $prevUpdate) { |
563
|
|
|
|
|
|
|
# must still write Root dictionary if it was previously updated |
564
|
6
|
|
|
|
|
18
|
my $oldPos = LocateObject($xref, $$rootRef); |
565
|
6
|
100
|
66
|
|
|
28
|
$rootChanged = 1 if $oldPos and $oldPos > $prevUpdate; |
566
|
|
|
|
|
|
|
} |
567
|
17
|
100
|
|
|
|
58
|
$newObj{$$rootRef} = $capture{Root} if $rootChanged; |
568
|
|
|
|
|
|
|
# |
569
|
|
|
|
|
|
|
# write incremental update if anything was changed |
570
|
|
|
|
|
|
|
# |
571
|
17
|
100
|
|
|
|
66
|
if ($$et{CHANGED}) { |
|
|
50
|
|
|
|
|
|
572
|
|
|
|
|
|
|
# remember position of original EOF |
573
|
16
|
|
|
|
|
50
|
my $oldEOF = Tell($outfile) - $$et{PDFBase}; |
574
|
16
|
50
|
|
|
|
36
|
Write($outfile, $beginComment) or $rtn = -1; |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
# write new objects |
577
|
16
|
|
|
|
|
69
|
foreach $objRef (sort keys %newObj) { |
578
|
38
|
50
|
|
|
|
181
|
$objRef =~ /^(\d+) (\d+)/ or $rtn = -1, last; |
579
|
38
|
|
|
|
|
116
|
($id, $gen) = ($1, $2); |
580
|
38
|
100
|
|
|
|
85
|
if (not $newObj{$objRef}) { |
581
|
7
|
50
|
|
|
|
27
|
++$gen if $gen < 65535; |
582
|
|
|
|
|
|
|
# write free entry in xref table |
583
|
7
|
|
|
|
|
17
|
$newXRef{$id} = [ 0, $gen, 'f' ]; |
584
|
7
|
|
|
|
|
13
|
next; |
585
|
|
|
|
|
|
|
} |
586
|
|
|
|
|
|
|
# create new entry for xref table |
587
|
31
|
|
|
|
|
71
|
$newXRef{$id} = [ Tell($outfile) - $$et{PDFBase} + length($/), $gen, 'n' ]; |
588
|
31
|
|
|
|
|
74
|
$keyExt = "$id $gen obj"; # (must set for stream encryption) |
589
|
31
|
50
|
|
|
|
75
|
Write($outfile, $/, $keyExt) or $rtn = -1; |
590
|
31
|
50
|
|
|
|
81
|
WriteObject($outfile, $newObj{$objRef}) or $rtn = -1; |
591
|
31
|
50
|
|
|
|
64
|
Write($outfile, $/, 'endobj') or $rtn = -1; |
592
|
|
|
|
|
|
|
} |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
# Prev points to old xref table |
595
|
16
|
100
|
|
|
|
51
|
$$mainDict{Prev} = $capture{startxref} unless $prevUpdate; |
596
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
# add xref entry for head of free-object list |
598
|
16
|
|
|
|
|
42
|
$newXRef{0} = [ 0, 65535, 'f' ]; |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
# must insert free xref entries from previous exiftool update if applicable |
601
|
16
|
100
|
|
|
|
33
|
if ($prevUpdate) { |
602
|
13
|
|
|
|
|
16
|
my $mainFree; |
603
|
|
|
|
|
|
|
# extract free entries from our previous Main xref stream |
604
|
13
|
50
|
33
|
|
|
45
|
if ($$mainDict{Type} and $$mainDict{Type} eq '/XRef') { |
605
|
0
|
|
|
|
|
0
|
$mainFree = GetFreeEntries($xref->{dicts}->[0]); |
606
|
|
|
|
|
|
|
} else { |
607
|
|
|
|
|
|
|
# free entries from Main xref table already captured for us |
608
|
13
|
|
|
|
|
26
|
$mainFree = $capture{mainFree}; |
609
|
|
|
|
|
|
|
} |
610
|
13
|
|
|
|
|
46
|
foreach $id (sort { $a <=> $b } keys %$mainFree) { |
|
6
|
|
|
|
|
21
|
|
611
|
19
|
100
|
|
|
|
54
|
$newXRef{$id} = $$mainFree{$id} unless $newXRef{$id}; |
612
|
|
|
|
|
|
|
} |
613
|
|
|
|
|
|
|
} |
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
# connect linked list of free object in our xref table |
616
|
16
|
|
|
|
|
28
|
my $prevFree = 0; |
617
|
16
|
|
|
|
|
55
|
foreach $id (sort { $b <=> $a } keys %newXRef) { # (reverse sort) |
|
70
|
|
|
|
|
108
|
|
618
|
59
|
100
|
|
|
|
118
|
next unless $newXRef{$id}->[2] eq 'f'; # skip if not free |
619
|
|
|
|
|
|
|
# no need to add free entry for objects added by us |
620
|
|
|
|
|
|
|
# in previous edits then freed again |
621
|
28
|
100
|
|
|
|
61
|
if ($id >= $nextObject) { |
622
|
3
|
|
|
|
|
7
|
delete $newXRef{$id}; # Note: deleting newXRef entry! |
623
|
3
|
|
|
|
|
6
|
next; |
624
|
|
|
|
|
|
|
} |
625
|
25
|
|
|
|
|
37
|
$newXRef{$id}->[0] = $prevFree; |
626
|
25
|
|
|
|
|
41
|
$prevFree = $id; |
627
|
|
|
|
|
|
|
} |
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
# prepare our main dictionary for writing |
630
|
16
|
|
|
|
|
33
|
$$mainDict{Size} = $nextObject; # update number of objects |
631
|
|
|
|
|
|
|
# must change the ID if it exists |
632
|
16
|
100
|
66
|
|
|
51
|
if (ref $$mainDict{ID} eq 'ARRAY' and @{$$mainDict{ID}} > 1) { |
|
6
|
|
|
|
|
21
|
|
633
|
|
|
|
|
|
|
# increment first byte since this is an easy change to make |
634
|
6
|
|
|
|
|
12
|
$id = $mainDict->{ID}->[1]; |
635
|
6
|
50
|
0
|
|
|
27
|
if ($id =~ /^<([0-9a-f]{2})/i) { |
|
|
0
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
636
|
6
|
|
|
|
|
32
|
my $byte = unpack('H2',chr((hex($1) + 1) & 0xff)); |
637
|
6
|
|
|
|
|
17
|
substr($id, 1, 2) = $byte; |
638
|
|
|
|
|
|
|
} elsif ($id =~ /^\((.)/s and $1 ne '\\' and $1 ne ')' and $1 ne '(') { |
639
|
0
|
|
|
|
|
0
|
my $ch = chr((ord($1) + 1) & 0xff); |
640
|
|
|
|
|
|
|
# avoid generating characters that could cause problems |
641
|
0
|
0
|
|
|
|
0
|
$ch = 'a' if $ch =~ /[()\\\x00-\x08\x0a-\x1f\x7f\xff]/; |
642
|
0
|
|
|
|
|
0
|
substr($id, 1, 1) = $ch; |
643
|
|
|
|
|
|
|
} |
644
|
6
|
|
|
|
|
13
|
$mainDict->{ID}->[1] = $id; |
645
|
|
|
|
|
|
|
} |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
# remember position of xref table in file (we will write this next) |
648
|
16
|
|
|
|
|
42
|
my $startxref = Tell($outfile) - $$et{PDFBase} + length($/); |
649
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
# must write xref as a stream in xref-stream-only files |
651
|
16
|
50
|
33
|
|
|
50
|
if ($$mainDict{Type} and $$mainDict{Type} eq '/XRef') { |
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
# create entry for the xref stream object itself |
654
|
0
|
|
|
|
|
0
|
$newXRef{$nextObject++} = [ Tell($outfile) - $$et{PDFBase} + length($/), 0, 'n' ]; |
655
|
0
|
|
|
|
|
0
|
$$mainDict{Size} = $nextObject; |
656
|
|
|
|
|
|
|
# create xref stream and Index entry |
657
|
0
|
|
|
|
|
0
|
$$mainDict{W} = [ 1, 4, 2 ]; # int8u, int32u, int16u ('CNn') |
658
|
0
|
|
|
|
|
0
|
$$mainDict{Index} = [ ]; |
659
|
0
|
|
|
|
|
0
|
$$mainDict{_stream} = ''; |
660
|
0
|
|
|
|
|
0
|
my @ids = sort { $a <=> $b } keys %newXRef; |
|
0
|
|
|
|
|
0
|
|
661
|
0
|
|
|
|
|
0
|
while (@ids) { |
662
|
0
|
|
|
|
|
0
|
my $startID = $ids[0]; |
663
|
0
|
|
|
|
|
0
|
for (;;) { |
664
|
0
|
|
|
|
|
0
|
$id = shift @ids; |
665
|
0
|
|
|
|
|
0
|
my ($pos, $gen, $type) = @{$newXRef{$id}}; |
|
0
|
|
|
|
|
0
|
|
666
|
0
|
0
|
|
|
|
0
|
if ($pos > 0xffffffff) { |
667
|
0
|
|
|
|
|
0
|
$et->Error('Huge files not yet supported'); |
668
|
0
|
|
|
|
|
0
|
last; |
669
|
|
|
|
|
|
|
} |
670
|
0
|
0
|
|
|
|
0
|
$$mainDict{_stream} .= pack('CNn', $type eq 'f' ? 0 : 1, $pos, $gen); |
671
|
0
|
0
|
0
|
|
|
0
|
last if not @ids or $ids[0] != $id + 1; |
672
|
|
|
|
|
|
|
} |
673
|
|
|
|
|
|
|
# add Index entries for this section of the xref stream |
674
|
0
|
|
|
|
|
0
|
push @{$$mainDict{Index}}, $startID, $id - $startID + 1; |
|
0
|
|
|
|
|
0
|
|
675
|
|
|
|
|
|
|
} |
676
|
|
|
|
|
|
|
# write the xref stream object |
677
|
0
|
|
|
|
|
0
|
$keyExt = "$id 0 obj"; # (set anyway, but xref stream should NOT be encrypted) |
678
|
0
|
0
|
|
|
|
0
|
Write($outfile, $/, $keyExt) or $rtn = -1; |
679
|
0
|
0
|
|
|
|
0
|
WriteObject($outfile, $mainDict) or $rtn = -1; |
680
|
0
|
0
|
|
|
|
0
|
Write($outfile, $/, 'endobj') or $rtn = -1; |
681
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
} else { |
683
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
# write new xref table |
685
|
16
|
50
|
|
|
|
41
|
Write($outfile, $/, 'xref', $/) or $rtn = -1; |
686
|
|
|
|
|
|
|
# lines must be exactly 20 bytes, so pad newline if necessary |
687
|
16
|
50
|
|
|
|
65
|
my $endl = (length($/) == 1 ? ' ' : '') . $/; |
688
|
16
|
|
|
|
|
45
|
my @ids = sort { $a <=> $b } keys %newXRef; |
|
63
|
|
|
|
|
110
|
|
689
|
16
|
|
|
|
|
42
|
while (@ids) { |
690
|
34
|
|
|
|
|
43
|
my $startID = $ids[0]; |
691
|
34
|
|
|
|
|
44
|
$buff = ''; |
692
|
34
|
|
|
|
|
37
|
for (;;) { |
693
|
56
|
|
|
|
|
73
|
$id = shift @ids; |
694
|
56
|
|
|
|
|
69
|
$buff .= sprintf("%.10d %.5d %s%s", @{$newXRef{$id}}, $endl); |
|
56
|
|
|
|
|
175
|
|
695
|
56
|
100
|
100
|
|
|
183
|
last if not @ids or $ids[0] != $id + 1; |
696
|
|
|
|
|
|
|
} |
697
|
|
|
|
|
|
|
# write this (contiguous-numbered object) section of the xref table |
698
|
34
|
50
|
|
|
|
92
|
Write($outfile, $startID, ' ', $id - $startID + 1, $/, $buff) or $rtn = -1; |
699
|
|
|
|
|
|
|
} |
700
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
# write main (trailer) dictionary |
702
|
16
|
50
|
|
|
|
34
|
Write($outfile, 'trailer') or $rtn = -1; |
703
|
16
|
50
|
|
|
|
34
|
WriteObject($outfile, $mainDict) or $rtn = -1; |
704
|
|
|
|
|
|
|
} |
705
|
|
|
|
|
|
|
# write trailing comment (marker to allow edits to be reverted) |
706
|
16
|
50
|
|
|
|
51
|
Write($outfile, $/, $endComment, $oldEOF, $/) or $rtn = -1; |
707
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
# write pointer to main xref table and EOF marker |
709
|
16
|
50
|
|
|
|
48
|
Write($outfile, 'startxref', $/, $startxref, $/, '%%EOF', $/) or $rtn = -1; |
710
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
} elsif ($prevUpdate) { |
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
# nothing new changed, so copy over previous incremental update |
714
|
1
|
50
|
|
|
|
5
|
$raf->Seek($prevUpdate+$$et{PDFBase}, 0) or $rtn = -1; |
715
|
1
|
|
|
|
|
5
|
while ($raf->Read($buff, 65536)) { |
716
|
1
|
50
|
|
|
|
5
|
Write($outfile, $buff) or $rtn = -1; |
717
|
|
|
|
|
|
|
} |
718
|
|
|
|
|
|
|
} |
719
|
17
|
100
|
66
|
|
|
125
|
if ($rtn > 0 and $$et{CHANGED} and ($$et{DEL_GROUP}{PDF} or $$et{DEL_GROUP}{XMP})) { |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
720
|
6
|
|
|
|
|
27
|
$et->Warn('ExifTool PDF edits are reversible. Deleted tags may be recovered!', 1); |
721
|
|
|
|
|
|
|
} |
722
|
17
|
|
|
|
|
173
|
undef $newTool; |
723
|
17
|
|
|
|
|
90
|
undef %capture; |
724
|
17
|
|
|
|
|
296
|
return $rtn; |
725
|
|
|
|
|
|
|
} |
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
1; # end |
729
|
|
|
|
|
|
|
|
730
|
|
|
|
|
|
|
__END__ |