Current File : //proc/self/root/bin/psnup

#!/usr/bin/perl
# -*- perl -*-
my $version_banner = <<END;
psnup 2.07
Copyright (c) Reuben Thomas 2016-2021.
Released under the GPL version 3, or (at your option) any later version.
END

use v5.14;
use warnings;
use strict;

my $bindir;
BEGIN
{
# Relocatable header

# The functions in this file provide support for relocatability of
# Perl scripts.  They should be included near the beginning of each
# Perl script in a relocatable program, by adding @relocatable_pl@
# and causing the script to be expanded with AC_CONFIG_FILES.  A
# small amount of additional code must be added and adapted to the
# package by hand; see doc/relocatable-maint.texi (in Gnulib) for
# details.
#
# This code is based on relocatable.sh.in, and design changes (and
# bugs) should probably be cross-checked with it.
#
# Copyright (C) 2013, 2015-2022 Free Software Foundation, Inc.
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <https://www.gnu.org/licenses/>.
#

use Config;
use File::Basename;
use File::Spec::Functions;
use Cwd 'realpath';

# Support for relocatability.
sub find_curr_installdir {
  # Determine curr_installdir, even taking into account symlinks.
  my $curr_executable = $0;
  my $basename = basename($0);
  if ($curr_executable eq $basename) {
    LOOP: for my $dir (split /$Config{path_sep}/, $ENV{PATH}) {
      $dir = "." unless $dir;
      for my $ext ('') {
        my $filename = catfile($dir, "$curr_executable$ext");
        if (-f $filename) {
          $curr_executable = $filename;
          last LOOP;
        }
      }
    }
  }
  # Resolve symlinks and canonicalize.
  return realpath(dirname($curr_executable));
}
sub find_prefixes {
  # Compute the original/current installation prefixes by stripping the
  # trailing directories off the original/current installation directories.
  my ($orig_installprefix, $curr_installprefix) = @_;
  my $orig_last = basename($orig_installprefix);
  my $curr_last = basename($curr_installprefix);
  if ($orig_last && $curr_last && $orig_last eq $curr_last) {
    $orig_installprefix = dirname($orig_installprefix);
    $curr_installprefix = dirname($curr_installprefix);
  }
  return $orig_installprefix, $curr_installprefix;
}
if ("no" eq "yes") {
  my $exec_prefix = "/usr";
  my $orig_installdir = "/usr/bin"; # see Makefile.am's *_SCRIPTS variables
  my ($orig_installprefix, $curr_installprefix) = find_prefixes($orig_installdir, find_curr_installdir());
  sub relocate { # the subroutine is defined whether or not the enclosing block is executed
    my ($dir) = @_;
    if ("no" eq "yes") {
      $dir =~ s%^$orig_installprefix/%$curr_installprefix/%;
      $dir =~ s,/$,,;
    }
    return $dir;
  }
}

# Relocate the directory variables that we use.
my $pkgdatadir = &relocate("/usr/share/psutils");
$bindir = &relocate("/usr/bin");

# End of relocatable header; "real" Perl starts here.

unshift (@INC, '/usr/share/psutils') unless $ENV{PSUTILS_UNINSTALLED};
$bindir = '/builddir/build/BUILD/psutils-2.07' if $ENV{PSUTILS_UNINSTALLED};
}

use File::Spec::Functions 'catfile';
use File::Basename;
use Getopt::Long;
use List::Util qw(min);

use PSUtils;

our $program_name = basename($0);
my ($help_flag, $version_flag);

sub usage {
  my ($exit_code) = @_;
  print STDERR <<END;
Usage: $program_name [OPTION...] -NUP [INFILE [OUTFILE]]
Put multiple pages of a PostScript document on to one page.

  -NUMBER                  number of pages to impose on each output page
  -p, --paper=PAPER        output paper name or dimensions
  -P, --inpaper=PAPER      input paper name or dimensions
  -m, --margin=DIMENSION   width of margin around each output page
                           [default 0pt]; useful for thumbnail sheets,
                           as the original page margins will be shrunk
  -b, --border=DIMENSION   width of border around each input page
  -d, --draw[=DIMENSION]   draw a line of given width around each page
                           [relative to input page size; argument defaults to
                           1pt; default is no line]
  -l, --rotatedleft        input pages are rotated left 90 degrees
  -r, --rotatedright       input pages are rotated right 90 degrees
  -f, --flip               swap output pages' width and height
  -c, --transpose          swap columns and rows (column-major order)
  -t, --tolerance=NUMBER   maximum wasted area in square pt [default: 100,000]
  -q, --quiet              don't show page numbers being output
      --help               display this help and exit
      --version            display version information and exit

psnup aborts with an error if it cannot arrange the input pages so as to
waste less than the given tolerance.

The output paper size defaults to the input paper size; if that is not given,
the default given by the `paper' command is used.

The input paper size defaults to the output paper size.

In row-major order (the default), adjacent pages are placed in rows across
the paper; in column-major order, they are placed in columns down the page.
END
  exit $exit_code;
}

# Settings
my $rowmajor = 1;
my ($flip, $leftright, $topbottom) = (0, 1, 1);
my $nup = 1;
my $draw = 0;				# draw page borders
my ($margin, $border) = (0, 0);		# paper & page margins
my ($owidth, $oheight);			# output paper size
my ($iwidth, $iheight);			# input paper size
my $tolerance = 100000;			# layout tolerance

sub parsenup {
  Die("option $_[0] requires an argument") unless $_[1] ne "";
  Die("value \"$nup\" invalid for -NUP (number expected)") unless $_[1] =~ /^\d+$/;
  Die("number of pages per sheet must be positive") if $_[1] == 0;
  $nup = $_[1];
}

# Parse -NUP, which Getopt::Long can't easily be made to understand
for (my $i = 0; $i <= $#ARGV; ) {
  if ($ARGV[$i] =~ /^-[1-9]\d*$/) { # -NUP
    $nup = -$ARGV[$i];
    splice(@ARGV, $i, 1)
  } else {
    $i++;
  }
}

# Get arguments
Getopt::Long::Configure("bundling");
# Having configured bundling, must give short options explicitly
my @pstops_args = ();
GetOptions(
  "paper|p=s" => sub { ($owidth, $oheight) = parsepaper($_[1]); },
  "width|w=s" => sub { $owidth = singledimen($_[1], $owidth, $oheight); },
  "height|h=s" => sub { $oheight = singledimen($_[1], $owidth, $oheight); },
  "inpaper|P=s" => sub { ($iwidth, $iheight) = parsepaper($_[1]); },
  "inwidth|W=s" => sub { $iwidth = singledimen($_[1], $owidth, $oheight); },
  "inheight|H=s" => sub { $iheight = singledimen($_[1], $owidth, $oheight); },
  "margin|m=s" => sub { $margin = singledimen($_[1], $owidth, $oheight); },
  "border|b=s" => sub { $border = singledimen($_[1], $owidth, $oheight); },
  "draw|d:s" => sub { push @pstops_args, "-d";
                      $draw = singledimen($_[1] || "1pt", $owidth, $oheight); },
  "rotatedleft|l" => sub { $rowmajor = !$rowmajor; $topbottom = !$topbottom; },
  "rotatedright|r" => sub { $rowmajor = !$rowmajor; $leftright = !$leftright; },
  "flip|f" => sub { $flip = !$flip; },
  "transpose|c" => sub { $rowmajor = !$rowmajor; },
  "tolerance|t=i" => \$tolerance,
  "quiet|q" => sub { push @pstops_args, "-q"; },
  "help" => \$help_flag,
  "version" => \$version_flag,
  "n=s" => \&parsenup, # for compatibility with other psnup implementations
 ) or usage(1);
if ($version_flag) {
  print STDERR $version_banner;
  exit 0;
}
usage(0) if $help_flag;

Die("output page width and height must both be set, or neither")
  if !defined($owidth) xor !defined($oheight);
Die("input page width and height must both be set, or neither")
  if !defined($iwidth) xor !defined($iheight);

# Find next larger exact divisor > $n of $m, or 0 if none; return divisor
# and dividend.
# There is probably a much more efficient method of doing this, but the
# numbers involved are small.
sub nextdiv {
  my ($n, $m) = @_;
  while (++$n <= $m) {
    return ($n, $m / $n) if $m % $n == 0;
  }
  return 0;
}

# Set output height/width from corresponding input value if undefined
($owidth, $oheight) = ($iwidth, $iheight) if !defined($owidth) && defined($iwidth);

# Ensure output paper size is set
($owidth, $oheight) = paper_size()
  or Die("output paper size not set, and could not get default paper size")
  if !defined($owidth);

# Set input height/width from corresponding output value if undefined
($iwidth, $iheight) = ($owidth, $oheight) if !defined($iwidth);

# Take account of flip
($owidth, $oheight) = ($oheight, $owidth) if $flip;

# Tell pstops input paper size if it differs from output paper size
push @pstops_args, "-P${iwidth}x${iheight}" if $owidth != $iwidth || $oheight != $iheight;

# Calculate paper dimensions, subtracting paper margin from height & width
my ($ppwid, $pphgt) = ($owidth - $margin * 2, $oheight - $margin * 2);
Die("margin is too large") if $ppwid <= 0 || $pphgt <= 0;
Die("border is too large") if $border > min($ppwid, $pphgt);

# Finding the best layout is an optimisation problem. We try all of the
# combinations of width*height in both normal and rotated form, and
# minimise the wasted space.
my $best = $tolerance;
my ($horiz, $vert, $rotate);

sub reduce_waste {
  my ($hor, $ver, $iwid, $ihgt, $rot) = @_;
  my $scl = min($pphgt / ($ihgt * $ver), $ppwid / ($iwid * $hor));
  my $waste = ($ppwid - $scl * $iwid * $hor) ** 2 + ($pphgt - $scl * $ihgt * $ver) ** 2;
  ($best, $horiz, $vert, $rotate) = ($waste, $hor, $ver, $rot) if $waste < $best;
}

for (my ($hor, $ver) = (1, $nup); $hor != 0; ($hor, $ver) = (nextdiv($hor, $nup))) {
  reduce_waste($hor, $ver, $iwidth, $iheight, 0); # normal orientation
  reduce_waste($ver, $hor, $iheight, $iwidth, 1); # rotated orientation
}

# Fail if nothing better than tolerance was found
Die("can't find acceptable layout for $nup-up") if $best == $tolerance;

# Take account of rotation
($topbottom, $leftright, $rowmajor, $iwidth, $iheight) = (!$leftright, $topbottom, !$rowmajor, $iheight, $iwidth) if $rotate;

# Calculate page scale, allowing for internal borders
my $scale = min(($pphgt - 2 * $border * $vert) / ($iheight * $vert),
                ($ppwid - 2 * $border * $horiz) / ($iwidth * $horiz));

# Page centring shifts
my ($hshift, $vshift) = (($ppwid / $horiz - $iwidth * $scale) / 2, ($pphgt / $vert - $iheight * $scale) / 2);

push @pstops_args, "-p${owidth}x${oheight}"; # set output paper size for pstops

# Construct specification list
my @specs;
for (my $page = 0; $page < $nup; $page++) {
  my ($across, $up) = $rowmajor ? ($page % $horiz, int($page / $horiz)) : (int($page / $vert), $page % $vert);
  $across = $horiz - 1 - $across if !$leftright;
  $up = $vert - 1 - $up if $topbottom;
  push @specs, sprintf "%d%s@%f(%f,%f)", $page , ($rotate ? "L" : ""), $scale ,
    ($rotate ? $margin + ($across + 1) * $ppwid / $horiz - $hshift : $margin + $across * $ppwid / $horiz + $hshift),
    ($margin + $up * $pphgt / $vert + $vshift);
}

# Rearrange pages
exec(catfile($bindir, "pstops"), @pstops_args, "$nup:" . join("+", @specs), @ARGV) or Die("error running pstops");