oberdiek update from tds zip (28aug06)

git-svn-id: svn://tug.org/texlive/trunk@2054 c570f23f-e606-0410-a88d-b1316a301751

1 files changed, 185 insertions, 0 deletions

diff --git a/Master/texmf-dist/scripts/oberdiek/pdfatfi.pl b/Master/texmf-dist/scripts/oberdiek/pdfatfi.pl
new file mode 100755
index 00000000000..c952d29a4b2
--- /dev/null
+++ b/Master/texmf-dist/scripts/oberdiek/pdfatfi.pl
@@ -0,0 +1,185 @@
+eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}' && eval 'exec perl -S $0 $argv:q'
+  if 0;
+use strict;
+$^W=1; # turn warning on
+#
+# pdfatfi.pl
+#
+# Copyright (C) 2005, 2006 Heiko Oberdiek.
+#
+# This work may be distributed and/or modified under the
+# conditions of the LaTeX Project Public License, either version 1.3
+# of this license or (at your option) any later version.
+# The latest version of this license is in
+#   http://www.latex-project.org/lppl.txt
+# and version 1.3 or later is part of all distributions of LaTeX
+# version 2005/12/01 or later.
+#
+# This work has the LPPL maintenance status "maintained".
+#
+# This Current Maintainer of this work is Heiko Oberdiek.
+#
+# See file "attachfile2.pdf" for a list of files that belong to this project.
+#
+# This file "pdfatfi.pl" may be renamed to "pdfatfi"
+# for installation purposes.
+#
+my $file        = "pdfatfi.pl";
+my $program     = uc($&) if $file =~ /^\w+/;
+my $version     = "2.2";
+my $date        = "2006/08/16";
+my $author      = "Heiko Oberdiek";
+my $copyright   = "Copyright (c) 2005, 2006 by $author.";
+#
+# History:
+#   2005/05/21 v1.0: First release.
+#   2006/08/16 v2.2: Included in DTX file of attachfile2.dtx.
+#
+
+use POSIX qw(strftime); # %z is used (GNU)
+use Digest::MD5;
+
+### program identification
+my $title = "$program $version, $date - $copyright\n";
+
+### error strings
+my $Error = "!!! Error:"; # error prefix
+
+### variables
+my $atfifile;
+
+### option variables
+my @bool = ("false", "true");
+$::opt_help       = 0;
+$::opt_quiet      = 0;
+$::opt_debug      = 0;
+$::opt_verbose    = 0;
+
+my $usage = <<"END_OF_USAGE";
+${title}Syntax:   \L$program\E [options] <file[.atfi]>
+Function: Help program for LaTeX package "attachfile2".
+Options:                                          (defaults:)
+  --help          print usage
+  --(no)quiet     suppress messages               ($bool[$::opt_quiet])
+  --(no)verbose   verbose printing                ($bool[$::opt_verbose])
+  --(no)debug     debug informations              ($bool[$::opt_debug])
+END_OF_USAGE
+
+### process options
+my @OrgArgv = @ARGV;
+use Getopt::Long;
+GetOptions(
+  "help!",
+  "quiet!",
+  "debug!",
+  "verbose!",
+) or die $usage;
+!$::opt_help or die $usage;
+@ARGV == 1 or die "$usage$Error Missing jobname!\n";
+
+$::opt_quiet = 0 if $::opt_verbose;
+
+print $title unless $::opt_quiet;
+
+### get jobname
+$atfifile = $ARGV[0];
+if (!-f $atfifile && -f "$atfifile.atfi") {
+    $atfifile .= ".atfi";
+}
+-f $atfifile or die "$Error File `$atfifile' not found!\n";
+
+print "* job file     = $atfifile\n" if $::opt_verbose;
+
+if ($::opt_debug) {
+  print <<"END_DEB";
+* OSNAME: $^O
+* PERL_VERSION: $]
+* ARGV: @OrgArgv
+END_DEB
+}
+
+my $tmpfile = $atfifile . ".tmp";
+
+my $timezone = strftime "%z", localtime;
+$timezone =~ s/^([+\-]\d\d)(\d\d)$/$1'$2'/;
+
+open(IN, $atfifile) or die "$Error Cannot open `$atfifile'!\n";
+open(OUT, ">$tmpfile") or die "$Error Cannot write `$tmpfile'!\n";
+
+while(<IN>) {
+    # timezone
+    if (s/^(\\attachfile\@timezone\{).*(\})$/$1$timezone$2/) {
+        print "* timezone     = $timezone\n" if $::opt_verbose;
+    }
+
+    # file entry
+    if (/^\\attachfile\@file\[[^\]]*\]\{(.*)\}$/) {
+        my $hexfile = $1;
+        my $file = pack('H*', $hexfile);
+        my @s = stat($file);
+        if (@s == 0) {
+            print "!!! Warning: File `$file' not found!\n";
+        }
+        else {
+            my $size = @s[7];
+            my $mtime = @s[9];
+            my $ctime = @s[10]; # inode change time
+
+            my ($sec, $min, $hour, $mday, $mon, $year) = localtime($mtime);
+            my $moddate = sprintf("%04d%02d%02d%02d%02d%02d",
+                                  $year + 1900, $mon + 1, $mday,
+                                  $hour, $min, $sec);
+
+            # Manual page "perlport" says that "ctime" is creation
+            # time instead of inode change time for "Win32" and
+            # "Mac OS", but it is unsupported for "Mac OS X".
+            my $creationdate = "";
+            if ($^O eq 'MSWin32') { # cygwin?
+                ($sec, $min, $hour, $mday, $mon, $year) = localtime($ctime);
+                $creationdate = sprintf("%04d%02d%02d%02d%02d%02d",
+                                        $year + 1900, $mon + 1, $mday,
+                                        $hour, $min, $sec);
+            }
+
+            # md5 checksum
+            my $checksum = "";
+            my $ctx = Digest::MD5->new;
+            if (open(FILE, $file)) {
+                $ctx->addfile(*FILE);
+                $checksum = $ctx->hexdigest;
+                close(FILE);
+            }
+            else {
+                print "!!! Warning: File `$file' cannot be read,"
+                      . " dropping checksum!\n";
+            }
+
+            $_ = "\\attachfile\@file["
+                 . "ModDate=$moddate,Size=$size"
+                 . (($checksum) ? ",CheckSum=$checksum" : "")
+                 . (($creationdate) ? ",CreationDate=$creationdate" : "")
+                 . "]{$hexfile}\n";
+            if ($::opt_verbose) {
+                print "* file entry   = $file\n";
+                print "  size         = $size\n";
+                print "  moddate      = $moddate\n";
+                print "  creationdate = $creationdate\n" if $creationdate;
+                print "  checksum     = $checksum\n" if $checksum;
+            }
+        }
+    }
+
+    print OUT $_;
+}
+
+close(IN);
+close(OUT);
+
+unlink($atfifile) or die "$Error Cannot delete old `$atfifile'!\n";
+rename $tmpfile, $atfifile
+        or die "$Error Cannot move `$tmpfile' to `$atfifile'!\n";
+
+print "*** ready. ***\n" unless $::opt_quiet;
+
+__END__
+