Changeset 24107 for main/trunk/greenstone2/perllib/cpan/Image/ExifTool/WritePostScript.pl

Timestamp:

2011-06-01T12:33:42+12:00 (13 years ago)

Author:

sjm84

Message:

Updating the ExifTool perl modules

File:

• main/trunk/greenstone2/perllib/cpan/Image/ExifTool/WritePostScript.pl (modified) (11 diffs)

main/trunk/greenstone2/perllib/cpan/Image/ExifTool/WritePostScript.pl

@@ -74 +74 @@
 
 #------------------------------------------------------------------------------
-# Check PS tag value
-# Inputs: 0) ExifTool object ref, 1) tag info ref, 2) value ref
-# Returns: undef on success, or error string
-sub CheckPS($$$)
-{
-    my ($exifTool, $tagInfo, $valPt) = @_;
-    # parentheses must be balanced (or escaped)
-    my $n = 0;
-    pos($$valPt) = 0;
-    while ($$valPt =~ /(\(|\))/g) {
-        $n += ($1 eq '(') ? 1 : -1;
-        last if $n < 0;
-    }
-    return 'Unmatched parentheses' unless $n == 0;
-    return undef;   # success
-}
-
-#------------------------------------------------------------------------------
 # Write XMP directory to file, with begin/end tokens if necessary
 # Inputs: 0) outfile ref, 1) flags hash ref, 2-N) data to write
@@ -160 +142 @@
         $dirInfo{DataPt} = \$xmp;
     }
-    my $tagTablePtr = GetTagTable("Image::ExifTool::${dirName}::Main");
+    my $tagTablePtr = Image::ExifTool::GetTagTable("Image::ExifTool::${dirName}::Main");
     my $val = $exifTool->WriteDirectory(\%dirInfo, $tagTablePtr);
     if (defined $val) {
@@ -264 +246 @@
 
 #------------------------------------------------------------------------------
+# Encode postscript tag/value
+# Inputs: 0) tag ID, 1) value
+# Returns: postscript comment
+# - adds brackets, escapes special characters, and limits line length
+sub EncodeTag($$)
+{
+    my ($tag, $val) = @_;
+    unless ($val =~ /^\d+$/) {
+        $val =~ s/([()\\])/\\$1/g;  # escape brackets and backslashes
+        $val =~ s/\n/\\n/g;         # escape newlines
+        $val =~ s/\r/\\r/g;         # escape carriage returns
+        $val =~ s/\t/\\t/g;         # escape tabs
+        # use octal escape codes for other control characters
+        $val =~ s/([\x00-\x1f\x7f\xff])/sprintf("\\%.3o",ord($1))/ge;
+        $val = "($val)";
+    }
+    my $line = "%%$tag: $val";
+    # postscript line limit is 255 characters
+    # --> split if necessary using continuation comment "%%+"
+    my $n;
+    for ($n=255; length($line)>$n; $n+=255+length($/)) {
+        substr($line, $n, 0) = "$/%%+";
+    }
+    return $line . $/;
+}
+
+#------------------------------------------------------------------------------
 # Write new tags information in comments section
 # Inputs: 0) ExifTool object ref, 1) output file ref, 2) reference to new tag hash
@@ -279 +288 @@
     foreach $tag (sort keys %$newTags) {
         my $tagInfo = $$newTags{$tag};
-        my $newValueHash = $exifTool->GetNewValueHash($tagInfo);
-        next unless Image::ExifTool::IsCreating($newValueHash);
-        my $val = Image::ExifTool::GetNewValues($newValueHash);
-        if ($exifTool->Options('Verbose') > 1) {
-            my $out = $exifTool->Options('TextOut');
-            print $out "    + PostScript:$$tagInfo{Name} = '$val'\n";
-        }
-        $val =~ /^\d+$/ or $val = "($val)"; # add brackets around strings
-        my $buff = "%%$tag: $val$/";
-        if (length $buff > 255) {
-            $exifTool->Warn("Value for too long for $tag");
-        } else {
-            Write($outfile, $buff) or $success = 0;
-            ++$exifTool->{CHANGED};
-        }
+        my $nvHash = $exifTool->GetNewValueHash($tagInfo);
+        next unless Image::ExifTool::IsCreating($nvHash);
+        my $val = Image::ExifTool::GetNewValues($nvHash);
+        $exifTool->VerboseValue("+ PostScript:$$tagInfo{Name}", $val);
+        Write($outfile, EncodeTag($tag, $val)) or $success = 0;
+        ++$exifTool->{CHANGED};
     }
     # write XMP hint if necessary
@@ -436 +436 @@
 # rewrite PostScript data
 #
-    my $oldsep = SetInputRecordSeparator($raf);
-    unless ($oldsep and $raf->ReadLine($buff)) {
+    local $/ = GetInputRecordSeparator($raf);
+    unless ($/ and $raf->ReadLine($buff)) {
         $exifTool->Error('Invalid PostScript data');
         return 1;
     }
     $data .= $buff;
-    unless ($data =~ /^%!PS-Adobe-3.(0|1)/) {
+    unless ($data =~ /^%!PS-Adobe-3\.(\d+)\b/ and $1 < 2) {
         if ($exifTool->Error("Document does not conform to DSC spec. Metadata may be unreadable by other apps", 1)) {
             return 1;
         }
     }
+    my $psRev = $1; # save PS revision number (3.x)
     Write($outfile, $data) or $err = 1;
     $flags{EPS} = 1 if $data =~ /EPSF/;
@@ -461 +462 @@
     # set XMP hint flag (1 for adding, 0 for deleting, undef for no change)
     $xmpHint = 1 if $$addDirs{XMP};
-    $xmpHint = 0 if $exifTool->{DEL_GROUP}->{XMP};
+    $xmpHint = 0 if $$exifTool{DEL_GROUP}{XMP};
     $$newTags{XMP_HINT} = $xmpHint if $xmpHint;  # add special tag to newTags list
 
-    my @lines;
+    my (@lines, $changedNL);
     my $altnl = ($/ eq "\x0d") ? "\x0a" : "\x0d";
 
@@ -474 +475 @@
             $dos and CheckPSEnd($raf, $psEnd, $data);
             # split line if it contains other newline sequences
-            SplitLine(\$data, \@lines) if $data =~ /$altnl/;
-        }
+            if ($data =~ /$altnl/) {
+                if (length($data) > 500000 and IsPC()) {
+                    # patch for Windows memory problem
+                    unless ($changedNL) {
+                        $changedNL = 1;
+                        my $t = $/;
+                        $/ = $altnl;
+                        $altnl = $t;
+                        $raf->Seek(-length($data), 1);
+                        next;
+                    }
+                } else {
+                    # split into separate lines
+                    SplitLine(\$data, \@lines);
+                }
+            }
+        }
+        undef $changedNL;
         if ($endToken) {
             # look for end token
@@ -537 +554 @@
             # rewrite information from PostScript tags in comments
             my ($tag, $val) = ($1, $2);
+            # handle Adobe Illustrator files specially
+            # - EVENTUALLY IT WOULD BE BETTER TO FIND ANOTHER IDENTIFICATION METHOD
+            #   (because Illustrator doesn't care if the Creator is changed)
+            if ($tag eq 'Creator' and $val =~ /^Adobe Illustrator/) {
+                # disable writing XMP to PS-format Adobe Illustrator files and
+                # older Illustrator EPS files becaues it confuses Illustrator
+                # (Illustrator 8 and older write PS-Adobe-3.0, newer write PS-Adobe-3.1)
+                if ($$editDirs{XMP} and $psRev == 0) {
+                    if ($flags{EPS}) {
+                        $exifTool->Warn("Can't write XMP to Illustrator 8 or older EPS files");
+                    } else {
+                        $exifTool->Warn("Can't write XMP to PS-format AI files");
+                    }
+                    # pretend like we wrote it already so we won't try to add it later
+                    $doneDir{XMP} = 1;
+                }
+                # don't allow "Creator" to be changed in Illustrator files
+                # (we need it to be able to recognize these files)
+                # --> find a better way to do this!
+                if ($$newTags{$tag}) {
+                    $exifTool->Warn("Can't change Postscript:Creator of Illustrator files");
+                    delete $$newTags{$tag};
+                }
+            }
             if ($$newTags{$tag}) {
                 my $tagInfo = $$newTags{$tag};
+                delete $$newTags{$tag}; # write it then forget it
                 next unless ref $tagInfo;
-                delete $$newTags{$tag}; # write it then forget it
-                $val =~ s/\x0d*\x0a*$//;        # remove trailing CR, LF or CR/LF
-                if ($val =~ s/^\((.*)\)$/$1/) { # remove brackets if necessary
-                    $val =~ s/\) \(/, /g;       # convert contained brackets too
-                }
-                my $newValueHash = $exifTool->GetNewValueHash($tagInfo);
-                if (Image::ExifTool::IsOverwriting($newValueHash, $val)) {
-                    $verbose > 1 and print $out "    - PostScript:$$tagInfo{Name} = '$val'\n";
-                    $val = Image::ExifTool::GetNewValues($newValueHash);
+                # decode comment string (reading continuation lines if necessary)
+                $val = DecodeComment($val, $raf, \@lines, \$data);
+                $val = join $exifTool->Options('ListSep'), @$val if ref $val eq 'ARRAY';
+                my $nvHash = $exifTool->GetNewValueHash($tagInfo);
+                if (Image::ExifTool::IsOverwriting($nvHash, $val)) {
+                    $exifTool->VerboseValue("- PostScript:$$tagInfo{Name}", $val);
+                    $val = Image::ExifTool::GetNewValues($nvHash);
                     ++$exifTool->{CHANGED};
                     next unless defined $val;   # next if tag is being deleted
-                    $verbose > 1 and print $out "    + PostScript:$$tagInfo{Name} = '$val'\n";
-                    $val =~ /^\d+$/ or $val = "($val)"; # add brackets around strings
-                    $buff = "%%$tag: $val$/";
-                    if (length $buff > 255) {
-                        # lines in PS documents must be less than 256 characters
-                        # (don't yet support continuation with %%+ comment)
-                        $exifTool->Warn("Value for too long for $tag");
-                    } else {
-                        $data = $buff;  # write the new value
-                    }
+                    $exifTool->VerboseValue("+ PostScript:$$tagInfo{Name}", $val);
+                    $data = EncodeTag($tag, $val);
                 }
             }
@@ -663 +695 @@
         push @notDone, 'PostScript' if %$newTags;
         foreach $dir (qw{Photoshop ICC_Profile XMP}) {
-            push @notDone, $dir if $$editDirs{$dir} and not $doneDir{$dir};
+            push @notDone, $dir if $$editDirs{$dir} and not $doneDir{$dir} and
+                                   not $$exifTool{DEL_GROUP}{$dir};
         }
         @notDone and $exifTool->Warn("Couldn't write ".join('/',@notDone).' information');
@@ -698 +731 @@
 =head1 NOTES
 
-Currently, information is written only in the outter-level document.
+Currently, information is written only in the outer-level document.
 
 Photoshop will discard meta information in a PostScript document if it has
@@ -731 +764 @@
 =head1 AUTHOR
 
-Copyright 2003-2007, Phil Harvey (phil at owl.phy.queensu.ca)
+Copyright 2003-2011, Phil Harvey (phil at owl.phy.queensu.ca)
 
 This library is free software; you can redistribute it and/or modify it