summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/scripts/memoize/memoize-extract.pl
diff options
context:
space:
mode:
Diffstat (limited to 'Master/texmf-dist/scripts/memoize/memoize-extract.pl')
-rwxr-xr-xMaster/texmf-dist/scripts/memoize/memoize-extract.pl859
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: