#!/usr/bin/perl
# -*- perl -*-
my $version_banner = <<END;
psjoin 1.93
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

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 STDOUT <<END;
Usage: $program_name [OPTION...] FILE...
Concatenate PostScript files.

  -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 STDOUT $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";
