summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/scripts/attachfile2/pdfatfi.pl
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2019-11-24 21:34:37 +0000
committerKarl Berry <karl@freefriends.org>2019-11-24 21:34:37 +0000
commit4496f7ad4bfd0f0ac5de285d257f704a4666a496 (patch)
treee85528f9abc73b8a8c5ee31b13af4df1d18fc0db /Master/texmf-dist/scripts/attachfile2/pdfatfi.pl
parenta6a6f0433fec0714e037a4ccfc5d67092535a128 (diff)
attachfile2 splt from oberdiek (24nov19)
git-svn-id: svn://tug.org/texlive/trunk@52909 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/texmf-dist/scripts/attachfile2/pdfatfi.pl')
-rw-r--r--Master/texmf-dist/scripts/attachfile2/pdfatfi.pl218
1 files changed, 218 insertions, 0 deletions
diff --git a/Master/texmf-dist/scripts/attachfile2/pdfatfi.pl b/Master/texmf-dist/scripts/attachfile2/pdfatfi.pl
new file mode 100644
index 00000000000..f12381a6064
--- /dev/null
+++ b/Master/texmf-dist/scripts/attachfile2/pdfatfi.pl
@@ -0,0 +1,218 @@
+#!/usr/bin/env perl
+use strict;
+$^W=1; # turn warning on
+#
+# pdfatfi.pl
+#
+# Copyright (C) 2005-2010, 2012 Heiko Oberdiek.
+#
+# This work may be distributed and/or modified under the
+# conditions of the LaTeX Project Public License, either
+# version 1.3c of this license or (at your option) any later
+# version. This version of this license is in
+# https://www.latex-project.org/lppl/lppl-1-3c.txt
+# and the latest version of this license is in
+# https://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".
+#
+# The Current Maintainers of this work are
+# Heiko Oberdiek and the Oberdiek Package Support Group
+# https://github.com/ho-tex/attachfile2/issues
+#
+# 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 $prj = 'pdfatfi';
+my $file = "$prj.pl";
+my $program = uc($&) if $file =~ /^\w+/;
+my $version = "2.9";
+my $date = "2019/11/24";
+my $author = "Heiko Oberdiek";
+my $copyright = "Copyright (c) 2005-2010, 2012 by $author.";
+#
+# History:
+# 2005/05/21 v1.0: First release.
+# 2006/08/16 v2.2: Included in DTX file of attachfile2.dtx.
+# 2010/09/27 v2.6: Keys ModDateTZ and CreationDateTZ added.
+# 2016/05/16 v2.8: Option --version added.
+# 2019/11/24 v2.10: adapted version to attachfile2 version.
+#
+
+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;
+$::opt_version = 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
+ --version print version number
+ --(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!",
+ "version!",
+ "quiet!",
+ "debug!",
+ "verbose!",
+) or die $usage;
+!$::opt_help or die $usage;
+if ($::opt_version) {
+ print "$prj $date v$version\n";
+ exit(0);
+}
+@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;
+
+sub gettz ($) {
+ my $time = shift;
+ my $tz = strftime "%z", localtime($time);
+ return '' unless $tz;
+ return 'Z' if $tz eq '+0000';
+ $tz =~ s/^([+\-]\d\d)(\d\d)$/$1'$2'/;
+ return $tz;
+}
+
+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);
+ my $moddatetz = 'D:' . $moddate . gettz($mtime);
+
+ # 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 = "";
+ my $creationdatetz = "";
+ 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);
+ $creationdatetz =
+ 'D:' . $creationdate . gettz($ctime);
+ }
+
+ # 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["
+ . "ModDateTZ=$moddatetz"
+ . ",Size=$size"
+ . ($checksum ? ",CheckSum=$checksum" : "")
+ . ($creationdatetz ?
+ ",CreationDateTZ=$creationdatetz" :
+ ($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__