From 4496f7ad4bfd0f0ac5de285d257f704a4666a496 Mon Sep 17 00:00:00 2001 From: Karl Berry Date: Sun, 24 Nov 2019 21:34:37 +0000 Subject: attachfile2 splt from oberdiek (24nov19) git-svn-id: svn://tug.org/texlive/trunk@52909 c570f23f-e606-0410-a88d-b1316a301751 --- Master/texmf-dist/scripts/attachfile2/pdfatfi.pl | 218 +++++++++++++++++++++++ 1 file changed, 218 insertions(+) create mode 100644 Master/texmf-dist/scripts/attachfile2/pdfatfi.pl (limited to 'Master/texmf-dist/scripts/attachfile2/pdfatfi.pl') 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] +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() { + # 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__ -- cgit v1.2.3