From 1598205ade1602e324b7fd8e5410d1389eae7416 Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Thu, 12 Oct 2023 03:04:15 +0000 Subject: CTAN sync 202310120304 --- macros/generic/memoize/memoize-extract.pl | 205 ++++++++++++++++++++++++++++++ 1 file changed, 205 insertions(+) create mode 100755 macros/generic/memoize/memoize-extract.pl (limited to 'macros/generic/memoize/memoize-extract.pl') diff --git a/macros/generic/memoize/memoize-extract.pl b/macros/generic/memoize/memoize-extract.pl new file mode 100755 index 0000000000..8fba3d356f --- /dev/null +++ b/macros/generic/memoize/memoize-extract.pl @@ -0,0 +1,205 @@ +#!/usr/bin/env perl + +# This file is a part of Memoize, a TeX package for externalization of +# graphics and memoization of compilation results in general, available at +# https://ctan.org/pkg/memoize and https://github.com/sasozivanovic/memoize. +# +# Copyright (c) 2020- Saso Zivanovic +# +# 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. The latest version of this license is in +# https://www.latex-project.org/lppl.txt and version 1.3c or later is part of +# all distributions of LaTeX version 2008 or later. +# +# This work has the LPPL maintenance status `maintained'. +# The Current Maintainer of this work is Saso Zivanovic. +# +# The files belonging to this work and covered by LPPL are listed in +# /doc/generic/memoize/FILES. + +use strict; +use Getopt::Long; +use Path::Class; +use File::Spec; +use File::Basename; +use PDF::API2; + +my $VERSION = '2023/10/10 v1.0.0'; + +my $usage = "usage: memoize-extract.pl [-h] [--pdf PDF] [--prune] [--keep] [--force] [--log LOG] [--warning-template WARNING_TEMPLATE] [--quiet] [--mkdir] mmz\n"; +my $Help = < \$pdf_arg, + "keep|k" => \$keep, + "prune|p" => \$prune, + "log|l=s" => \$log, + "quiet|q" => \$quiet, + "embedded|e" => \$embedded, + "force|f" => \$force, + "warning-template|w=s" => \$warning_template, + "mkdir|m" => \$mkdir, + "help|h|?" => \$help, + "version|V" => \$print_version, + ) 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); + +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; +} + +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); +} + +my $mmz_arg = $ARGV[0]; +my $mmz_file = file($mmz_arg); +my $mmz_dir = $mmz_file->parent; + +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$/; +} + +# 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; + +if ($log) { + paranoia(file($log)); + open LOG, ">$log"; +} else { + *LOG = *STDERR; +} + +my ($pdf, %extern_pages); +print "${message_prefix}Extracting externs from $pdf_file:\n" unless $quiet; + +my $tolerance = 0.01; +my $done_message = "${message_prefix}Done (there was nothing to extract).\n"; + +while (<>) { + if (/^\\mmzNewExtern *{(?P(?P.*?)(?P[0-9A-F]{32})-(?P[0-9A-F]{32})(?:-[0-9]+)?.pdf)}{(?P[0-9]+)}{(?P[0-9.]*)pt}{(?P[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); + } + } + $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; +} + +if ($log) { + print LOG "\\endinput\n"; + close LOG; +} -- cgit v1.2.3