From e0c6872cf40896c7be36b11dcc744620f10adf1d Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Mon, 2 Sep 2019 13:46:59 +0900 Subject: Initial commit --- support/pdfcrop/pdfcrop.pl | 1213 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1213 insertions(+) create mode 100755 support/pdfcrop/pdfcrop.pl (limited to 'support/pdfcrop/pdfcrop.pl') diff --git a/support/pdfcrop/pdfcrop.pl b/support/pdfcrop/pdfcrop.pl new file mode 100755 index 0000000000..b7662c15f2 --- /dev/null +++ b/support/pdfcrop/pdfcrop.pl @@ -0,0 +1,1213 @@ +#!/usr/bin/env perl +use strict; +$^W=1; # turn warning on +# +# pdfcrop.pl +# +# Copyright (C) 2002, 2004, 2005, 2008-2012 Heiko Oberdiek. +# +# This program may be distributed and/or modified under the +# conditions of the LaTeX Project Public License, either version 1.2 +# of this license or (at your option) any later version. +# The latest version of this license is in +# http://www.latex-project.org/lppl.txt +# and version 1.2 or later is part of all distributions of LaTeX +# version 1999/12/01 or later. +# +# See file "README" for a list of files that belong to this project. +# +# This file "pdfcrop.pl" may be renamed to "pdfcrop" +# for installation purposes. +# +my $prj = 'pdfcrop'; +my $file = "$prj.pl"; +my $program = uc($&) if $file =~ /^\w+/; +my $version = "1.38"; +my $date = "2012/11/02"; +my $author = "Heiko Oberdiek"; +my $copyright = "Copyright (c) 2002-2012 by $author."; +# +# Reqirements: Perl5, Ghostscript +# History: +# 2002/10/30 v1.0: First release. +# 2002/10/30 v1.1: Option --hires added. +# 2002/11/04 v1.2: "nul" instead of "/dev/null" for windows. +# 2002/11/23 v1.3: Use of File::Spec module's "devnull" call. +# 2002/11/29 v1.4: Option --papersize added. +# 2004/06/24 v1.5: Clear map file entries so that pdfTeX +# does not touch the fonts. +# 2004/06/26 v1.6: Use mgs.exe instead of gswin32c.exe for MIKTEX. +# 2005/03/11 v1.7: Support of spaces in file names +# (open("-|") is used for ghostscript call). +# 2008/01/09 v1.8: Fix for moving the temporary file to the output +# file across file system boundaries. +# 2008/04/05 v1.9: Options --resolution and --bbox added. +# 2008/07/16 v1.10: Support for XeTeX added with new options +# --pdftex, --xetex, and --xetexcmd. +# 2008/07/22 v1.11: Workaround for open("-|"). +# 2008/07/23 v1.12: Workarounds for the workaround (error detection, ...). +# 2008/07/24 v1.13: open("-|")/workaround removed. +# Input files with unsafe file names are linked/copied +# to temporary file with safe file name. +# 2008/09/12 v1.14: Error detection for invalid Bounding Boxes. +# 2009/07/14 v1.15: Fix for negative coordinates in Bounding Boxes +# (David Menestrina). +# 2009/07/16 v1.16: Security fixes: +# * -dSAFER added for Ghostscript, +# * -no-shell-escape added for pdfTeX/XeTeX. +# 2009/07/17 v1.17: Security fixes: +# * Backticks and whitespace are forbidden +# for options --(gs|pdftex|xetex)cmd. +# * Validation of options --papersize and --resolution. +# 2009/07/18 v1.18: * Restricted mode added. +# * Option --version added. +# 2009/09/24 v1.19: * Ghostscript detection rewritten. +# * Cygwin: `gs' is preferred to `gswin32c'. +# 2009/10/06 v1.20: * File name sanitizing in .tex file. +# 2009/12/21 v1.21: * Option --ini added for IniTeX mode. +# * Option --luatex and --luatexcmd added for LuaTeX. +# 2009/12/29 v1.22: * Syntax description for option --bbox fixed +# (Lukas Prochazka). +# 2010/01/09 v1.23: * Options --bbox-odd and -bbox-even added. +# 2010/08/16 v1.24: * Workaround added for buggy ghostscript ports +# that print the BoundingBox data twice. +# 2010/08/26 v1.25: * Fix for the case that the PDF file contains +# an entry /CropBox different to /MediaBox. +# * \pageinclude implemented for XeTeX. +# * XeTeX: --clip does not die, but this option +# is ignored, because XeTeX always clip. +# 2010/08/26 v1.26: * XeTeX's \XeTeXpdffile expects keyword +# `media', not `mediabox'. +# * New option --pdfversion. +# Default is `auto' that means the PDF version +# is inherited from the input file. Before +# pdfcrop has used the TeX engine's default. +# * Option --luatex fixed (extra empty page at end). +# 2010/09/03 v1.27: * Workaround of v1.24 fixed. +# 2010/09/06 v1.28: * The Windows registry is searched if Ghostscript +# is not found via PATH. +# * Windows only: support of spaces in command +# names in unrestricted mode. +# 2010/09/06 v1.29: * Find the latest Ghostscript version in registry. +# 2010/09/15 v1.30: * Warning of pdfTeX because of \pdfobjcompresslevel +# avoided when reducing \pdfminorversion. +# * Fix for TeX syntax characters in input file names. +# 2010/09/17 v1.31: * Passing the input file name via hex string to TeX. +# * Again input file names restricted for Ghostscript +# command line, switch then to symbol link/copy +# method. +# 2011/08/10 v1.32: * Detection for gswin64c.exe added. +# 2012/02/01 v1.33: * Input file can be `-' (standard input). +# 2012/04/18 v1.34: * Format of --version changed +# from naked version number to a line with +# program name, date and version. +# 2012/10/15 v1.35: * Additional debug infos added for Perl version. +# 2012/10/16 v1.36: * More error codes added. +# 2012/10/16 v1.37: * Extended error messages if available. +# * Fix for broken v1.36. +# 2012/11/02 v1.38: * Fix for unsufficient cleanup, if function `cleanup' is +# prematurely called in `eval' for `symlink' checking. + +### program identification +my $title = "$program $version, $date - $copyright\n"; + +### error strings +my $Error = "!!! Error:"; # error prefix + +### make ENV safer +delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; + +# Windows detection (no SIGHUP) +my $Win = 0; +$Win = 1 if $^O =~ /mswin32/i; +$Win = 1 if $^O =~ /cygwin/i; +use Config; +my $archname = $Config{'archname'}; +$archname = 'unknown' unless defined $Config{'archname'}; + +### extended error messages +sub exterr () { + chomp(my $msg_errno = $!); + chomp(my $msg_extended_os_error = $^E); + if ($msg_errno eq $msg_extended_os_error) { + $msg_errno; + } + else { + "$msg_errno/$msg_extended_os_error"; + } +} + +### string constants for Ghostscript run +# get Ghostscript command name +$::opt_gscmd = ''; +sub find_ghostscript () { + return if $::opt_gscmd; + if ($::opt_debug) { + print "* Perl executable: $^X\n"; + if ($] < 5.006) { + print "* Perl version: $]\n"; + } + else { + printf "* Perl version: v%vd\n", $^V; + } + if (defined &ActivePerl::BUILD) { + printf "* Perl product: ActivePerl, build %s\n", ActivePerl::BUILD(); + } + use Config; + printf "* Pointer size: $Config{'ptrsize'}\n"; + printf "* Pipe support: %s\n", + (defined($Config{'d_pipe'}) ? 'yes' : 'no'); + printf "* Fork support: %s\n", + (defined($Config{'d_fork'}) ? 'yes' : 'no'); + } + my $system = 'unix'; + $system = "dos" if $^O =~ /dos/i; + $system = "os2" if $^O =~ /os2/i; + $system = "win" if $^O =~ /mswin32/i; + $system = "cygwin" if $^O =~ /cygwin/i; + $system = "miktex" if defined($ENV{"TEXSYSTEM"}) and + $ENV{"TEXSYSTEM"} =~ /miktex/i; + print "* OS name: $^O\n" if $::opt_debug; + print "* Arch name: $archname\n" if $::opt_debug; + print "* System: $system\n" if $::opt_debug; + my %candidates = ( + 'unix' => [qw|gs gsc|], + 'dos' => [qw|gs386 gs|], + 'os2' => [qw|gsos2 gs|], + 'win' => [qw|gswin32c gs|], + 'cygwin' => [qw|gs gswin32c|], + 'miktex' => [qw|mgs gswin32c gs|] + ); + if ($system eq 'win' or $system eq 'cygwin' or $system eq 'miktex') { + if ($archname =~ /mswin32-x64/i) { + my @a = (); + foreach my $name (@{$candidates{$system}}) { + push @a, 'gswin64c' if $name eq 'gswin32c'; + push @a, $name; + } + $candidates{$system} = \@a; + } + } + my %ext = ( + 'unix' => '', + 'dos' => '.exe', + 'os2' => '.exe', + 'win' => '.exe', + 'cygwin' => '.exe', + 'miktex' => '.exe' + ); + my $candidates_ref = $candidates{$system}; + my $ext = $Config{'_exe'}; + $ext = $ext{$system} unless defined $ext; + use File::Spec; + my @path = File::Spec->path(); + my $found = 0; + foreach my $candidate (@$candidates_ref) { + foreach my $dir (@path) { + my $file = File::Spec->catfile($dir, "$candidate$ext"); + if (-x $file) { + $::opt_gscmd = $candidate; + $found = 1; + print "* Found ($candidate): $file\n" if $::opt_debug; + last; + } + print "* Not found ($candidate): $file\n" if $::opt_debug; + } + last if $found; + } + if (not $found and $Win) { + $found = SearchRegistry(); + } + if ($found) { + print "* Autodetected ghostscript command: $::opt_gscmd\n" if $::opt_debug; + } + else { + $::opt_gscmd = $$candidates_ref[0]; + print "* Default ghostscript command: $::opt_gscmd\n" if $::opt_debug; + } +} + +sub SearchRegistry () { + my $found = 0; + eval 'use Win32::TieRegistry qw|KEY_READ REG_SZ|;'; + if ($@) { + if ($::opt_debug) { + print "* Registry lookup for Ghostscript failed:\n"; + my $msg = $@; + $msg =~ s/\s+$//; + foreach (split /\r?\n/, $msg) { + print " $_\n"; + } + } + return $found; + } + my $open_params = {Access => KEY_READ(), Delimiter => '/'}; + my $key_name_software = 'HKEY_LOCAL_MACHINE/SOFTWARE/'; + my $current_key = $key_name_software; + my $software = new Win32::TieRegistry $current_key, $open_params; + if (not $software) { + print "* Cannot find or access registry key `$current_key'!\n" + if $::opt_verbose; + return $found; + } + print "* Search registry at `$current_key'.\n" if $::opt_debug; + my %list; + foreach my $key_name_gs (grep /Ghostscript/i, $software->SubKeyNames()) { + $current_key = "$key_name_software$key_name_gs/"; + print "* Registry entry found: $current_key\n" if $::opt_debug; + my $key_gs = $software->Open($key_name_gs, $open_params); + if (not $key_gs) { + print "* Cannot open registry key `$current_key'!\n" if $::opt_debug; + next; + } + foreach my $key_name_version ($key_gs->SubKeyNames()) { + $current_key = "$key_name_software$key_name_gs/$key_name_version/"; + print "* Registry entry found: $current_key\n" if $::opt_debug; + if (not $key_name_version =~ /^(\d+)\.(\d+)$/) { + print " The sub key is not a version number!\n" if $::opt_debug; + next; + } + my $version_main = $1; + my $version_sub = $2; + $current_key = "$key_name_software$key_name_gs/$key_name_version/"; + my $key_version = $key_gs->Open($key_name_version, $open_params); + if (not $key_version) { + print "* Cannot open registry key `$current_key'!\n" if $::opt_debug; + next; + } + $key_version->FixSzNulls(1); + my ($value, $type) = $key_version->GetValue('GS_DLL'); + if ($value and $type == REG_SZ()) { + print " GS_DLL = $value\n" if $::opt_debug; + $value =~ s|([\\/])([^\\/]+\.dll)$|$1gswin32c.exe|i; + my $value64 = $value; + $value64 =~ s/gswin32c\.exe$/gswin64c.exe/; + if ($archname =~ /mswin32-x64/i and -f $value64) { + $value = $value64; + } + if (-f $value) { + print " EXE found: $value\n" if $::opt_debug; + } + else { + print " EXE not found!\n" if $::opt_debug; + next; + } + my $sortkey = sprintf '%02d.%03d %s', + $version_main, $version_sub, $key_name_gs; + $list{$sortkey} = $value; + } + else { + print " Missing key `GS_DLL' with type `REG_SZ'!\n" if $::opt_debug; + } + } + } + foreach my $entry (reverse sort keys %list) { + $::opt_gscmd = $list{$entry}; + print "* Found (via registry): $::opt_gscmd\n" if $::opt_debug; + $found = 1; + last; + } + return $found; +} + +# restricted mode +my $restricted = 0; +if ($0 =~ /rpdfcrop/ or $0 =~ /restricted/) { + $restricted = 1; +} + +# "null" device +use File::Spec::Functions qw(devnull); +my $null = devnull(); + +### variables +my $inputfile = ""; +my $outputfile = ""; +my $tmp = "tmp-\L$program\E-$$"; + +### paper sizes + +my @papersizes = qw[ + 11x17 ledger legal letter lettersmall + archE archD archC archB archA + a0 a1 a2 a3 a4 a4small a5 a6 a7 a8 a9 a10 + isob0 isob1 isob2 isob3 isob4 isob5 isob6 + c0 c1 c2 c3 c4 c5 c6 + jisb0 jisb1 jisb2 jisb3 jisb4 jisb5 jisb6 + b0 b1 b2 b3 b4 b5 + flsa flse halfletter +]; +my %papersizes; +foreach (@papersizes) { + $papersizes{$_} = 1; +} + +### option variables +my @bool = ("false", "true"); +$::opt_version = 0; +$::opt_help = 0; +$::opt_debug = 0; +$::opt_verbose = 0; +$::opt_pdftexcmd = "pdftex"; +$::opt_xetexcmd = "xetex"; +$::opt_luatexcmd = "luatex"; +$::opt_tex = "pdftex"; +$::opt_margins = "0 0 0 0"; +$::opt_clip = 0; +$::opt_hires = 0; +$::opt_papersize = ""; +$::opt_resolution = ""; +$::opt_bbox = ""; +$::opt_bbox_odd = ""; +$::opt_bbox_even = ""; +$::opt_initex = 0; +$::opt_pdfversion = "auto"; + +sub usage ($) { + my $ret = shift; + find_ghostscript(); + my $usage = <<"END_OF_USAGE"; +${title}Syntax: \L$program\E [options] [output file] +Function: Margins are calculated and removed for each page in the file. +Options: (defaults:) + --help print usage + --version print version number + --(no)verbose verbose printing ($bool[$::opt_verbose]) + --(no)debug debug informations ($bool[$::opt_debug]) + --gscmd call of ghostscript ($::opt_gscmd) + --pdftex | --xetex | --luatex + use pdfTeX | use XeTeX | use LuaTeX ($::opt_tex) + --pdftexcmd call of pdfTeX ($::opt_pdftexcmd) + --xetexcmd call of XeTeX ($::opt_xetexcmd) + --luatexcmd call of LuaTeX ($::opt_luatexcmd) + --margins " " ($::opt_margins) + add extra margins, unit is bp. If only one number is + given, then it is used for all margins, in the case + of two numbers they are also used for right and bottom. + --(no)clip clipping support, if margins are set ($bool[$::opt_clip]) + (not available for --xetex) + --(no)hires using `%%HiResBoundingBox' ($bool[$::opt_hires]) + instead of `%%BoundingBox' + --(no)ini use iniTeX variant of the TeX compiler ($bool[$::opt_initex]) +Expert options: + --restricted turn on restricted mode ($bool[$restricted]) + --papersize parameter for gs's -sPAPERSIZE=, + use only with older gs versions <7.32 ($::opt_papersize) + --resolution x ($::opt_resolution) + --resolution pass argument to ghostscript's option -r + Example: --resolution 72 + --bbox " " ($::opt_bbox) + override bounding box found by ghostscript + with origin at the lower left corner + --bbox-odd Same as --bbox, but for odd pages only ($::opt_bbox_odd) + --bbox-even Same as --bbox, but for even pages only ($::opt_bbox_even) + --pdfversion <1.x> | auto | none + Set the PDF version to 1.x, 1 < x < 8. + If `auto' is given as value, then the + PDF version is taken from the header + of the input PDF file. + An empty value or `none' uses the + default of the TeX engine. ($::opt_pdfversion) + +Input file: If the name is `-', then the standard input is used and + the output file name must be explicitly given. +Examples: + \L$program\E --margins 10 input.pdf output.pdf + \L$program\E --margins '5 10 5 20' --clip input.pdf output.pdf +In case of errors: + Try option --verbose first to get more information. +In case of bugs: + Please, use option --debug for bug reports. +END_OF_USAGE + if ($ret) { + die $usage; + } + else { + print $usage; + exit(0); + } +} + +### process options +my @OrgArgv = @ARGV; +use Getopt::Long; +GetOptions( + "help!", + "version!", + "debug!", + "verbose!", + "gscmd=s", + "pdftexcmd=s", + "xetexcmd=s", + "luatexcmd=s", + "pdftex" => sub { $::opt_tex = 'pdftex'; }, + "xetex" => sub { $::opt_tex = 'xetex'; }, + "luatex" => sub { $::opt_tex = 'luatex'; }, + "initex!", + "margins=s", + "clip!", + "hires!", + "papersize=s", + "resolution=s", + "bbox=s", + "bbox-odd=s" => \$::opt_bbox_odd, + "bbox-even=s" => \$::opt_bbox_even, + "restricted" => sub { $restricted = 1; }, + "pdfversion=s" => \$::opt_pdfversion, +) or usage(1); +!$::opt_help or usage(0); + +if ($::opt_version) { + print "$prj $date v$version\n"; + exit(0); +} + +$::opt_verbose = 1 if $::opt_debug; + +@ARGV >= 1 or usage(1); + +print $title; + +print "* Restricted mode: ", ($restricted ? "enabled" : "disabled"), "\n" + if $::opt_debug; + +$::opt_pdfversion =~ /^(|none|auto|1\.([2-7]))$/ + or die "!!! Error: Invalid value `$::opt_pdfversion' for option `--pdfversion'!\n"; +print "* Option `pdfversion': $::opt_pdfversion\n" if $::opt_debug; +$::opt_pdfversion = $2 if $2; +$::opt_pdfversion = '' if $::opt_pdfversion eq 'none'; + +find_ghostscript(); + +if ($::opt_bbox) { + $::opt_bbox =~ s/^\s+//; + $::opt_bbox =~ s/\s+$//; + $::opt_bbox =~ s/\s+/ /; + if ($::opt_bbox =~ /^-?\d*\.?\d+ -?\d*\.?\d+ -?\d*\.?\d+ -?\d*\.?\d+$/) { + print "* Explicite Bounding Box: $::opt_bbox\n" if $::opt_debug; + } + else { + die "$Error Parse error (option --bbox \"$::opt_bbox\")!\n"; + } +} +if ($::opt_bbox_odd) { + $::opt_bbox_odd =~ s/^\s+//; + $::opt_bbox_odd =~ s/\s+$//; + $::opt_bbox_odd =~ s/\s+/ /; + if ($::opt_bbox_odd =~ /^-?\d*\.?\d+ -?\d*\.?\d+ -?\d*\.?\d+ -?\d*\.?\d+$/) { + print "* Explicite Bounding Box for odd pages: $::opt_bbox_odd\n" + if $::opt_debug; + } + else { + die "$Error Parse error (option --bbox-odd \"$::opt_bbox_odd\")!\n"; + } +} +if ($::opt_bbox_even) { + $::opt_bbox_even =~ s/^\s+//; + $::opt_bbox_even =~ s/\s+$//; + $::opt_bbox_even =~ s/\s+/ /; + if ($::opt_bbox_even =~ /^-?\d*\.?\d+ -?\d*\.?\d+ -?\d*\.?\d+ -?\d*\.?\d+$/) { + print "* Explicite Bounding Box for even pages: $::opt_bbox_even\n" + if $::opt_debug; + } + else { + die "$Error Parse error (option --bbox-even \"$::opt_bbox_even\")!\n"; + } +} + +@ARGV <= 2 or die "$Error Too many files!\n"; + +### input file +$inputfile = shift @ARGV; + +if ($inputfile eq '-') { + @ARGV == 1 or die "$Error Missing output file name!\n"; + print "* Input file: \n" if $::opt_debug; +} +else { + if (! -f $inputfile) { + if (-f "$inputfile.pdf") { + $inputfile .= ".pdf"; + } + else { + die "$Error Input file `$inputfile' not found!\n"; + } + } + print "* Input file: $inputfile\n" if $::opt_debug; +} + +### output file +if (@ARGV) { + $outputfile = shift @ARGV; +} +else { + $outputfile = $inputfile; + $outputfile =~ s/\.pdf$//i; + $outputfile .= "-crop.pdf"; +} + +print "* Output file: $outputfile\n" if $::opt_debug; + +### margins +my ($llx, $lly, $urx, $ury) = (0, 0, 0, 0); +if ($::opt_margins =~ + /^\s*([\-\.\d]+)\s+([\-\.\d]+)\s+([\-\.\d]+)\s+([\-\.\d]+)\s*$/) { + ($llx, $lly, $urx, $ury) = ($1, $2, $3, $4); +} +else { + if ($::opt_margins =~ /^\s*([\-\.\d]+)\s+([\-\.\d]+)\s*$/) { + ($llx, $lly, $urx, $ury) = ($1, $2, $1, $2); + } + else { + if ($::opt_margins =~ /^\s*([\-\.\d]+)\s*$/) { + ($llx, $lly, $urx, $ury) = ($1, $1, $1, $1); + } + else { + die "$Error Parse error (option --margins)!\n"; + } + } +} +print "* Margins: $llx $lly $urx $ury\n" if $::opt_debug; + +### papersize validation (security) +if ($::opt_papersize ne '') { + $::opt_papersize =~ /^[0-9A-Za-z]+$/ + or die "$Error Invalid papersize ($::opt_papersize)!\n"; + $papersizes{$::opt_papersize} + or die "$Error Unknown papersize ($::opt_papersize)," + . " see ghostscript's documentation for option `-r'!\n"; +} + +### resolution validation (security) +if ($::opt_resolution ne '') { + $::opt_resolution =~ /^\d+(x\d+)?$/ + or die "$Error Invalid resolution ($::opt_resolution)," + . " see ghostscript's documentation!\n"; +} + +### command name validation (security) +my %cmd = ( + 'gscmd' => \$::opt_gscmd, + 'pdftexcmd' => \$::opt_pdftexcmd, + 'luatexcmd' => \$::opt_luatexcmd, + 'xetexcmd' => \$::opt_xetexcmd +); +foreach my $cmd (keys %cmd) { + my $cmd_ref = $cmd{$cmd}; + $$cmd_ref =~ s/^\s+//; + $$cmd_ref =~ s/\s+$//; + my $val = $$cmd_ref; + next unless $val; + next unless $val; + if ($val =~ /`/) { + die "$Error Forbidden backtick for option `--$cmd' ($val)!\n"; + } + if ($val =~ /\s/) { + my $err = 0; + if ($restricted or not $Win) { + $err = 1; + } + else { + $err = 1 if $val =~ /\.exe.*\s/i; + $err = 1 if $val =~ /\s[-\/@+]/; + } + die "$Error Forbidden whitespace for option `--$cmd' ($val)!\n" if $err; + } +} +if ($restricted) { + if ($::opt_pdftexcmd and $::opt_pdftexcmd ne 'pdftex') { + die "$Error pdfTeX program name must not be changed in restricted mode!\n"; + } + if ($::opt_xetexcmd and $::opt_xetexcmd ne 'xetex') { + die "$Error XeTeX program name must not be changed in restricted mode!\n"; + } + if ($::opt_luatexcmd and $::opt_luatexcmd ne 'luatex') { + die "$Error LuaTeX program name must not be changed in restricted mode!\n"; + } + if ($::opt_gscmd) { + $::opt_gscmd =~ /^(gs|mgs|gswin32c|gs386|gsos2)$/ + or $::opt_gscmd =~ /^gs[\-_]?(\d|\d[\.-_]?\d\d)c?$/ + or die "$Error: Invalid Ghostscript program name in restricted mode!\n"; + } +} +if ($Win and $::opt_gscmd =~ /\s/) { + $::opt_gscmd = "\"$::opt_gscmd\""; +} + +### cleanup system +my @unlink_files = (); +my $exit_code = 1; +sub clean { + print "* Cleanup\n" if $::opt_debug; + if ($::opt_debug) { + print "* Temporary files: @unlink_files\n"; + } + else { + for (; @unlink_files>0; ) { + unlink shift @unlink_files; + } + } +} +sub cleanup { + clean(); + exit($exit_code); +} +$SIG{'INT'} = \&cleanup; +$SIG{'__DIE__'} = \&clean; + +### Calculation of BoundingBoxes + +# use safe file name for use within cmd line of gs (unknown shell: space, ...) +# and XeTeX (hash, curly braces, ...) +my $inputfilesafe = $inputfile; +if ($inputfile eq '-') { + $inputfilesafe = "$tmp-stdin.pdf"; + print "* Temporary input file: $inputfilesafe\n" if $::opt_debug; + push @unlink_files, $inputfilesafe; + open(OUT, '>', $inputfilesafe) + or die sprintf "$Error Cannot write `%s' (%s)!\n", + $inputfilesafe, exterr; + binmode(OUT); + my $size = 0; + my $len = 0; + my $buf = ''; + my $buf_size = 65536; + do { + $len = read STDIN, $buf, $buf_size; + if (not defined $len) { + my $msg = exterr; + die "$Error Reading standard input ($msg)!\n"; + } + print OUT $buf + or die sprintf "$Error Writing `%s` (%s)!\n", + $inputfilesafe, exterr; + $size += $len; + } + while ($len); + close(OUT); + print "* File size (STDIN): $size\n" if $::opt_debug; +} +elsif (not $inputfile =~ /^[\w\d\.\-\:\/@]+$/) { # /[\s\$~'"#{}%]/ + $inputfilesafe = "$tmp-img.pdf"; + push @unlink_files, $inputfilesafe; + my $symlink_exists = eval { + local $SIG{'__DIE__'}; + symlink("", ""); + 1; + }; + print "* Input file name `$inputfile' contains special characters.\n" + . "* " . ($symlink_exists ? "Link" : "Copy") + . " input file to temporary file `$inputfilesafe'.\n" + if $::opt_verbose; + if ($symlink_exists) { + symlink($inputfile, $inputfilesafe) + or die sprintf "$Error Link from `%s' to `%s' failed (%s)!\n", + $inputfile, $inputfilesafe, exterr; + } + else { + use File::Copy; + copy($inputfile, $inputfilesafe) + or die sprintf "$Error Copy from `%s' to `%s' failed (%s)\n", + $inputfile, $inputfilesafe, exterr; + } +} + +if ($::opt_pdfversion eq 'auto') { + open(IN, '<', $inputfilesafe) + or die sprintf "!!! Error: Cannot open `%s' (%s)!\n", + $inputfilesafe, exterr; + my $buf; + read(IN, $buf, 1024) + or die sprintf "!!! Error: Cannot read the header of `%s' failed (%s)!\n", + $inputfilesafe, exterr; + close(IN); + if ($buf =~ /%PDF-1.([0-7])\s/) { + $::opt_pdfversion = $1; + print "* PDF header: %PDF-1.$::opt_pdfversion\n" if $::opt_verbose; + $::opt_pdfversion = 2 if $::opt_pdfversion < 2; + } + else { + die "!!! Error: Cannot find PDF header of `$inputfilesafe'!\n"; + } +} +print '* Using PDF minor version: ', + ($::opt_pdfversion ? $::opt_pdfversion : "engine's default"), + "\n" if $::opt_debug; + +my @gsargs = ( + "-sDEVICE=bbox", + "-dBATCH", + "-dNOPAUSE" +); +push @gsargs, "-sPAPERSIZE=$::opt_papersize" if $::opt_papersize; +push @gsargs, "-r$::opt_resolution" if $::opt_resolution; +push @gsargs, + "-c", + "save", + "pop", + "-f", + $inputfilesafe +; + +my $tmpfile = "$tmp.tex"; +push @unlink_files, $tmpfile; +open(TMP, ">$tmpfile") + or die sprintf "$Error Cannot write tmp file `%s' (%s)!\n", + $tmpfile, exterr; +print TMP <<'END_TMP'; +\catcode37 14 % percent +\catcode33 12 % exclam +\catcode34 12 % quote +\catcode35 6 % hash +\catcode39 12 % apostrophe +\catcode40 12 % left parenthesis +\catcode41 12 % right parenthesis +\catcode45 12 % minus +\catcode46 12 % period +\catcode60 12 % less +\catcode61 12 % equals +\catcode62 12 % greater +\catcode64 12 % at +\catcode91 12 % left square +\catcode93 12 % right square +\catcode96 12 % back tick +\catcode123 1 % left curly brace +\catcode125 2 % right curly brace +\catcode126 12 % tilde +\catcode`\#=6 % +\escapechar=92 % +\def\IfUndefined#1#2#3{% + \begingroup\expandafter\expandafter\expandafter\endgroup + \expandafter\ifx\csname#1\endcsname\relax + #2% + \else + #3% + \fi +} +END_TMP +my $pdffilehex = unpack 'H*', $inputfilesafe; +$pdffilehex = "\U$pdffilehex\E"; +print TMP "\\def\\pdffilehex{$pdffilehex}\n"; +print TMP <<'END_TMP'; +\IfUndefined{pdfunescapehex}{% + \begingroup + \gdef\pdffile{}% + \def\do#1#2{% + \ifx\relax#2\relax + \ifx\relax#1\relax + \else + \errmessage{Invalid hex string, should not happen!}% + \fi + \else + \lccode`0="#1#2\relax + \lowercase{% + \xdef\pdffile{\pdffile0}% + }% + \expandafter\do + \fi + }% + \expandafter\do\pdffilehex\relax\relax + \endgroup +}{% + \edef\pdffile{\pdfunescapehex{\pdffilehex}}% +} +\immediate\write-1{Input file: \pdffile} +END_TMP +if ($::opt_tex eq 'luatex') { + print TMP <<'END_TMP'; +\begingroup\expandafter\expandafter\expandafter\endgroup +\expandafter\ifx\csname directlua\endcsname\relax + \errmessage{LuaTeX not found!}% +\else + \begingroup + \newlinechar=10 % + \endlinechar=\newlinechar % + \ifnum0% + \directlua{% + if tex.enableprimitives then + tex.enableprimitives('TEST', { + 'luatexversion', + 'pdfoutput', + 'pdfcompresslevel', + 'pdfhorigin', + 'pdfvorigin', + 'pdfpagewidth', + 'pdfpageheight', + 'pdfmapfile', + 'pdfximage', + 'pdflastximage', + 'pdfrefximage', + 'pdfminorversion', + 'pdfobjcompresslevel', + }) + tex.print('1') + end + }% + \ifx\TESTluatexversion\UnDeFiNeD\else 1\fi % + =11 % + \global\let\luatexversion\luatexversion % + \global\let\pdfoutput\TESTpdfoutput % + \global\let\pdfcompresslevel\TESTpdfcompresslevel % + \global\let\pdfhorigin\TESTpdfhorigin % + \global\let\pdfvorigin\TESTpdfvorigin % + \global\let\pdfpagewidth\TESTpdfpagewidth % + \global\let\pdfpageheight\TESTpdfpageheight % + \global\let\pdfmapfile\TESTpdfmapfile % + \global\let\pdfximage\TESTpdfximage % + \global\let\pdflastximage\TESTpdflastximage % + \global\let\pdfrefximage\TESTpdfrefximage % + \global\let\pdfminorversion\TESTpdfminorversion % + \global\let\pdfobjcompresslevel\TESTpdfobjcompresslevel % + \else % + \errmessage{% + Missing \string\luatexversion % + }% + \fi % + \endgroup % +\fi +END_TMP +} +if ($::opt_tex eq 'pdftex' or $::opt_tex eq 'luatex') { + print TMP <<'END_TMP_HEAD'; +\pdfoutput=1 % +\pdfcompresslevel=9 % +\csname pdfmapfile\endcsname{} +\def\setpdfversion#1{% + \IfUndefined{pdfobjcompresslevel}{% + }{% + \ifnum#1<5 % + \pdfobjcompresslevel=0 % + \else + \pdfobjcompresslevel=2 % + \fi + }% + \IfUndefined{pdfminorversion}{% + \IfUndefined{pdfoptionpdfminorversion}{% + }{% + \pdfoptionpdfminorversion=#1\relax + }% + }{% + \pdfminorversion=#1\relax + }% +} +\def\page #1 [#2 #3 #4 #5]{% + \count0=#1\relax + \setbox0=\hbox{% + \pdfximage page #1 mediabox{\pdffile}% + \pdfrefximage\pdflastximage + }% + \pdfhorigin=-#2bp\relax + \pdfvorigin=#3bp\relax + \pdfpagewidth=#4bp\relax + \advance\pdfpagewidth by -#2bp\relax + \pdfpageheight=#5bp\relax + \advance\pdfpageheight by -#3bp\relax + \ht0=\pdfpageheight + \shipout\box0\relax +} +\def\pageclip #1 [#2 #3 #4 #5][#6 #7 #8 #9]{% + \count0=#1\relax + \dimen0=#4bp\relax \advance\dimen0 by -#2bp\relax + \edef\imagewidth{\the\dimen0}% + \dimen0=#5bp\relax \advance\dimen0 by -#3bp\relax + \edef\imageheight{\the\dimen0}% + \pdfximage page #1 mediabox{\pdffile}% + \setbox0=\hbox{% + \kern -#2bp\relax + \lower #3bp\hbox{\pdfrefximage\pdflastximage}% + }% + \wd0=\imagewidth\relax + \ht0=\imageheight\relax + \dp0=0pt\relax + \pdfhorigin=#6pt\relax + \pdfvorigin=#7bp\relax + \pdfpagewidth=\imagewidth + \advance\pdfpagewidth by #6bp\relax + \advance\pdfpagewidth by #8bp\relax + \pdfpageheight=\imageheight\relax + \advance\pdfpageheight by #7bp\relax + \advance\pdfpageheight by #9bp\relax + \pdfxform0\relax + \shipout\hbox{\pdfrefxform\pdflastxform}% +}% +\def\pageinclude#1{% + \pdfhorigin=0pt\relax + \pdfvorigin=0pt\relax + \pdfximage page #1 mediabox{\pdffile}% + \setbox0=\hbox{\pdfrefximage\pdflastximage}% + \pdfpagewidth=\wd0\relax + \pdfpageheight=\ht0\relax + \advance\pdfpageheight by \dp0\relax + \shipout\hbox{% + \raise\dp0\box0\relax + }% +} +END_TMP_HEAD + print TMP "\\setpdfversion{$::opt_pdfversion}\n" if $::opt_pdfversion; +} +else { # XeTeX + print TMP <<'END_TMP_HEAD'; +\expandafter\ifx\csname XeTeXpdffile\endcsname\relax + \errmessage{XeTeX not found or too old!}% +\fi +\def\page #1 [#2 #3 #4 #5]{% + \count0=#1\relax + \setbox0=\hbox{% + \XeTeXpdffile "\pdffile" page #1 media\relax + }% + \pdfpagewidth=#4bp\relax + \advance\pdfpagewidth by -#2bp\relax + \pdfpageheight=#5bp\relax + \advance\pdfpageheight by -#3bp\relax + \shipout\hbox{% + \kern-1in% + \kern-#2bp% + \vbox{% + \kern-1in% + \kern#3bp% + \ht0=\pdfpageheight + \box0 % + }% + }% +} +\def\pageclip #1 [#2 #3 #4 #5][#6 #7 #8 #9]{% + \page {#1} [#2 #3 #4 #5]% +} +\def\pageinclude#1{% + \setbox0=\hbox{% + \XeTeXpdffile "\pdffile" page #1 media\relax + }% + \pdfpagewidth=\wd0\relax + \pdfpageheight=\ht0\relax + \advance\pdfpageheight by \dp0\relax + \shipout\hbox{% + \kern-1in% + \vbox{% + \kern-1in% + \ht0=\pdfpageheight + \box0 % + }% + }% +} +END_TMP_HEAD +} + +print "* Running ghostscript for BoundingBox calculation ...\n" + if $::opt_verbose; +print "* Ghostscript call: $::opt_gscmd @gsargs\n" if $::opt_debug; + +my @bbox; +my @bbox_all; +my @bbox_odd; +my @bbox_even; +if ($::opt_bbox) { + $::opt_bbox =~ /([-\d\.]+) ([-\d\.]+) ([-\d\.]+) ([-\d\.]+)/; + @bbox_all = ($1, $2, $3, $4); +} +if ($::opt_bbox_odd) { + $::opt_bbox_odd =~ /([-\d\.]+) ([-\d\.]+) ([-\d\.]+) ([-\d\.]+)/; + @bbox_odd = ($1, $2, $3, $4); +} +if ($::opt_bbox_even) { + $::opt_bbox_even =~ /([-\d\.]+) ([-\d\.]+) ([-\d\.]+) ([-\d\.]+)/; + @bbox_even = ($1, $2, $3, $4); +} + +sub getbbox ($$$$$) { + my $page = shift; + my $a = shift; + my $b = shift; + my $c = shift; + my $d = shift; + if ($page % 2 == 1) { + if ($::opt_bbox_odd) { + return @bbox_odd; + } + } + else { + if ($::opt_bbox_even) { + return @bbox_even; + } + } + if ($::opt_bbox) { + return @bbox_all; + } + return ($a, $b, $c, $d); +} +my $page = 0; +my $gs_pipe = "$::opt_gscmd -dSAFER @gsargs 2>&1"; +$gs_pipe .= " 1>$null" unless $::opt_verbose; +$gs_pipe .= " |"; + +open(GS, $gs_pipe) + or die sprintf "$Error Cannot call ghostscript `%s' (%s)!\n", + $::opt_gscmd, exterr; +my $bb = ($::opt_hires) ? "%%HiResBoundingBox" : "%%BoundingBox"; +my $previous_line = 'Previous line'; +# Ghostscript workaround for buggy ports that prints +# the bounding box data twice on STDERR. +while () { + print $_ if $::opt_verbose; + if (/^$bb:\s*(-?[\.\d]+) (-?[\.\d]+) (-?[\.\d]+) (-?[\.\d]+)/o) { + } + else { + $previous_line = $_; + next; + } + next if $previous_line eq $_; + $previous_line = $_; + $page++; + @bbox = getbbox($page, $1, $2, $3, $4); + + my $empty = 0; + $empty = 1 if $bbox[0] >= $bbox[2]; + $empty = 1 if $bbox[1] >= $bbox[3]; + if ($empty) { + print <<"END_WARNING"; + +!!! Warning: Empty Bounding Box is returned by Ghostscript! +!!! Page $page: @bbox +!!! Either there is a problem with the page or with Ghostscript. +!!! Recovery is tried by embedding the page in its original size. + +END_WARNING + print TMP "\\pageinclude{$page}\n"; + next; + } + + print "* Page $page: @bbox\n" if $::opt_verbose; + + my @bb = ($bbox[0] - $llx, $bbox[1] - $ury, + $bbox[2] + $urx, $bbox[3] + $lly); + + $empty = 0; + $empty = 1 if $bb[0] >= $bb[2]; + $empty = 1 if $bb[1] >= $bb[3]; + if ($empty) { + print <<"END_WARNING"; + +!!! Warning: The final Bounding Box is empty! +!!! Page: $page: @bb +!!! Probably caused by too large negative margin values. +!!! Recovery by ignoring margin values. + +END_WARNING + print TMP "\\page $page [@bbox]\n"; + # clipping shouldn't make a difference + next; + } + if ($::opt_clip) { + print TMP "\\pageclip $page [@bbox][$llx $lly $urx $ury]\n"; + } + else { + print TMP "\\page $page [@bb]\n"; + } +} +close(GS); + +if ($? == -1) { + die sprintf "$Error Ghostscript failed to execute (%s)!\n", + exterr; +} +elsif ($? & 127) { + die sprintf "$Error Ghostscript died with signal %d!\n", + ($? & 127); +} +elsif ($? != 0) { + die sprintf "$Error Ghostscript exited with error code %d!\n", + $? >> 8; +} + +print TMP "\\csname \@\@end\\endcsname\n\\end\n"; +close(TMP); + +if ($page == 0) { + die "$Error Ghostscript does not report bounding boxes!\n"; +} + +### Run pdfTeX/XeTeX + +push @unlink_files, "$tmp.log"; +my $cmd; +my $texname; +if ($::opt_tex eq 'pdftex') { + $cmd = $::opt_pdftexcmd; + $texname = 'pdfTeX'; +} +elsif ($::opt_tex eq 'luatex') { + $cmd = $::opt_luatexcmd; + $texname = 'LuaTeX'; +} +else { + $cmd = $::opt_xetexcmd; + $texname = 'XeTeX'; +} +$cmd = "\"$cmd\"" if $Win and $cmd =~ /\s/; +$cmd .= ' -no-shell-escape'; +if ($::opt_initex) { + $cmd .= ' --ini --etex'; +} +if ($::opt_verbose) { + $cmd .= " -interaction=nonstopmode $tmp"; +} +else { + $cmd .= " -interaction=batchmode $tmp"; +} +print "* Running $texname ...\n" if $::opt_verbose; +print "* $texname call: $cmd\n" if $::opt_debug; +if ($::opt_verbose) { + system($cmd); +} +else { + `$cmd`; +} +if ($? == -1) { + die sprintf "$Error %s run failed to execute (%s)!\n", + $texname, exterr; +} +elsif ($? & 127) { + die sprintf "$Error %s run died with signal %d!\n", + $texname, ($? & 127); +} +elsif ($? != 0) { + die sprintf "$Error %s run failed with value %d!\n", + $texname, ($? >> 8); +} + +### Check pdf version of temp file +if ($::opt_pdfversion) { + open(PDF, '+<', "$tmp.pdf") + or die sprintf "!!! Error: Cannot open `%s' (%s)!\n", + "$tmp.pdf", exterr; + my $header; + read PDF, $header, 9 + or die sprintf "!!! Error: Cannot read header of `%s' (%s)!\n", + "$tmp.pdf", exterr; + $header =~ /^%PDF-1\.(\d)\s$/ or die "!!! Error: Cannot find header of `$tmp.pdf'!\n"; + if ($1 ne $::opt_pdfversion) { + seek PDF, 7, 0 + or die sprintf "!!! Error: Cannot seek in `%s' (%s)!\n", + "$tmp.pdf", exterr; + print PDF $::opt_pdfversion + or die sprintf "!!! Error: Cannot write in `%s' (%s)!\n", + "$tmp.pdf", exterr; + print "* PDF version correction in output file: 1.$::opt_pdfversion\n" + if $::opt_debug; + } + close(PDF); +} + +### Move temp file to output +if (!rename("$tmp.pdf", $outputfile)) { + use File::Copy; + move "$tmp.pdf", $outputfile or + die "$Error Cannot move `$tmp.pdf' to `$outputfile'!\n"; +} + +print "==> $page page", (($page == 1) ? "" : "s"), + " written on `$outputfile'.\n"; + +$exit_code = 0; +cleanup(); + +__END__ -- cgit v1.2.3