diff options
Diffstat (limited to 'Master/texmf-dist/scripts/memoize/memoize-extract.pl')
-rwxr-xr-x | Master/texmf-dist/scripts/memoize/memoize-extract.pl | 859 |
1 files changed, 714 insertions, 145 deletions
diff --git a/Master/texmf-dist/scripts/memoize/memoize-extract.pl b/Master/texmf-dist/scripts/memoize/memoize-extract.pl index 8fba3d356fb..96eec29b97e 100755 --- a/Master/texmf-dist/scripts/memoize/memoize-extract.pl +++ b/Master/texmf-dist/scripts/memoize/memoize-extract.pl @@ -18,188 +18,757 @@ # The files belonging to this work and covered by LPPL are listed in # <texmf>/doc/generic/memoize/FILES. +my $PROG = 'memoize-extract.pl'; +my $VERSION = '2024/01/02 v1.1.0'; + use strict; +use File::Basename qw/basename/; use Getopt::Long; -use Path::Class; -use File::Spec; -use File::Basename; -use PDF::API2; +use File::Spec::Functions + qw/splitpath catpath splitdir rootdir file_name_is_absolute/; +use File::Path qw(make_path); +# We will only try to import the PDF processing library once we set up the error +# log. + +# Declare variables for command-line arguments and for |kpathsea| +# variables. They are defined here so that they are global in the subs which use +# them. +our ($pdf_file, $prune, $keep, $format, $force, $quiet, + $pdf_library, $print_version, $mkdir, $help, + $openin_any, $openout_any, $texmfoutput, $texmf_output_directory); + +# \paragraph{Messages} + +# The messages are written both to the extraction log and the terminal (we +# output to stdout rather than stderr so that messages on the TeX terminal and +# document |.log| appear in chronological order). Messages are automatically +# adapted to the TeX |--format|. + +# The format of the messages. It depends on the given |--format|; the last +# entry is for t the terminal output. + +my %ERROR = ( + latex => '\PackageError{memoize (perl-based extraction)}{$short}{$long}', + plain => '\errhelp{$long}\errmessage{memoize (perl-based extraction): $short}', + context => '\errhelp{$long}\errmessage{memoize (perl-based extraction): $short}', + '' => '$header$short. $long'); + +my %WARNING = ( + latex => '\PackageWarning{memoize (perl-based extraction)}{$texindent$text}', + plain => '\message{memoize (perl-based extraction) Warning: $texindent$text}', + context => '\message{memoize (perl-based extraction) Warning: $texindent$text}', + '' => '$header$indent$text.'); + +my %INFO = ( + latex => '\PackageInfo{memoize (perl-based extraction)}{$texindent$text}', + plain => '\message{memoize (perl-based extraction): $texindent$text}', + context => '\message{memoize (perl-based extraction): $texindent$text}', + '' => '$header$indent$text.'); -my $VERSION = '2023/10/10 v1.0.0'; +# Some variables used in the message routines; note that |header| will be +# redefined once we parse the arguments. + +my $exit_code = 0; +my $log; +my $header = ''; +my $indent = ''; +my $texindent = ''; + +# The message routines. + +sub error { + my ($short, $long) = @_; + if (! $quiet) { + $_ = $ERROR{''}; + s/\$header/$header/; + s/\$short/$short/; + s/\$long/$long/; + print(STDOUT "$_\n"); + } + if ($log) { + $long =~ s/\\/\\string\\/g; + $_ = $ERROR{$format}; + s/\$short/$short/; + s/\$long/$long/; + print(LOG "$_\n"); + } + $exit_code = 11; + endinput(); +} + +sub warning { + my $text = shift; + if ($log) { + $_ = $WARNING{$format}; + s/\$texindent/$texindent/; + s/\$text/$text/; + print(LOG "$_\n"); + } + if (! $quiet) { + $_ = $WARNING{''}; + s/\$header/$header/; + s/\$indent/$indent/; + s/\$text/$text/; + print(STDOUT "$_\n"); + } + $exit_code = 10; +} + +sub info { + my $text = shift; + if ($text && ! $quiet) { + $_ = $INFO{''}; + s/\$header/$header/; + s/\$indent/$indent/; + s/\$text/$text/; + print(STDOUT "$_\n"); + if ($log) { + $_ = $INFO{$format}; + s/\$texindent/$texindent/; + s/\$text/$text/; + print(LOG "$_\n"); + } + } +} + +# Mark the log as complete and exit. +sub endinput { + if ($log) { + print(LOG "\\endinput\n"); + close(LOG); + } + exit $exit_code; +} + +sub die_handler { + stderr_to_warning(); + my $text = shift; + chomp($text); + error("Perl error: $text", ''); +} + +sub warn_handler { + my $text = shift; + chomp($text); + warning("Perl warning: $text"); +} + +# This is used to print warning messages from PDF::Builder, which are output to +# STDERR. +my $stderr; +sub stderr_to_warning { + if ($stderr) { + my $w = ' Perl info: '; + my $nl = ''; + for (split(/\n/, $stderr)) { + /(^\s*)(.*?)(\s*)$/; + $w .= ($1 ? ' ' : $nl) . $2; + $nl = "\n"; + } + warning("$w"); + $stderr = ''; + } +} + +# \paragraph{Permission-related functions} + +# We will need these variables below. Note that we only support Unix and +# Windows. +my $on_windows = $^O eq 'MSWin32'; +my $dirsep = $on_windows ? '\\' : '/'; + +# |paranoia_in|/|out| should work exactly as +# |kpsewhich -safe-in-name|/|-safe-out-name|. +sub paranoia_in { + my ($f, $remark) = @_; + error("I'm not allowed to read from '$f' (openin_any = $openin_any)", + $remark) unless _paranoia($f, $openin_any); +} + +sub paranoia_out { + my ($f, $remark) = @_; + error("I'm not allowed to write to '$f' (openin_any = $openout_any)", + $remark) unless _paranoia($f, $openout_any); +} + +sub _paranoia { + # |f| is the path to the file (it should not be empty), and |mode| is the + # value of |openin_any| or |openout_any|. + my ($f, $mode) = @_; + return if (! $f); + # We split the filename into the directory and the basename part, and the + # directory into components. + my ($volume, $dir, $basename) = splitpath($f); + my @dir = splitdir($dir); + return ( + # In mode `any' (|a|, |y| or |1|), we may access any file. + $mode =~ /^[ay1]$/ + || ( + # Otherwise, we are at least in the restricted mode, so we should + # not open dot files on Unix-like systems (except file called + # |.tex|). + ! (!$on_windows && $basename =~ /^\./ && !($basename =~ /^\.tex$/)) + && ( + # If we are precisely in the restricted mode (|r|, |n|, |0|), + # then there are no further restrictions. + $mode =~ /^[rn0]$/ + # Otherwise, we are in the paranoid mode (officially |p|, but + # any other value is interpreted as |p| as well). There are + # two further restrictions in the paranoid mode. + || ( + # We're not allowed to go to a parent directory. + ! grep(/^\.\.$/, @dir) && $basename ne '..' + && + # If the given path is absolute, is should be a descendant + # of either |TEXMF_OUTPUT_DIRECTORY| or |TEXMFOUTPUT|. + (!file_name_is_absolute($f) + || + is_ancestor($texmf_output_directory, $f) + || + is_ancestor($texmfoutput, $f) + ))))); +} + +# Only removes final "/"s. This is unlike |File::Spec|'s |canonpath|, which also +# removes |.| components, collapses multiple |/| --- and unfortunately also goes +# up for |..| on Windows. +sub normalize_path { + my $path = shift; + my ($v, $d, $n) = splitpath($path); + if ($n eq '' && $d =~ /[^\Q$dirsep\E]\Q$dirsep\E+$/) { + $path =~ s/\Q$dirsep\E+$//; + } + return $path; +} + +# On Windows, we disallow ``semi-absolute'' paths, i.e.\ paths starting with the +# |\| but lacking the drive. |File::Spec|'s function |file_name_is_absolute| +# returns 2 if the path is absolute with a volume, 1 if it's absolute with no +# volume, and 0 otherwise. After a path was sanitized using this function, +# |file_name_is_absolute| will work as we want it to. +sub sanitize_path { + my $f = normalize_path(shift); + my ($v, $d, $n) = splitpath($f); + if ($on_windows) { + my $a = file_name_is_absolute($f); + if ($a == 1 || ($a == 0 && $v) ) { + error("\"Semi-absolute\" paths are disallowed: " . $f, + "The path must either both contain the drive letter and " . + "start with '\\', or none of these; paths like 'C:foo\\bar' " . + "and '\\foo\\bar' are disallowed"); + } + } +} + +sub access_in { + return -r shift; +} + +sub access_out { + my $f = shift; + my $exists; + eval { $exists = -e $f }; + # Presumably, we get this error when the parent directory is not executable. + return if ($@); + if ($exists) { + # An existing file should be writable, and if it's a directory, it + # should also be executable. + my $rw = -w $f; my $rd = -d $f; my $rx = -x $f; + return -w $f && (! -d $f || -x $f); + } else { + # For a non-existing file, the parent directory should be writable. + # (This is the only place where function |parent| is used, so it's ok + # that it returns the logical parent.) + my $p = parent($f); + return -w $p; + } +} + +# This function finds the location for an input file, respecting +# |TEXMF_OUTPUT_DIRECTORY| and |TEXMFOUTPUT|, and the permissions in the +# filesystem. It returns an absolute file as-is. For a relative file, it tries +# |TEXMF_OUTPUT_DIRECTORY| (if defined), the current directory (always), and +# |TEXMFOUTPUT| directory (if defined), in this order. The first readable file +# found is returned; if no readable file is found, the file in the current +# directory is returned. +sub find_in { + my $f = shift; + sanitize_path($f); + return $f if file_name_is_absolute($f); + for my $df ( + $texmf_output_directory ? join_paths($texmf_output_directory, $f) : undef, + $f, + $texmfoutput ? join_paths($texmfoutput, $f) : undef) { + return $df if $df && -r $df; + } + return $f; +} + +# This function finds the location for an output file, respecting +# |TEXMF_OUTPUT_DIRECTORY| and |TEXMFOUTPUT|, and the permissions in the +# filesystem. It returns an absolute file as-is. For a relative file, it tries +# |TEXMF_OUTPUT_DIRECTORY| (if defined), the current directory (unless +# |TEXMF_OUTPUT_DIRECTORY| is defined), and |TEXMFOUTPUT| directory (if +# defined), in this order. The first writable file found is returned; if no +# writable file is found, the file in either the current or the output directory +# is returned. +sub find_out { + my $f = shift; + sanitize_path($f); + return $f if file_name_is_absolute($f); + for my $df ( + $texmf_output_directory ? join_paths($texmf_output_directory, $f) : undef, + $texmf_output_directory ? undef : $f, + $texmfoutput ? join_paths($texmfoutput, $f) : undef) { + return $df if $df && access_out($df); + } + return $texmf_output_directory ? join_paths($texmf_output_directory, $f) : $f; +} + +# We next define some filename-related utilities matching what Python offers out +# of the box. We avoid using |File::Spec|'s |canonpath|, because on Windows, +# which has no concept of symlinks, this function resolves |..| to the parent. + +sub name { + my $path = shift; + my ($volume, $dir, $filename) = splitpath($path); + return $filename; +} + +sub suffix { + my $path = shift; + my ($volume, $dir, $filename) = splitpath($path); + $filename =~ /\.[^.]*$/; + return $&; +} -my $usage = "usage: memoize-extract.pl [-h] [--pdf PDF] [--prune] [--keep] [--force] [--log LOG] [--warning-template WARNING_TEMPLATE] [--quiet] [--mkdir] mmz\n"; +sub with_suffix { + my ($path, $suffix) = @_; + my ($volume, $dir, $filename) = splitpath($path); + if ($filename =~ s/\.[^.]*$/$suffix/) { + return catpath($volume, $dir, $filename); + } else { + return catpath($volume, $dir, $filename . $suffix); + } +} + +sub with_name { + my ($path, $name) = @_; + my ($volume, $dir, $filename) = splitpath($path); + my ($v,$d,$f) = splitpath($name); + die "Runtime error in with_name: " . + "'$name' should not contain the directory component" + unless $v eq '' && $d eq '' && $f eq $name; + return catpath($volume, $dir, $name); +} + +sub join_paths { + my $path1 = normalize_path(shift); + my $path2 = normalize_path(shift); + return $path2 if !$path1 || file_name_is_absolute($path2); + my ($volume1, $dir1, $filename1) = splitpath($path1, 'no_file'); + my ($volume2, $dir2, $filename2) = splitpath($path2); + die if $volume2; + return catpath($volume1, + join($dirsep, ($dir1 eq $dirsep ? '' : $dir1, $dir2)), + $filename2); +} + +# The logical parent. The same as |pathlib.parent| in Python. +sub parent { + my $f = normalize_path(shift); + my ($v, $dn, $_dummy) = splitpath($f, 1); + my $p_dn = $dn =~ s/[^\Q$dirsep\E]+$//r; + if ($p_dn eq '') { + $p_dn = $dn =~ /^\Q$dirsep\E/ ? $dirsep : '.'; + } + my $p = catpath($v, $p_dn, ''); + $p = normalize_path($p); + return $p; +} + +# This function assumes that both paths are absolute; ancestor may be '', +# signaling a non-path. +sub is_ancestor { + my $ancestor = normalize_path(shift); + my $descendant = normalize_path(shift); + return if ! $ancestor; + $ancestor .= $dirsep unless $ancestor =~ /\Q$dirsep\E$/; + return $descendant =~ /^\Q$ancestor/; +} + +# A paranoid |Path.mkdir|. The given folder is preprocessed by |find_out|. +sub make_directory { + my $folder = find_out(shift); + if (! -d $folder) { + paranoia_out($folder); + # Using |make_path| is fine because we know that + # |TEXMF_OUTPUT_DIRECTORY|/|TEXMFOUTPUT|, if given, exists, and that + # ``folder'' contains no |..|. + make_path($folder); + # This does not get logged when the function is invoked via |--mkdir|, + # as it is not clear what the log name should be. + info("Created directory $folder"); + } +} + +sub unquote { + shift =~ s/"(.*?)"/\1/rg; +} + +# \paragraph{Kpathsea} + +# Get the values of |openin_any|, |openout_any|, |TEXMFOUTPUT| and +# |TEXMF_OUTPUT_DIRECTORY|. + +my $maybe_backslash = $on_windows ? '' : '\\'; +my $query = 'kpsewhich -expand-var=' . + "openin_any=$maybe_backslash\$openin_any," . + "openout_any=$maybe_backslash\$openout_any," . + "TEXMFOUTPUT=$maybe_backslash\$TEXMFOUTPUT"; +my $kpsewhich_output = `$query`; +if (! $kpsewhich_output) { + # No TeX? (Note that |kpsewhich| should exist in MiKTeX as well.) In + # absence of |kpathsea| information, we get very paranoid. + ($openin_any, $openout_any) = ('p', 'p'); + ($texmfoutput, $texmf_output_directory) = ('', ''); + # Unfortunately, this warning can't make it into the log. But then again, + # the chances of a missing |kpsewhich| are very slim, and its absence would + # show all over the place anyway. + warning('I failed to execute "kpsewhich", is there no TeX system installed? ' . + 'Assuming openin_any = openout_any = "p" ' . + '(i.e. restricting all file operations to non-hidden files ' . + 'in the current directory of its subdirectories).'); +} else { + $kpsewhich_output =~ /^openin_any=(.*),openout_any=(.*),TEXMFOUTPUT=(.*)/; + ($openin_any, $openout_any, $texmfoutput) = @{^CAPTURE}; + $texmf_output_directory = $ENV{'TEXMF_OUTPUT_DIRECTORY'}; + if ($openin_any =~ '^\$openin_any') { + # When the |open*_any| variables are not expanded, we assume we're + # running MiKTeX. The two config settings below correspond to TeXLive's + # |openin_any| and |openout_any|; afaik, there is no analogue to + # |TEXMFOUTPUT|. + $query = 'initexmf --show-config-value=[Core]AllowUnsafeInputFiles ' . + '--show-config-value=[Core]AllowUnsafeOutputFiles'; + my $initexmf_output = `$query`; + $initexmf_output =~ /^(.*)\n(.*)\n/m; + $openin_any = $1 eq 'true' ? 'a' : 'p'; + $openout_any = $2 eq 'true' ? 'a' : 'p'; + $texmfoutput = ''; + $texmf_output_directory = ''; + } +} + +# An output directory should exist, and may not point to the root on Linux. On +# Windows, it may point to the root, because being absolute also implies +# containing the drive; see |sanitize_filename|. +sub sanitize_output_dir { + return unless my $d = shift; + sanitize_path($d); + # On Windows, |rootdir| returns |\|, so it cannot possibly match |$d|. + return $d if -d $d && $d ne rootdir(); +} + +$texmfoutput = sanitize_output_dir($texmfoutput); +$texmf_output_directory = sanitize_output_dir($texmf_output_directory); + +# We don't delve into the real script when loaded from the testing code. +return 1 if caller; + +# \paragraph{Arguments} + +my $usage = "usage: $PROG [-h] [-P PDF] [-p] [-k] [-F {latex,plain,context}] [-f] " . + "[-L {PDF::API2,PDF::Builder}] [-q] [-m] [-V] mmz\n"; my $Help = <<END; -Extract extern pages out of the document PDF. +Extract extern pages produced by package Memoize out of the document PDF. positional arguments: - mmz the record file produced by Memoize: doc.mmz when compiling doc.tex + mmz the record file produced by Memoize: + doc.mmz when compiling doc.tex + (doc and doc.tex are accepted as well) options: - --help, -h show this help message and exit - --version, -V show version and exit - --pdf PDF, -P PDF extract from file PDF - --prune, -p remove the extern pages after extraction - --keep, -k do not mark externs as extracted - --force, -f extract even if the size-check fails - --log LOG, -l LOG the log file - --warning-template WARNING_TEMPLATE, -w WARNING_TEMPLATE - \warningtext in the template will be replaced by the warning message - --quiet, -q don't describe what's happening - --embedded, -e prefix all messages to the standard output with the script name - --mkdir, -m create a directory (and exit) + -h, --help show this help message and exit + -P PDF, --pdf PDF extract from file PDF + -p, --prune remove the extern pages after extraction + -k, --keep do not mark externs as extracted + -F, --format {latex,plain,context} + the format of the TeX document invoking extraction + -f, --force extract even if the size-check fails + -q, --quiet describe what's happening + -L, --library {PDF::API2, PDF::Builder} + which PDF library to use for extraction (default: PDF::API2) + -m, --mkdir create a directory (and exit); + mmz argument is interpreted as directory name + -V, --version show program's version number and exit For details, see the man page or the Memoize documentation. END -my ($pdf_arg, $prune, $keep, $log, $quiet, $embedded, $force, $mkdir, $help, $print_version); -my $warning_template = '\warningtext'; +my @valid_libraries = ('PDF::API2', 'PDF::Builder'); Getopt::Long::Configure ("bundling"); GetOptions( - "pdf|P=s" => \$pdf_arg, - "keep|k" => \$keep, + "pdf|P=s" => \$pdf_file, "prune|p" => \$prune, - "log|l=s" => \$log, - "quiet|q" => \$quiet, - "embedded|e" => \$embedded, + "keep|k" => \$keep, + "format|F=s" => \$format, "force|f" => \$force, - "warning-template|w=s" => \$warning_template, + "quiet|q" => \$quiet, + "library|L=s" => \$pdf_library, "mkdir|m" => \$mkdir, - "help|h|?" => \$help, "version|V" => \$print_version, + "help|h|?" => \$help, ) or die $usage; + if ($help) {print("$usage\n$Help"); exit 0} -if ($print_version) { print("memoize-extract.pl of Memoize $VERSION\n"); exit 0 } -die $usage unless @ARGV == 1; -my $message_prefix = $embedded ? basename($0) . ': ' : ''; -print("\n") if ($embedded); +if ($print_version) { print("$PROG of Memoize $VERSION\n"); exit 0 } -my @output_paths = (dir()->absolute->resolve); -my $texmfoutput = `kpsewhich --var-value=TEXMFOUTPUT`; -$texmfoutput =~ s/^\s+|\s+$//g; -if ($texmfoutput) { - my $texmfoutput_dir = dir($texmfoutput)->absolute->resolve; - push(@output_paths, $texmfoutput_dir) unless $texmfoutput_dir->dir_list == 1 && ! $texmfoutput_dir->volume; -} +die "${usage}$PROG: error: the following arguments are required: mmz\n" + unless @ARGV == 1; -sub paranoia { - my $file = $_[0]; - die "${message_prefix}Cannot create a hidden file or dir: $file" - if $file->basename =~ /^\./; - my $parent = $file->parent->absolute->resolve; - die "${message_prefix}Cannot write outside the current working or output directory tree: $file" - unless grep($_->contains($parent), @output_paths); -} +die "${usage}$PROG: error: argument -F/--format: invalid choice: '$format' " . + "(choose from 'latex', 'plain', 'context')\n" + unless grep $_ eq $format, ('', 'latex', 'plain', 'context'); + +die "${usage}$PROG: error: argument -L/--library: invalid choice: '$pdf_library' " . + "(choose from " . join(", ", @valid_libraries) . ")\n" + if $pdf_library && ! grep $_ eq $pdf_library, @valid_libraries; -my $mmz_arg = $ARGV[0]; -my $mmz_file = file($mmz_arg); -my $mmz_dir = $mmz_file->parent; +$header = $format ? basename($0) . ': ' : ''; +# start a new line in the TeX terminal output +print("\n") if $format; + +# \paragraph{Initialization} + +# With |--mkdir|, argument |mmz| is interpreted as the directory to create. if ($mkdir) { - my $dir = dir($mmz_arg)->cleanup; - my $current = dir(File::Spec->catpath($dir->volume, - $dir->is_absolute ? File::Spec->rootdir : File::Spec->curdir, - ''))->absolute; - for my $c ($dir->components) { - $current = $current->subdir($c); - if (-d $current) { - $current = $current->resolve; - } else { - paranoia($current); - mkdir($current); - print("${message_prefix}Created directory $current\n") unless $quiet; - } - } - exit; -} else { - die "${message_prefix}The 'mmz' argument should be a file with suffix '.mmz', not '$mmz_file'\n" unless $mmz_file->basename =~ /\.mmz$/; + make_directory($ARGV[0]); + exit 0; } -# Enable in-place editing (of the .mmz file). -paranoia($mmz_file) unless $keep; -$^I = "" unless $keep; - -my $pdf_file = $pdf_arg ? file($pdf_arg) : $mmz_dir->file($mmz_file->basename =~ s/\.mmz$/\.pdf/r)->cleanup; -paranoia($pdf_file) if $prune; +# Normalize the |mmz| argument into a |.mmz| filename. +my $mmz_file = $ARGV[0]; +$mmz_file = with_suffix($mmz_file, '.mmz') + if suffix($mmz_file) eq '.tex'; +$mmz_file = with_name($mmz_file, name($mmz_file) . '.mmz') + if suffix($mmz_file) ne '.mmz'; -if ($log) { - paranoia(file($log)); +# Once we have the |.mmz| filename, we can open the log. +if ($format) { + my $_log = find_out(with_suffix($mmz_file, '.mmz.log')); + paranoia_out($_log); + info("Logging to '$_log'"); + $log = $_log; open LOG, ">$log"; +} + +# Now that we have opened the log file, we can try loading the PDF processing +# library. +if ($pdf_library) { + eval "use $pdf_library"; + error("Perl module '$pdf_library' was not found", + 'Have you followed the instructions is section 1.1 of the manual?') + if ($@); } else { - *LOG = *STDERR; + for (@valid_libraries) { + eval "use $_"; + if (!$@) { + $pdf_library = $_; + last; + } + } + if (!$pdf_library) { + error("No suitable Perl module for PDF processing was found, options are " . + join(", ", @valid_libraries), + 'Have you followed the instructions is section 1.1 of the manual?'); + } +} + +# Catch any errors in the script and output them to the log. +$SIG{__DIE__} = \&die_handler; +$SIG{__WARN__} = \&warn_handler; +close(STDERR); +open(STDERR, ">", \$stderr); + +# Find the |.mmz| file we will read, but retain the original filename in +# |$given_mmz_file|, as we will still need it. +my $given_mmz_file = $mmz_file; +$mmz_file = find_in($mmz_file, 1); +if (! -e $mmz_file) { + info("File '$given_mmz_file' does not exist, assuming there's nothing to do"); + endinput(); } +paranoia_in($mmz_file); +paranoia_out($mmz_file, + 'I would have to rewrite this file unless option --keep is given.') + unless $keep; -my ($pdf, %extern_pages); -print "${message_prefix}Extracting externs from $pdf_file:\n" unless $quiet; +# Determine the PDF filename: it is either given via |--pdf|, or constructed +# from the |.mmz| filename. +$pdf_file = with_suffix($given_mmz_file, '.pdf') if !$pdf_file; +$pdf_file = find_in($pdf_file); +paranoia_in($pdf_file); +paranoia_out($pdf_file, + 'I would have to rewrite this file because option --prune was given.') + if $prune; +# Various initializations. +my $pdf; +my %extern_pages; +my $new_mmz; my $tolerance = 0.01; -my $done_message = "${message_prefix}Done (there was nothing to extract).\n"; - -while (<>) { - if (/^\\mmzNewExtern *{(?P<extern_path>(?P<prefix>.*?)(?P<code_md5sum>[0-9A-F]{32})-(?P<context_md5sum>[0-9A-F]{32})(?:-[0-9]+)?.pdf)}{(?P<page_n>[0-9]+)}{(?P<expected_width>[0-9.]*)pt}{(?P<expected_height>[0-9.]*)pt}/) { - my $extern_file = file($+{extern_path}); - if (! $extern_file->is_absolute) { - $extern_file = $mmz_dir->file($+{extern_path}); - } - paranoia($extern_file); - my $page = $+{page_n}; - my $expected_width_pt = $+{expected_width}; - my $expected_height_pt = $+{expected_height}; - my $c_memo_file = $mmz_dir->file($+{prefix} . $+{code_md5sum} . '.memo'); - my $cc_memo_file = $mmz_dir->file($+{prefix} . $+{code_md5sum} . '-' . $+{context_md5sum} . '.memo'); - if (!(-e $c_memo_file && -e $cc_memo_file)) { - print LOG ($warning_template =~ s/\\warningtext/Not extracting page $page into extern $extern_file, because the associated (c)c-memo does not exist/gr), "\n\\endinput\n"; - last; - } - eval { $pdf = PDF::API2->open($pdf_file->stringify) unless $pdf; }; - if ($@) { - print LOG ($warning_template =~ s/\\warningtext/Cannot read file "$pdf_file". Perhaps you have to load Memoize earlier in the preamble?/gr), "\n\\endinput\n"; - close LOG; - die "${message_prefix}File '$pdf_file' cannot be read, bailing out.\n"; - } - my $extern = PDF::API2->new(); - $extern->version($pdf->version); - $extern->import_page($pdf, $page); - my $extern_page = $extern->open_page(1); - my ($x0, $y0, $x1, $y1) = $extern_page->get_mediabox(); - my $width_pt = ($x1 - $x0) / 72 * 72.27; - my $height_pt = ($y1 - $y0) / 72 * 72.27; - my $warning = ''; - if (abs($width_pt - $expected_width_pt) > $tolerance - || abs($height_pt - $expected_height_pt) > $tolerance) - { - $warning = "I refuse to extract page $page from $pdf_file, because its size (${width_pt}pt x ${height_pt}pt) is not what I expected (${expected_width_pt}pt x ${expected_height_pt}pt)"; - print LOG ($warning_template =~ s/\\warningtext/$warning/gr), "\n"; - } - if ($warning && !$force) { - unlink $extern_file; - } else { - $extern->saveas($extern_file->stringify); - $done_message = "${message_prefix}Done.\n"; - print STDOUT "${message_prefix} Page $page --> $extern_file\n" unless $quiet; - $extern_pages{$page} = 1 if $prune; - print("%") unless $keep; - } - } - print unless $keep; -} - -print $done_message unless $quiet; - -if ($pdf and $prune) { - paranoia($pdf_file); - my $pruned_pdf = PDF::API2->new(); - for (my $n = 1; $n <= $pdf->page_count(); $n++) { - if (! $extern_pages{$n}) { - $pruned_pdf->import_page($pdf, $n); - } +info("Extracting new externs listed in '$mmz_file' " . + "from '$pdf_file' using Perl module $pdf_library"); +my $done_message = "Done (there was nothing to extract)"; +$indent = ' '; +$texindent = '\space\space '; +my $dir_to_make; + +# \paragraph{Process \texttt{.mmz}} +# +# We cannot process the .mmz file using in-place editing. It would fail when +# the file is writable but its parent directory is not. + +open (MMZ, $mmz_file); +while (<MMZ>) { + my $mmz_line = $_; + if (/^\\mmzPrefix *{(?P<prefix>)}/) { + # Found |\mmzPrefix|: create the extern directory, but only later, if an + # extern file is actually produced. We parse the prefix in two steps + # because we have to unquote the entire prefix. + my $prefix = unquote($+{prefix}); + warning("Cannot parse line '$mmz_line'") unless + $prefix =~ /(?P<dir_prefix>.*\/)?(?P<name_prefix>.*?)/; + $dir_to_make = $+{dir_prefix}; + } elsif (/^\\mmzNewExtern\ *{(?P<extern_path>.*?)}{(?P<page_n>[0-9]+)}# + {(?P<expected_width>[0-9.]*)pt}{(?P<expected_height>[0-9.]*)pt}/x) { + # Found |\mmzNewExtern|: extract the extern page into an extern file. + $done_message = "Done"; + my $ok = 1; + my %m_ne = %+; + # The extern filename, as specified in |.mmz|: + my $extern_file = unquote($m_ne{extern_path}); + # We parse the extern filename in a separate step because we have to + # unquote the entire path. + warning("Cannot parse line '$mmz_line'") unless + $extern_file =~ /(?P<dir_prefix>.*\/)?(?P<name_prefix>.*?)# + (?P<code_md5sum>[0-9A-F]{32})-# + (?P<context_md5sum>[0-9A-F]{32})(?:-[0-9]+)?.pdf/x; + # The actual extern filename: + my $extern_file_out = find_out($extern_file); + paranoia_out($extern_file_out); + my $page = $m_ne{page_n}; + # Check whether c-memo and cc-memo exist (in any input directory). + my $c_memo = with_name($extern_file, + $+{name_prefix} . $+{code_md5sum} . '.memo'); + my $cc_memo = with_name($extern_file, + $+{name_prefix} . $+{code_md5sum} . + '-' . $+{context_md5sum} . '.memo'); + my $c_memo_in = find_in($c_memo); + my $cc_memo_in = find_in($cc_memo); + if ((! access_in($c_memo_in) || ! access_in($cc_memo_in)) && !$force) { + warning("I refuse to extract page $page into extern '$extern_file', " . + "because the associated c-memo '$c_memo' and/or " . + "cc-memo '$cc_memo' does not exist"); + $ok = ''; + } + # Load the PDF. We only do this now so that we don't load it if there + # is nothing to extract. + if ($ok && ! $pdf) { + if (!access_in($pdf_file)) { + warning("Cannot open '$pdf_file'", ''); + endinput(); + } + # Temporarily disable error handling, so that we can catch the error + # ourselves. + $SIG{__DIE__} = undef; $SIG{__WARN__} = undef; + # All safe, |paranoia_in| was already called above. + eval { $pdf = $pdf_library->open($pdf_file, msgver => 0) }; + $SIG{__DIE__} = \&die_handler; $SIG{__WARN__} = \&warn_handler; + error("File '$pdf_file' seems corrupted. " . + "Perhaps you have to load Memoize earlier in the preamble", + "In particular, Memoize must be loaded before TikZ library " . + "'fadings' and any package deploying it, and in Beamer, " . + "load Memoize by writing \\RequirePackage{memoize} before " . + "\\documentclass{beamer}. " . + "This was the error thrown by Perl:" . "\n$@") if $@; + } + # Does the page exist? + if ($ok && $page > (my $n_pages = $pdf->page_count())) { + error("I cannot extract page $page from '$pdf_file', " . + "as it contains only $n_pages page" . + ($n_pages > 1 ? 's' : ''), ''); + } + if ($ok) { + # Import the page into the extern PDF (no disk access yet). + my $extern = $pdf_library->new(outver => $pdf->version); + $extern->import_page($pdf, $page); + my $extern_page = $extern->open_page(1); + # Check whether the page size matches the |.mmz| expectations. + my ($x0, $y0, $x1, $y1) = $extern_page->get_mediabox(); + my $width_pt = ($x1 - $x0) / 72 * 72.27; + my $height_pt = ($y1 - $y0) / 72 * 72.27; + my $expected_width_pt = $m_ne{expected_width}; + my $expected_height_pt = $m_ne{expected_height}; + if ((abs($width_pt - $expected_width_pt) > $tolerance + || abs($height_pt - $expected_height_pt) > $tolerance) && !$force) { + warning("I refuse to extract page $page from $pdf_file, " . + "because its size (${width_pt}pt x ${height_pt}pt) " . + "is not what I expected " . + "(${expected_width_pt}pt x ${expected_height_pt}pt)"); + } else { + # All tests were successful, let's create the extern file. + # First, the containing directory, if necessary. + if ($dir_to_make) { + make_directory($dir_to_make); + $dir_to_make = undef; + } + # Now the extern file. Note that |paranoia_out| was already + # called above. + info("Page $page --> $extern_file_out"); + $extern->saveas($extern_file_out); + # This page will get pruned. + $extern_pages{$page} = 1 if $prune; + # Comment out this |\mmzNewExtern|. + $new_mmz .= '%' unless $keep; + } + } } - $pruned_pdf->save($pdf_file->stringify); - print("${message_prefix}The following extern pages were pruned out of the PDF: ", - join(",", sort(keys(%extern_pages))) . "\n") unless $quiet; + $new_mmz .= $mmz_line unless $keep; + stderr_to_warning(); } +close(MMZ); +$indent = ''; +$texindent = ''; +info($done_message); -if ($log) { - print LOG "\\endinput\n"; - close LOG; +# Write out the |.mmz| file with |\mmzNewExtern| lines commented out. (All safe, +# |paranoia_out| was already called above.) +if (!$keep) { + open(MMZ, ">", $mmz_file); + print MMZ $new_mmz; + close(MMZ); } + +# Remove the extracted pages from the original PDF. (All safe, |paranoia_out| +# was already called above.) +if ($prune and keys(%extern_pages) != 0) { + my $pruned_pdf = $pdf_library->new(); + for (my $n = 1; $n <= $pdf->page_count(); $n++) { + if (! $extern_pages{$n}) { + $pruned_pdf->import_page($pdf, $n); + } + } + $pruned_pdf->save($pdf_file); + info("The following extern pages were pruned out of the PDF: " . + join(",", sort(keys(%extern_pages)))); +} + +endinput(); + +# Local Variables: +# fill-column: 79 +# after-save-hook: pl2dtx +# End: |