source: gsdl/trunk/perllib/cpan/Image/ExifTool/WritePostScript.pl@ 16842

Last change on this file since 16842 was 16842, checked in by davidb, 16 years ago

ExifTool added to cpan area to support metadata extraction from files such as JPEG. Primarily targetted as Image files (hence the Image folder name decided upon by the ExifTool author) it also can handle video such as flash and audio such as Wav
File size: 28.1 KB
Line 
1#------------------------------------------------------------------------------
2# File: WritePostScript.pl
3#
4# Description: Write PostScript meta information
5#
6# Revisions: 03/03/2006 - P. Harvey Created
7#
8# References: (see references in PostScript.pm, plus:)
9# 1) http://www.adobe.com/products/postscript/pdfs/PLRM.pdf
10# 2) http://www-cdf.fnal.gov/offline/PostScript/PLRM2.pdf
11# 3) http://partners.adobe.com/public/developer/en/acrobat/sdk/pdf/pdf_creation_apis_and_specs/pdfmarkReference.pdf
12# 4) http://www.npes.org/standards/Tools/DCS20Spec.pdf
13#
14# Notes: (see NOTES in POD doc below)
15#------------------------------------------------------------------------------
16
17package Image::ExifTool::PostScript;
18
19use strict;
20
21# Structure of a DSC PS/EPS document:
22#
23# %!PS-Adobe-3.0 [plus " EPSF-3.0" for EPS]
24# <comments>
25# %%EndComments [optional]
26# %%BeginXxxx
27# <stuff to ignore>
28# %%EndXxxx
29# %%BeginProlog
30# <prolog stuff>
31# %%EndProlog
32# %%BeginSetup
33# <setup stuff>
34# %%EndSetup
35# %ImageData x x x x [written by Photoshop]
36# %BeginPhotoshop: xxxx
37# <ascii-hex IRB information>
38# %EndPhotosop
39# %%BeginICCProfile: (name) <num> <type>
40# <ICC Profile info>
41# %%EndICCProfile
42# %begin_xml_code
43# <postscript code to define and read the XMP stream object>
44# %begin_xml_packet: xxxx
45# <XMP data>
46# %end_xml_packet
47# <postscript code to add XMP stream to dictionary>
48# %end_xml_code
49# %%Page: x x [PS only (optional?)]
50# <graphics commands>
51# %%PageTrailer
52# %%Trailer
53# <a bit more code to bracket EPS content for distiller>
54# %%EOF
55
56# map of where information is stored in PS image
57my %psMap = (
58 XMP => 'PostScript',
59 Photoshop => 'PostScript',
60 IPTC => 'Photoshop',
61 EXIFInfo => 'Photoshop',
62 IFD0 => 'EXIFInfo',
63 IFD1 => 'IFD0',
64 ICC_Profile => 'PostScript',
65 ExifIFD => 'IFD0',
66 GPS => 'IFD0',
67 SubIFD => 'IFD0',
68 GlobParamIFD => 'IFD0',
69 PrintIM => 'IFD0',
70 InteropIFD => 'ExifIFD',
71 MakerNotes => 'ExifIFD',
72);
73
74
75#------------------------------------------------------------------------------
76# Check PS tag value
77# Inputs: 0) ExifTool object ref, 1) tag info ref, 2) value ref
78# Returns: undef on success, or error string
79sub CheckPS($$$)
80{
81 my ($exifTool, $tagInfo, $valPt) = @_;
82 # parentheses must be balanced (or escaped)
83 my $n = 0;
84 pos($$valPt) = 0;
85 while ($$valPt =~ /(\(|\))/g) {
86 $n += ($1 eq '(') ? 1 : -1;
87 last if $n < 0;
88 }
89 return 'Unmatched parentheses' unless $n == 0;
90 return undef; # success
91}
92
93#------------------------------------------------------------------------------
94# Write XMP directory to file, with begin/end tokens if necessary
95# Inputs: 0) outfile ref, 1) flags hash ref, 2-N) data to write
96# Returns: true on success
97sub WriteXMPDir($$@)
98{
99 my $outfile = shift;
100 my $flags = shift;
101 my $success = 1;
102 Write($outfile, "%begin_xml_code$/") or $success = 0 unless $$flags{WROTE_BEGIN};
103 Write($outfile, @_) or $success = 0;
104 Write($outfile, "%end_xml_code$/") or $success = 0 unless $$flags{WROTE_BEGIN};
105 return $success;
106}
107
108#------------------------------------------------------------------------------
109# Write a directory inside a PS document
110# Inputs: 0) ExifTool object ref, 1) output file reference,
111# 2) Directory name, 3) data reference, 4) flags hash ref
112# Returns: 0=error, 1=nothing written, 2=dir written ok
113sub WritePSDirectory($$$$$)
114{
115 my ($exifTool, $outfile, $dirName, $dataPt, $flags) = @_;
116 my $success = 2;
117 my $len = $dataPt ? length($$dataPt) : 0;
118 my $create = $len ? 0 : 1;
119 my %dirInfo = (
120 DataPt => $dataPt,
121 DataLen => $len,
122 DirStart => 0,
123 DirLen => $len,
124 DirName => $dirName,
125 Parent => 'PostScript',
126 );
127 # Note: $$flags{WROTE_BEGIN} may be 1 for XMP (it is always 0 for
128 # other dirs, but if 1, the begin/end markers were already written)
129#
130# prepare necessary postscript code to support embedded XMP
131#
132 my ($beforeXMP, $afterXMP, $reportedLen);
133 if ($dirName eq 'XMP' and $len) {
134 # isolate the XMP
135 pos($$dataPt) = 0;
136 unless ($$dataPt =~ /(.*)(<\?xpacket begin=.{7,13}W5M0MpCehiHzreSzNTczkc9d)/sg) {
137 $exifTool->Warn('No XMP packet start');
138 return WriteXMPDir($outfile, $flags, $$dataPt);
139 }
140 $beforeXMP = $1;
141 my $xmp = $2;
142 my $p1 = pos($$dataPt);
143 unless ($$dataPt =~ m{<\?xpacket end=.(w|r).\?>}sg) {
144 $exifTool->Warn('No XMP packet end');
145 return WriteXMPDir($outfile, $flags, $$dataPt);
146 }
147 my $p2 = pos($$dataPt);
148 $xmp .= substr($$dataPt, $p1, $p2-$p1);
149 $afterXMP = substr($$dataPt, $p2);
150 # determine if we can adjust the XMP size
151 if ($beforeXMP =~ /%begin_xml_packet: (\d+)/s) {
152 $reportedLen = $1;
153 my @matches= ($beforeXMP =~ /\b$reportedLen\b/sg);
154 undef $reportedLen unless @matches == 2;
155 }
156 # must edit in place if we can't reliably change the XMP length
157 $dirInfo{InPlace} = 1 unless $reportedLen;
158 # process XMP only
159 $dirInfo{DataLen} = $dirInfo{DirLen} = length $xmp;
160 $dirInfo{DataPt} = \$xmp;
161 }
162 my $tagTablePtr = GetTagTable("Image::ExifTool::${dirName}::Main");
163 my $val = $exifTool->WriteDirectory(\%dirInfo, $tagTablePtr);
164 if (defined $val) {
165 $dataPt = \$val; # use modified directory
166 $len = length $val;
167 } elsif ($dirName eq 'XMP') {
168 return 1 unless $len;
169 # just write the original XMP
170 return WriteXMPDir($outfile, $flags, $$dataPt);
171 }
172 unless ($len) {
173 return 1 if $create or $dirName ne 'XMP'; # nothing to create
174 # it would be really difficult to delete the XMP,
175 # so instead we write a blank XMP record
176 $val = <<EMPTY_XMP;
177<?xpacket begin='' id='W5M0MpCehiHzreSzNTczkc9d'?>
178<x:xmpmeta xmlns:x='adobe:ns:meta/' x:xmptk='Image::ExifTool $Image::ExifTool::VERSION'>
179</x:xmpmeta>
180EMPTY_XMP
181 $val .= ((' ' x 100) . "\n") x 24 unless $exifTool->Options('Compact');
182 $val .= q{<?xpacket end='w'?>};
183 $dataPt = \$val;
184 $len = length $val;
185 }
186#
187# write XMP directory
188#
189 if ($dirName eq 'XMP') {
190 if ($create) {
191 # create necessary PS/EPS code to support XMP
192 $beforeXMP = <<HDR_END;
193/pdfmark where {pop true} {false} ifelse
194/currentdistillerparams where {pop currentdistillerparams
195/CoreDistVersion get 5000 ge } {false} ifelse
196and not {userdict /pdfmark /cleartomark load put} if
197[/NamespacePush pdfmark
198[/_objdef {exiftool_metadata_stream} /type /stream /OBJ pdfmark
199[{exiftool_metadata_stream} 2 dict begin /Type /Metadata def
200 /Subtype /XML def currentdict end /PUT pdfmark
201/MetadataString $len string def % exact length of metadata
202/TempString 100 string def
203/ConsumeMetadata {
204currentfile TempString readline pop pop
205currentfile MetadataString readstring pop pop
206} bind def
207ConsumeMetadata
208%begin_xml_packet: $len
209HDR_END
210 # note: use q() to get necessary linefeed before %end_xml_packet
211 $afterXMP = q(
212%end_xml_packet
213[{exiftool_metadata_stream} MetadataString /PUT pdfmark
214);
215 if ($$flags{EPS}) {
216 $afterXMP .= <<EPS_AFTER;
217[/Document 1 dict begin
218 /Metadata {exiftool_metadata_stream} def currentdict end /BDC pdfmark
219[/NamespacePop pdfmark
220EPS_AFTER
221 # write this at end of file
222 $$flags{TRAILER} = "[/EMC pdfmark$/";
223 } else { # PS
224 $afterXMP .= <<PS_AFTER;
225[{Catalog} {exiftool_metadata_stream} /Metadata pdfmark
226[/NamespacePop pdfmark
227PS_AFTER
228 }
229 $beforeXMP =~ s{\n}{$/}sg; # use proper newline characters
230 $afterXMP =~ s{\n}{$/}sg;
231 } else {
232 # replace xmp size in PS code
233 $reportedLen and $beforeXMP =~ s/\b$reportedLen\b/$len/sg;
234 }
235 WriteXMPDir($outfile, $flags, $beforeXMP, $$dataPt, $afterXMP) or $success = 0;
236#
237# Write Photoshop or ICC_Profile directory
238#
239 } elsif ($dirName eq 'Photoshop' or $dirName eq 'ICC_Profile') {
240 my ($startToken, $endToken);
241 if ($dirName eq 'Photoshop') {
242 $startToken = "%BeginPhotoshop: $len";
243 $endToken = '%EndPhotoshop';
244 } else {
245 $startToken = '%%BeginICCProfile: (Photoshop Profile) -1 Hex';
246 $endToken = '%%EndICCProfile';
247 }
248 Write($outfile, $startToken, $/) or $success = 0;
249 # write as an ASCII-hex comment
250 my $i;
251 my $wid = 32;
252 for ($i=0; $i<$len; $i+=$wid) {
253 $wid > $len-$i and $wid = $len-$i;
254 my $dat = substr($$dataPt, $i, $wid);
255 Write($outfile, "% ", uc(unpack('H*',$dat)), $/) or $success = 0;
256 }
257 Write($outfile, $endToken, $/) or $success = 0;
258 } else {
259 $exifTool->Warn("Can't write PS directory $dirName");
260 }
261 undef $val;
262 return $success;
263}
264
265#------------------------------------------------------------------------------
266# Write new tags information in comments section
267# Inputs: 0) ExifTool object ref, 1) output file ref, 2) reference to new tag hash
268# Returns: true on success
269sub WriteNewTags($$$)
270{
271 my ($exifTool, $outfile, $newTags) = @_;
272 my $success = 1;
273 my $tag;
274
275 # get XMP hint and remove from tags hash
276 my $xmpHint = $$newTags{XMP_HINT};
277 delete $$newTags{XMP_HINT};
278
279 foreach $tag (sort keys %$newTags) {
280 my $tagInfo = $$newTags{$tag};
281 my $newValueHash = $exifTool->GetNewValueHash($tagInfo);
282 next unless Image::ExifTool::IsCreating($newValueHash);
283 my $val = Image::ExifTool::GetNewValues($newValueHash);
284 if ($exifTool->Options('Verbose') > 1) {
285 my $out = $exifTool->Options('TextOut');
286 print $out " + PostScript:$$tagInfo{Name} = '$val'\n";
287 }
288 $val =~ /^\d+$/ or $val = "($val)"; # add brackets around strings
289 my $buff = "%%$tag: $val$/";
290 if (length $buff > 255) {
291 $exifTool->Warn("Value for too long for $tag");
292 } else {
293 Write($outfile, $buff) or $success = 0;
294 ++$exifTool->{CHANGED};
295 }
296 }
297 # write XMP hint if necessary
298 Write($outfile, "%ADO_ContainsXMP: MainFirst$/") or $success = 0 if $xmpHint;
299
300 %$newTags = (); # all done with new tags
301 return $success;
302}
303
304#------------------------------------------------------------------------------
305# check to be sure we haven't read past end of PS data in DOS-style file
306# Inputs: 0) RAF ref, 1) pointer to end of PS, 2) data
307# - modifies data and sets RAF to EOF if end of PS is reached
308sub CheckPSEnd($$$)
309{
310 my $pos = $_[0]->Tell();
311 if ($pos >= $_[1]) {
312 $_[0]->Seek(0, 2); # seek to end of file so we can't read any more
313 $_[2] = substr($_[2], 0, length($_[2]) - $pos + $_[1]) if $pos > $_[1];
314 }
315}
316
317#------------------------------------------------------------------------------
318# Split into lines ending in any CR, LF or CR+LF combination
319# (this is annoying, and could be avoided if EPS files didn't mix linefeeds!)
320# Inputs: 0) data pointer, 1) reference to lines array
321# Notes: Updates data to contain next line and fills list with remaining lines
322sub SplitLine($$)
323{
324 my ($dataPt, $lines) = @_;
325 for (;;) {
326 my $endl;
327 # find the position of the first LF (\x0a)
328 $endl = pos($$dataPt), pos($$dataPt) = 0 if $$dataPt =~ /\x0a/g;
329 if ($$dataPt =~ /\x0d/g) { # find the first CR (\x0d)
330 if (defined $endl) {
331 # (remember, CR+LF is a DOS newline...)
332 $endl = pos($$dataPt) if pos($$dataPt) < $endl - 1;
333 } else {
334 $endl = pos($$dataPt);
335 }
336 } elsif (not defined $endl) {
337 push @$lines, $$dataPt;
338 last;
339 }
340 # split into separate lines
341 if (length $$dataPt == $endl) {
342 push @$lines, $$dataPt;
343 last;
344 } else {
345 push @$lines, substr($$dataPt, 0, $endl);
346 $$dataPt = substr($$dataPt, $endl);
347 }
348 }
349 $$dataPt = shift @$lines; # set $$dataPt to first line
350}
351
352#------------------------------------------------------------------------------
353# Write PS file
354# Inputs: 0) ExifTool object reference, 1) source dirInfo reference
355# Returns: 1 on success, 0 if this wasn't a valid PS file,
356# or -1 if a write error occurred
357sub WritePS($$)
358{
359 my ($exifTool, $dirInfo) = @_;
360 $exifTool or return 1; # allow dummy access to autoload this package
361 my $tagTablePtr = Image::ExifTool::GetTagTable('Image::ExifTool::PostScript::Main');
362 my $raf = $$dirInfo{RAF};
363 my $outfile = $$dirInfo{OutFile};
364 my $verbose = $exifTool->Options('Verbose');
365 my $out = $exifTool->Options('TextOut');
366 my ($data, $buff, %flags, $err, $mode, $endToken);
367 my ($dos, $psStart, $psEnd, $psNewStart, $xmpHint);
368
369 $raf->Read($data, 4) == 4 or return 0;
370 return 0 unless $data =~ /^(%!PS|%!Ad|\xc5\xd0\xd3\xc6)/;
371
372 if ($data =~ /^%!Ad/) {
373 # I've seen PS files start with "%!Adobe-PS"...
374 return 0 unless $raf->Read($buff, 6) == 6 and $buff eq "obe-PS";
375 $data .= $buff;
376
377 } elsif ($data =~ /^\xc5\xd0\xd3\xc6/) {
378#
379# process DOS binary PS files
380#
381 # save DOS header then seek ahead and check PS header
382 $raf->Read($dos, 26) == 26 or return 0;
383 $dos = $data . $dos;
384 SetByteOrder('II');
385 $psStart = Get32u(\$dos, 4);
386 unless ($raf->Seek($psStart, 0) and
387 $raf->Read($data, 4) == 4 and $data eq '%!PS')
388 {
389 $exifTool->Error('Invalid PS header');
390 return 1;
391 }
392 $psEnd = $psStart + Get32u(\$dos, 8);
393 my $base = Get32u(\$dos, 20);
394 Set16u(0xffff, \$dos, 28); # ignore checksum
395 if ($base) {
396 my %dirInfo = (
397 Parent => 'PS',
398 RAF => $raf,
399 Base => $base,
400 NoTiffEnd => 1, # no end-of-TIFF check
401 );
402 $buff = $exifTool->WriteTIFF(\%dirInfo);
403 SetByteOrder('II'); # (WriteTIFF may change this)
404 if ($buff) {
405 $buff = substr($buff, $base); # remove header written by WriteTIFF()
406 } else {
407 # error rewriting TIFF, so just copy over original data
408 my $len = Get32u(\$dos, 24);
409 unless ($raf->Seek($base, 0) and $raf->Read($buff, $len) == $len) {
410 $exifTool->Error('Error reading embedded TIFF');
411 return 1;
412 }
413 $exifTool->Warn('Bad embedded TIFF');
414 }
415 Set32u(0, \$dos, 12); # zero metafile pointer
416 Set32u(0, \$dos, 16); # zero metafile length
417 Set32u(length($dos), \$dos, 20); # set TIFF pointer
418 Set32u(length($buff), \$dos, 24); # set TIFF length
419 } elsif (($base = Get32u(\$dos, 12)) != 0) {
420 # copy over metafile section
421 my $len = Get32u(\$dos, 16);
422 unless ($raf->Seek($base, 0) and $raf->Read($buff, $len) == $len) {
423 $exifTool->Error('Error reading metafile section');
424 return 1;
425 }
426 Set32u(length($dos), \$dos, 12); # set metafile pointer
427 } else {
428 $buff = '';
429 }
430 $psNewStart = length($dos) + length($buff);
431 Set32u($psNewStart, \$dos, 4); # set pointer to start of PS
432 Write($outfile, $dos, $buff) or $err = 1;
433 $raf->Seek($psStart + 4, 0); # seek back to where we were
434 }
435#
436# rewrite PostScript data
437#
438 my $oldsep = SetInputRecordSeparator($raf);
439 unless ($oldsep and $raf->ReadLine($buff)) {
440 $exifTool->Error('Invalid PostScript data');
441 return 1;
442 }
443 $data .= $buff;
444 unless ($data =~ /^%!PS-Adobe-3.(0|1)/) {
445 if ($exifTool->Error("Document does not conform to DSC spec. Metadata may be unreadable by other apps", 1)) {
446 return 1;
447 }
448 }
449 Write($outfile, $data) or $err = 1;
450 $flags{EPS} = 1 if $data =~ /EPSF/;
451
452 # get hash of new information keyed by tagID and directories to add/edit
453 my $newTags = $exifTool->GetNewTagInfoHash($tagTablePtr);
454
455 # figure out which directories we need to write (PostScript takes priority)
456 $exifTool->InitWriteDirs(\%psMap, 'PostScript');
457 my $addDirs = $exifTool->{ADD_DIRS};
458 my $editDirs = $exifTool->{EDIT_DIRS};
459 my %doneDir;
460
461 # set XMP hint flag (1 for adding, 0 for deleting, undef for no change)
462 $xmpHint = 1 if $$addDirs{XMP};
463 $xmpHint = 0 if $exifTool->{DEL_GROUP}->{XMP};
464 $$newTags{XMP_HINT} = $xmpHint if $xmpHint; # add special tag to newTags list
465
466 my @lines;
467 my $altnl = ($/ eq "\x0d") ? "\x0a" : "\x0d";
468
469 for (;;) {
470 if (@lines) {
471 $data = shift @lines;
472 } else {
473 $raf->ReadLine($data) or last;
474 $dos and CheckPSEnd($raf, $psEnd, $data);
475 # split line if it contains other newline sequences
476 SplitLine(\$data, \@lines) if $data =~ /$altnl/;
477 }
478 if ($endToken) {
479 # look for end token
480 if ($data =~ m/^$endToken\s*$/is) {
481 undef $endToken;
482 # found end: process this information
483 if ($mode) {
484 $doneDir{$mode} and $exifTool->Error("Multiple $mode directories", 1);
485 $doneDir{$mode} = 1;
486 WritePSDirectory($exifTool, $outfile, $mode, \$buff, \%flags) or $err = 1;
487 # write end token if we wrote the begin token
488 Write($outfile, $data) or $err = 1 if $flags{WROTE_BEGIN};
489 undef $buff;
490 } else {
491 Write($outfile, $data) or $err = 1;
492 }
493 } else {
494 # buffer data in current begin/end block
495 if (not defined $mode) {
496 # pick up XMP in unrecognized blocks for editing in place
497 if ($data =~ /^<\?xpacket begin=.{7,13}W5M0MpCehiHzreSzNTczkc9d/ and
498 $$editDirs{XMP})
499 {
500 $buff = $data;
501 $mode = 'XMP';
502 } else {
503 Write($outfile, $data) or $err = 1;
504 }
505 } elsif ($mode eq 'XMP') {
506 $buff .= $data;
507 } else {
508 # data is ASCII-hex encoded
509 $data =~ tr/0-9A-Fa-f//dc; # remove all but hex characters
510 $buff .= pack('H*', $data); # translate from hex
511 }
512 }
513 next;
514 } elsif ($data =~ m{^(%{1,2})(Begin)(?!Object:)(.*?)[:\x0d\x0a]}i) {
515 # comments section is over... write any new tags now
516 WriteNewTags($exifTool, $outfile, $newTags) or $err = 1 if %$newTags;
517 undef $xmpHint;
518 # the beginning of a data block (can only write XMP and Photoshop)
519 my %modeLookup = (
520 _xml_code => 'XMP',
521 photoshop => 'Photoshop',
522 iccprofile => 'ICC_Profile',
523 );
524 $verbose > 1 and print $out "$2$3\n";
525 $endToken = $1 . ($2 eq 'begin' ? 'end' : 'End') . $3;
526 $mode = $modeLookup{lc($3)};
527 if ($mode and $$editDirs{$mode}) {
528 $buff = ''; # initialize buffer for this block
529 $flags{WROTE_BEGIN} = 0;
530 } else {
531 undef $mode; # not editing this directory
532 Write($outfile, $data) or $err = 1;
533 $flags{WROTE_BEGIN} = 1;
534 }
535 next;
536 } elsif ($data =~ /^%%(?!Page:|PlateFile:|BeginObject:)(\w+): ?(.*)/s) {
537 # rewrite information from PostScript tags in comments
538 my ($tag, $val) = ($1, $2);
539 if ($$newTags{$tag}) {
540 my $tagInfo = $$newTags{$tag};
541 next unless ref $tagInfo;
542 delete $$newTags{$tag}; # write it then forget it
543 $val =~ s/\x0d*\x0a*$//; # remove trailing CR, LF or CR/LF
544 if ($val =~ s/^\((.*)\)$/$1/) { # remove brackets if necessary
545 $val =~ s/\) \(/, /g; # convert contained brackets too
546 }
547 my $newValueHash = $exifTool->GetNewValueHash($tagInfo);
548 if (Image::ExifTool::IsOverwriting($newValueHash, $val)) {
549 $verbose > 1 and print $out " - PostScript:$$tagInfo{Name} = '$val'\n";
550 $val = Image::ExifTool::GetNewValues($newValueHash);
551 ++$exifTool->{CHANGED};
552 next unless defined $val; # next if tag is being deleted
553 $verbose > 1 and print $out " + PostScript:$$tagInfo{Name} = '$val'\n";
554 $val =~ /^\d+$/ or $val = "($val)"; # add brackets around strings
555 $buff = "%%$tag: $val$/";
556 if (length $buff > 255) {
557 # lines in PS documents must be less than 256 characters
558 # (don't yet support continuation with %%+ comment)
559 $exifTool->Warn("Value for too long for $tag");
560 } else {
561 $data = $buff; # write the new value
562 }
563 }
564 }
565 # (note: Adobe InDesign doesn't put colon after %ADO_ContainsXMP -- doh!)
566 } elsif (defined $xmpHint and $data =~ m{^%ADO_ContainsXMP:? ?(.+?)[\x0d\x0a]*$}s) {
567 # change the XMP hint if necessary
568 if ($xmpHint) {
569 $data = "%ADO_ContainsXMP: MainFirst$/" if $1 eq 'NoMain';
570 } else {
571 $data = "%ADO_ContainsXMP: NoMain$/";
572 }
573 # delete XMP hint flags
574 delete $$newTags{XMP_HINT};
575 undef $xmpHint;
576 } else {
577 # look for end of comments section
578 if (%$newTags and ($data !~ /^%\S/ or
579 $data =~ /^%(%EndComments|%Page:|%PlateFile:|%BeginObject:|.*BeginLayer)/))
580 {
581 # write new tags at end of comments section
582 WriteNewTags($exifTool, $outfile, $newTags) or $err = 1;
583 undef $xmpHint;
584 }
585 # look for start of drawing commands (AI uses "%AI5_BeginLayer",
586 # and Helios uses "%%BeginObject:")
587 if ($data =~ /^%(%Page:|%PlateFile:|%BeginObject:|.*BeginLayer)/ or
588 $data !~ m{^(%.*|\s*)$}s)
589 {
590 # we have reached the first page or drawing command, so create necessary
591 # directories and copy the rest of the file, then all done
592 my $dir;
593 my $plateFile = ($data =~ /^%%PlateFile:/);
594 # create Photoshop first, then XMP if necessary
595 foreach $dir (qw{Photoshop ICC_Profile XMP}) {
596 next unless $$editDirs{$dir} and not $doneDir{$dir};
597 if ($plateFile) {
598 # PlateFile comments may contain offsets so we can't edit these files!
599 $exifTool->Warn("Can only edit PostScript information DCS Plate files");
600 last;
601 }
602 next unless $$addDirs{$dir} or $dir eq 'XMP';
603 $flags{WROTE_BEGIN} = 0;
604 WritePSDirectory($exifTool, $outfile, $dir, undef, \%flags) or $err = 1;
605 $doneDir{$dir} = 1;
606 }
607 # copy rest of file
608 if ($flags{TRAILER}) {
609 # write trailer before %%EOF
610 for (;;) {
611 Write($outfile, $data) or $err = 1;
612 if (@lines) {
613 $data = shift @lines;
614 } else {
615 $raf->ReadLine($data) or undef($data), last;
616 $dos and CheckPSEnd($raf, $psEnd, $data);
617 if ($data =~ /[\x0d\x0a]%%EOF\b/g) {
618 # split data before "%%EOF"
619 # (necessary if data contains other newline sequences)
620 my $pos = pos($data) - 5;
621 push @lines, substr($data, $pos);
622 $data = substr($data, 0, $pos);
623 }
624 }
625 last if $data =~ /^%%EOF\b/;
626 }
627 Write($outfile, $flags{TRAILER}) or $err = 1;
628 }
629 # simply copy the rest of the file if any data is left
630 if (defined $data) {
631 Write($outfile, $data) or $err = 1;
632 Write($outfile, @lines) or $err = 1 if @lines;
633 while ($raf->Read($data, 65536)) {
634 $dos and CheckPSEnd($raf, $psEnd, $data);
635 Write($outfile, $data) or $err = 1;
636 }
637 }
638 last; # all done!
639 }
640 }
641 # write new information or copy existing line
642 Write($outfile, $data) or $err = 1;
643 }
644 if ($dos and not $err) {
645 # must go back and set length of PS section in DOS header (very dumb design)
646 if (ref $outfile eq 'SCALAR') {
647 Set32u(length($$outfile) - $psNewStart, $outfile, 8);
648 } else {
649 my $pos = tell $outfile;
650 unless (seek($outfile, 8, 0) and
651 print $outfile Set32u($pos - $psNewStart) and
652 seek($outfile, $pos, 0))
653 {
654 $exifTool->Error("Can't write DOS-style PS files in non-seekable stream");
655 $err = 1;
656 }
657 }
658 }
659 # issue warning if we couldn't write any information
660 unless ($err) {
661 my (@notDone, $dir);
662 delete $$newTags{XMP_HINT};
663 push @notDone, 'PostScript' if %$newTags;
664 foreach $dir (qw{Photoshop ICC_Profile XMP}) {
665 push @notDone, $dir if $$editDirs{$dir} and not $doneDir{$dir};
666 }
667 @notDone and $exifTool->Warn("Couldn't write ".join('/',@notDone).' information');
668 }
669 $endToken and $exifTool->Error("File missing $endToken");
670 return $err ? -1 : 1;
671}
672
673
6741; # end
675
676__END__
677
678=head1 NAME
679
680Image::ExifTool::WritePostScript.pl - Write PostScript meta information
681
682=head1 SYNOPSIS
683
684This file is autoloaded by Image::ExifTool::PostScript.
685
686=head1 DESCRIPTION
687
688This file contains routines to write meta information in PostScript
689documents. Six forms of meta information may be written:
690
691 1) PostScript comments (Adobe DSC specification)
692 2) XMP information embedded in a document-level XMP stream
693 3) EXIF information embedded in a Photoshop record
694 4) IPTC information embedded in a PhotoShop record
695 5) ICC_Profile information embedded in an ICCProfile record
696 6) TIFF information embedded in DOS-style binary header
697
698=head1 NOTES
699
700Currently, information is written only in the outter-level document.
701
702Photoshop will discard meta information in a PostScript document if it has
703to rasterize the image, and it will rasterize anything that doesn't contain
704the Photoshop-specific 'ImageData' tag. So don't expect Photoshop to read
705any meta information added to EPS images that it didn't create.
706
707The following two acronyms may be confusing since they are so similar and
708have different meanings with respect to PostScript documents:
709
710 DSC = Document Structuring Conventions
711 DCS = Desktop Color Separation
712
713=head1 REFERENCES
714
715See references in L<PostScript.pm|Image::ExifTool::PostScript>, plus:
716
717=over 4
718
719=item L<http://www.adobe.com/products/postscript/pdfs/PLRM.pdf>
720
721=item L<http://www-cdf.fnal.gov/offline/PostScript/PLRM2.pdf>
722
723=item L<http://partners.adobe.com/public/developer/en/acrobat/sdk/pdf/pdf_creation_apis_and_specs/pdfmarkReference.pdf>
724
725=back
726
727=head1 ACKNOWLEDGEMENTS
728
729Thanks to Tim Kordick for his help testing the EPS writer.
730
731=head1 AUTHOR
732
733Copyright 2003-2007, Phil Harvey (phil at owl.phy.queensu.ca)
734
735This library is free software; you can redistribute it and/or modify it
736under the same terms as Perl itself.
737
738=head1 SEE ALSO
739
740L<Image::ExifTool::PostScript(3pm)|Image::ExifTool::PostScript>,
741L<Image::ExifTool(3pm)|Image::ExifTool>
742
743=cut
Note: See TracBrowser for help on using the repository browser.