#!/usr/bin/perl
# ==================================================================== psselect
# A PERL Script to select a page or range of pages from a PostScipt
# file conforming to the Adobe Document Structuring Conventions (DSC)
#
#  Version 1.0
#
# History:
# (v0.8) Fri 03 Jan 1992, Kevin O. Grover, grover@isri.unlv.edu
#        - Created
# (v0.9) Mon 13 Jan 1992, KOG (v0.9)
#        - Cleaned up, completed, enhanced comments.
# (v1.0) Wed 25 Mar 1992, KOG (v1.0)
#        - Added support for the "EOF" at the end of a document.  Input
#          from STDIN now works.
#
# Syntax:  psselect range [file ...]
#
# Desc: This PERL script will extract a single page, or a continuous
#       range of pages from a PostScript file conforming to the DSC
#       standards.  The first line of the file must start with
#       "%!PS-Adobe-" indicating a minimally conforming DSC file.  It
#       then outputs everything until the "%%EndProlog" comment is
#       found.  Then the file is scanned until the correct page(s)
#       is/are found and it/they is/are output.  Then, the file is
#       searched for the "%%Trailer" comment, and everything after it
#       is output (or it is created if it does not exist.)  NOTE: All
#       instances of "%%Pages" and "%%Page" comments that are output
#       are updated so that the resulting PostScript is still DSC
#       compliant.
#
# Examples:
#    psselect 4 file.ps       # Only page 4 with w/ prolog and trailer
#    psselect 5-10 file.ps    # Pages 5 to 10 w/ prolog and trailer
#    # Convert main.c to PostScript (conforming to the DCS) and pipe to
#    # pselect to only get pages 2 and 3, then send those to the printer
#    tp main.c | psselect 2-3 | lpr
#
#    NOTE: "tp" is a Text to PostScript converter I wrote in C a while back.
#           It puts a header with the time,date,file, and page number at
#           the top of every page, and has the ability to number all lines
#           and to print in a specified font size (for putting more than
#           66 lines per page.)  I am planning on improving it.  If you are
#           interested in it, send a message to me at the address above.
#
# To Do
#       - Improve Error Checking (warn on only #!, or missing section)
#       - Allow multiple input files?
#       - Allow multiple ranges (possibly not in order)?
# - Test all cases
#       - If STDIN is used, use trick to make it "seekable"?  (Check with
#         (-t) file test to see if it is open to a tty, if so, create a temp
#         file, and copy STDIN to temp file.)
#       - Print a warning of the specified page is not found
# - Should look for first "%%Page:" command as end of header
# - Add ability to discard "%%Begin(End)Document" embedded docs
#   when searching for a page, or the trailer?
#
# Notes - make sure the #! line points to your copy of PERL
# =============================================================================

#
# Get the range from the command line
#

if (@ARGV) {
 $rng = shift @ARGV;
 if ($rng =~ m/(\d*)\-(\d*)/o) {
  $start = $1;
  $stop  = $2;
 } else {
  $start = $rng;
  $stop  = $start;
 }

 if ($stop < $start) {
  warn "STOP page is less than START page.  Swapping.\n";
  $t = $start; $start = $stop; $stop = $t;
 }
} else {
 print "Not enough Arguements\n";
 print "Usage: psselect range file\n";
 print "Range: p-p or p\n";
 exit;
}

#
# Get the File to process from the command line, and process the file
#

if (! @ARGV) {
 *IN = *STDIN;
 &process;
} else {
 $currfile = shift @ARGV;
 open (IN, $currfile) || die "Could not open file: $!\n";
 &process;
 close(IN);
}

# --------------------------------------------------------------------- process
#  Process an open file pointer to extract only the PostScript pages
#  in the range [$start,$stop]  (i.e. inclusive).  DSC Comments are
#  preserved, and where needed added or updated.
#  When a %%Page: comment is found, the ordinal count (i.e. second component)
#  is rewritten with sequencial values starting at 1.
# -----------------------------------------------------------------------------

sub process {
 $echoing = 0;
 $phys    = 0;

 &OutHeader || return;

 while ($in = <IN>) {
  if ($in =~ m/^%%BeginDocument/) {
	#print STDERR "eps\n";
	&EatEPS;
	next;
  }
  if ($in =~ m/^%%Trailer/o) { &OutTrailer; return; }
  if ($in =~ m/^%%Page: (\d*) (\d*)/o) {
   if ($1 >= $start) { $echoing = 1; }
   if ($1 > $stop)   { $echoing = 0; &FindTrailer; return; }
   if ($echoing) { 
    printf ("%%%%Page: %d %d\n", $1, ++$phys);
   }
  } elsif ($echoing) { print $in; }
 }
}

# ------------------------------------------------------------------- OutHeader
#  Write out the PostScript header until the %%EndProlog comment is
#  found.
#
#  Returns: 1 if %%EndProlog is found, 0 if EOF is reached or if the
#           first line does not contain the comment indicating that the
#           file is DSC PostScript.
# -----------------------------------------------------------------------------

sub OutHeader {
 #print STDERR "OutHeader\n";
 if ($in = <IN>) {
  if ($in =~ m/^%!PS-Adobe-.*/o) {
    print $in;
  } else {
    warn "Error: $currfile is not a conforming PS file\n";
    return 0;
  }
 } else
  { return 0; }

 while ($in = <IN>) {
  if ($in =~ m/^%%BeginDocument/) {
	#print STDERR "eps\n";
	&EatEPS;
	next;
  }
  if ($in =~ m/^%%Pages:.*/o)
   { print "%%Pages: (attend)\n"; }
  else
   { print $in; }

# Should I add more comments to the file??
#
#  if ($in =~ m/^%%EndComments/o) 
#   {
#     print "% Created by PSSELECT for pages $start ";
#     print "to $stop\n";
#   }

  if ($in =~ m/^%%EndSetup/o) { return 1; }
 }

 return 0;
}

# ----------------------------------------------------------------- FindTrailer
#  Searches every line until the %%Trailer is found.
#  If the comment is found, then the OutTrailer routine is called,
#  otherwise we create our own trailer and write the page count.
# -----------------------------------------------------------------------------

sub EatEPS {
	if ($echoing) { print $in; }
	$eps=1;
	$seen_eof=0;
	while($eps && ($in = <IN>)) {
		if ($echoing) { print $in; }
		if ($in =~ m/^%%EndDocument/) { $eps=0; }
	}
}

sub FindTrailer {
 ##print STDERR "FindTrailer";
 while ($in = <IN>) {
  if ($in =~ m/^%%BeginDocument/) {
	&EatEPS;
	next;
  }
  if ($in =~ m/^%%Trailer/o) {
   &OutTrailer;
   return;
  }
 }

 print "%%Trailer\n";
 print "%%Pages: $phys\n";
 print "%%EOF\n";
}

# ------------------------------------------------------------------ OutTrailer
#  Outputs information contained in the trailer.  If the %%Pages
#  comment is found, it is updated to contain the actual number of
#  pages produced by this program.  All other lines are echoed as is.
# -----------------------------------------------------------------------------

sub OutTrailer {
 ##print STDERR "OutTrailer\n";
 local($fnd_pages) = 0;

 print $in;
 while ($in = <IN>) {
  if ($in =~ m/^%%BeginDocument/) {
	#print STDERR "eps\n";
	&EatEPS;
	next;
  }
  if ($in =~ m/^%%Pages:.*\n/o) {
    print "%%Pages: $phys\n";
    $fnd_pages = 1;
  } elsif ( $in =~ m/^%%EOF/o ) {

                  # if there was not pages comment before the eof,
    # then add a pages comment before the eof

    if (!$fnd_pages) {
      print "%%Pages: $phys\n";
      $fnd_pages = 1;
    }
   
                  # Print the "EOF" line as is.

     print $in;
  } else { print $in;
  }
 }

 # If there was no "%%EOF" and no "%%Pages" comment, then add both

 if (!$fnd_pages) {
   print "%%Pages: $phys\n";
   print "%%EOF\n";
 }
}
