Current File : //kunden/bin/psjoin

#!/usr/bin/perl
# -*- perl -*-
my $version_banner = <<END;
psjoin 2.07
Copyright (c) Tom Sato 2002-2003.
Copyright (c) Reuben Thomas 2013-2020.
Released under the GPL version 3, or (at your option) any later version.
END

use v5.10;
use strict;
use warnings;

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");

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

  unshift (@INC, '/usr/share/psutils') unless $ENV{PSUTILS_UNINSTALLED};
}

use File::Basename;
use Getopt::Long;

use PSUtils;

our $program_name = basename($0);

sub usage {
  my ($exit_code) = @_;
  print STDERR <<END;
Usage: $program_name [OPTION...] FILE...
Concatenate PostScript documents.

  -e, --even          force each file to an even number of pages
  -s, --save          try to close unclosed save operators
  -n, --nostrip       do not strip prolog or trailer from input files
      --help          display this help and exit
      --version       display version information and exit
END
  exit $exit_code;
}

my $force_even = 0;
my $force_save = 0;
my $nostrip = 0;
my $save = "save %psjoin\n";
my $restore = "restore %psjoin\n";
my ($help_flag, $version_flag);

Getopt::Long::Configure("bundling");
# Having configured bundling, must give short option names explicitly
GetOptions(
  "even|e" => \$force_even,
  "save|s" => \$force_save,
  "nostrip|n|p" => \$nostrip,
  "help" => \$help_flag,
  "version" => \$version_flag,
 ) or usage(1);
if ($version_flag) {
  print STDERR $version_banner;
  exit 0;
}
usage(0) if $help_flag or $#ARGV == -1;

if ($force_save) {
  $save = "/#psjoin-save# save def %psjoin\n";
  $restore = "#psjoin-save# restore %psjoin\n";
}
my (@prolog, $prolog_inx, @trailer, @comments, @pages);
if ($nostrip) {
  $prolog_inx = 9999;
  $prolog[$prolog_inx] = "% psjoin: don't strip\n";
  $trailer[$prolog_inx] = "% psjoin: don't strip\n";
} else {
  for (my $i = 0; $i <= $#ARGV; $i++) {
    open(IN, $ARGV[$i]) || die "$0: can't open \"$ARGV[$i]\" ($!)";

    my $in_comment = 1;
    my $in_prolog = 1;
    my $in_trailer = 0;
    $comments[$i] = "";
    $prolog[$i] = "";
    $trailer[$i] = "";
    $pages[$i] = 0;
    while (<IN>) {
      next if /^%%BeginDocument/ .. /^%%EndDocument/;

      if ($in_comment) {
        next if /^%!PS-Adobe-/;
        next if /^%%Title/;
        next if /^%%Pages/;
        next if /^%%Creator/;
        $in_comment = 0 if /^%%EndComments/;
        $comments[$i] .= $_;
        next;
      } elsif ($in_prolog) {
        if (/^%%Page:/) {
          $in_prolog = 0;
        } else {
          $prolog[$i] .= $_;
          next;
        }
      }

      $in_trailer = 1 if /^%%Trailer/;
      if ($in_trailer) {
        $trailer[$i] .= $_;
        next;
      }

      $pages[$i]++ if /^%%Page:/;
    }
    close(IN);

    if ($prolog[$i]) {
      for (my $j = 0; $j < $i; $j++) {
        if ($prolog[$j] eq $prolog[$i]) {
          $pages[$j] += $pages[$i];
          last;
        }
      }
    }
  }

  my $largest = 0;
  $prolog_inx = 0;
  for (my $i = 0; $i <= $#ARGV; $i++) {
    my $size = length($prolog[$i]) * $pages[$i];
    if ($largest < $size) {
      $largest = $size;
      $prolog_inx = $i;
    }
  }
}

my @files = @ARGV;
@files = map basename($_), @ARGV;

print <<END;
%!PS-Adobe-3.0
%%Title: @files
%%Creator: psjoin (from PSUtils)
%%Pages: (atend)
END
print $comments[$prolog_inx] || "";

print "\n$prolog[$prolog_inx]";
for (my $i = 0; $i <= $#ARGV; $i++) {
  if ($prolog[$i]) {
    $prolog[$i] =~ s/^%%/% %%/;
    $prolog[$i] =~ s/\n%%/\n% %%/g;
    $trailer[$i] =~ s/^%%/% %%/;
    $trailer[$i] =~ s/\n%%/\n% %%/g;
  }
}

my $total_pages = 0;
for (my $i = 0; $i <= $#ARGV; $i++) {
  say "% psjoin: file: $files[$i]";
  if (!defined($prolog[$i]) || $prolog[$i] ne $prolog[$prolog_inx]) {
    say "% psjoin: Prolog/Trailer will be inserted in each page";
  } else {
    say "% psjoin: common Prolog/Trailer will be used";
  }

  my $in_comment = 1 if !$nostrip;
  my $in_prolog = 1 if !$nostrip;
  my $in_trailer = 0;
  my $saved = 0;
  my $pages = 0;

  open(IN, $ARGV[$i]) || die "$0: can't open \"$ARGV[$i]\" ($!)";
  while (<IN>) {
    if (/^%%BeginDocument/ .. /^%%EndDocument/) {
      # s/^(%[%!])/% \1/;
      print $_;
    } else {
      if ($in_comment) {
        $in_comment = 0 if /^%%EndComments/;
      } elsif ($in_prolog) {
        if (/^%%Page:/) {
          $in_prolog = 0;
        } else {
          next;
        }
      }
      $in_trailer = 1 if !$nostrip && /^%%Trailer/;
      next if $in_trailer;

      if (/^%%Page:/) {
        if ($saved) {
          print $trailer[$i];
          print $restore;
          $saved = 0;
        }

        $pages++;
        $total_pages++;
        say "\n%%Page: ($i-$pages) $total_pages";
        if (!defined($prolog[$i]) || $prolog[$i] ne $prolog[$prolog_inx]) {
          print $save;
          print $prolog[$i] if defined($prolog[$i]);
          $saved = 1;
        } elsif ($force_save) {
          print $save;
        }
      } else {
        s/^(%[%!])/% $1/;
        print $_;
      }
    }
  }
  close(IN);

  if ($force_even && $pages % 2 != 0) {
    $pages++;
    $total_pages++;
    print <<END;

%%Page: ($i-E) $total_pages
% psjoin: empty page inserted to force even pages
showpage
END
  }

  print $trailer[$i] if defined($trailer[$i]) && $saved;
  print $restore if $saved || $force_save;
}

say "\n%%Trailer";
print $trailer[$prolog_inx];
print "\n%%Pages: $total_pages\n%%EOF";