eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}' && eval 'exec perl -S $0 $argv:q'
  if 0;
use strict;
#
# thumbpdf.pl
#
# Copyright (C) 1999 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.txt" for a list of files that belong to this project.
#
# This file "thumbpdf.pl" may be renamed to "thumbpdf"
# for installation purposes.
#
my $file        = "thumbpdf.pl";
my $program     = uc($file =~ /^(\w+)/, $1);
my $version     = "1.11";
my $date        = "2000/01/19";
my $author      = "Heiko Oberdiek";
my $copyright   = "Copyright (c) 1999 by $author.";
#
# Reqirements: Perl5, Ghostscript
# History:
#   1999/02/14 v1.0: First release.
#   1999/02/23 v1.1:
#    * Looking for the media box to calculate the resolution
#      for ghostscript
#    * new option --resolution
#   1999/03/01 v1.2:
#    * optimization: indirect objects for length values removed.
#    * "first line" from epstopdf
#   1999/03/12 v1.3:
#    * Copyright: LPPL
#   1999/05/05 v1.4:
#    * Detecting of cygwin32 environment.
#    * Minor corrections of output of error messages.
#    * Sharing RGB objects.
#   1999/06/13 v1.5:
#    * gs detection extended.
#   1999/07/27 v1.6
#   1999/08/08 v1.7:
#    * \immediate before \pdfobj (pdfTeX 0.14a)
#   1999/09/09 v1.8
#   1999/09/06 v1.9:
#    * Check for direct /Length values (for jpg images)
#   2000/01/11 v1.10:
#    * Bug fix: /Length (direct) as last entry.
#    * Direct /Length in RGB objects supported.
#   2000/01/19 v1.11:
#    * "for (my $j=0;...;...)"  replaced by "my $j; for($j=0;...;...)",
#      because there exist perl versions that have problems with.
#

### program identification
my $title = "$program $version, $date - $copyright\n";

### error strings
my $Error = "!!! Error:"; # error prefix

### string constants for ghostscript run
# get ghostscript command name
my $GS = "gs";
$GS = "gs386"    if $^O =~ /dos/i;
$GS = "gsos2"    if $^O =~ /os2/i;
$GS = "gswin32c" if $^O =~ /mswin32/i;
$GS = "gswin32c" if $^O =~ /cygwin/i;

### file names
my $dtafile = "thumbdta.tex";
my $optfile = "thumbopt.tex";
my $pdffile = "thumbpdf.pdf";
my $texfile = "thumbpdf";
my $package = "thumbpdf.sty";

### usage
my @bool = ("false", "true");
$::opt_device="png16m";
$::opt_compress="9";
$::opt_resolution="";
my $resolution=9;
$::opt_help=0;
$::opt_quiet=0;
$::opt_debug=0;
$::opt_verbose=0;
$::opt_makepng=1;
$::opt_makepdf=1;
$::opt_makedef=1;

my $usage = <<"END_OF_USAGE";
${title}Syntax:   \L$program\E [options] [pdf file]
Function:
  1. If a pdf file is given, make thumbnails  (ghostscript --> thumb???.png).
  2. Make pdf file with thumb nails as images (pdftex      --> $pdffile).
  3. Parse pdf file and generate a tex input file        ( --> $dtafile),
     that is read by package '$package'.
Options:
  --help          print usage
  --(no)makepng   perform step one   (default: $bool[$::opt_makepng])
  --(no)makepdf   perform step two   (default: $bool[$::opt_makepdf])
  --(no)makedef   perform step three (default: $bool[$::opt_makedef])
  --(no)quiet     suppress messages  (default: $bool[$::opt_quiet])
  --(no)verbose   verbose printing   (default: $bool[$::opt_verbose])
  --(no)debug     debug informations while parsing         (default: $bool[$::opt_debug])
  --resolution <res>       resolution for ghostscript step (default: $resolution)
  --compress <n>           <n>   = 0..9
                  \\pdfcompresslevel for '$pdffile'     (default: $::opt_compress)
  --device|png [png]<dev>  <dev> = mono, gray, 16, 256, 16m
                  ghostscript png device                   (default: $::opt_device)
END_OF_USAGE

### process options
use Getopt::Long;
GetOptions(
  "help!",
  "quiet!",
  "debug!",
  "verbose!",
  "device|png=s",
  "compress=i",
  "resolution=f",
  "makepng!",
  "makepdf!",
  "makedef!"
) or die $usage;
!$::opt_help or die $usage;
@ARGV < 2 or die "$usage$Error Too many files!\n";

$::opt_device = "png$::opt_device" unless $::opt_device =~ /^png/;
$::opt_quiet = 0 if $::opt_verbose;

### get pdf file name
my $jobpdffile;
if (@ARGV == 1)
{
  $jobpdffile = $ARGV[0];
  $jobpdffile .= '.pdf' if -f "$jobpdffile.pdf";
  -f $jobpdffile or die "$usage$Error PDF file '$jobpdffile' not found!\n";
}

print $title unless $::opt_quiet;

print "* ghostscript command: '$GS'\n" if $::opt_verbose;
print "* ghostscript png device: '$::opt_device'\n" if $::opt_verbose;

###
### make thumbnails
###
if ($::opt_makepng and $jobpdffile)
{
  print "*** make png files / run ghostscript ***\n" unless $::opt_quiet;
  print "* pdf file: $jobpdffile\n" if $::opt_verbose;

  if ($::opt_resolution)
  {
    $resolution = $::opt_resolution
  }
  else
  {
    # looking for MediaBox

    my $max_x = 0;
    my $max_y = 0;
    {
      my $MB = $jobpdffile;
      open(MB, $MB) or die "$Error Cannot open '$MB'!\n";
      binmode(MB);
      my $xy_patt = '[\-\.\d]';
      while (<MB>)
      {
        if (/\/MediaBox\s*\[\s*($xy_patt+)\s+($xy_patt+)\s+($xy_patt+)\s+($xy_patt+)\s*\]/)
        {
          my $x = $3 - $1;
          my $y = $4 - $2;
          $max_x = $x if $x > $max_x;
          $max_y = $y if $y > $max_y;
        }
      }
      close(MB);
    }
    if ($max_x <= 0 || $max_y <= 0)
    {
      print "!!! Warning: MediaBox not found, " .
            "using default resolution: $resolution DPI\n";
    }
    else
    {
      print "* Max. Size of MediaBox: $max_x x $max_y\n" if $::opt_verbose;

      my $rx = 106 * 72 / $max_x;
      my $ry = 106 * 72 / $max_y;
      $resolution = $rx;
      $resolution = $ry if $ry < $rx;
      print "* Resolution: $resolution DPI\n" if $::opt_verbose;
    }
  }

  my $gs_cmd = <<"GS_CMD_END";
$GS
-dNOPAUSE
-dBATCH
-sDEVICE=$::opt_device
-r$resolution
-sOutputFile=thumb%03d.png
$jobpdffile
GS_CMD_END
  chomp($gs_cmd);
  $gs_cmd =~ s/\n/ /mg;
  print "> $gs_cmd\n" if $::opt_verbose;
  my $capture = `$gs_cmd`;
  print $capture if $::opt_verbose;
  if ($capture =~ /Error:\s*(.*)\n/)
  {
    die "$Error \"$1\" (ghostscript)!\n";
  }
  if ($capture =~ /Unknown device:\s*(.*)\n/)
  {
    die "$Error Unknown device \"$1\" (ghostscript)!\n";
  }
  if ($? != 0)
  {
    die "$Error $? (ghostscript)!\n";
  }
}

###
### make thumbpdf.pdf file
###
if ($::opt_makepdf)
{
  print "*** make \"$pdffile\" / run pdftex ***\n" unless $::opt_quiet;

  # get max thumb number to speed up the pdftex run
  my $MaxThumb = 0;
  foreach (glob("thumb???.png"))
  {
    next unless /thumb(\d\d\d).png/;
    $MaxThumb = $1 if $1 > $MaxThumb;
  }

  my $cmd = "pdftex \"\\nonstopmode\\pdfcompresslevel$::opt_compress" .
    "\\def\\thumbmax{$MaxThumb}\\input $texfile\"";
  print "> $cmd\n" if $::opt_verbose;
  my @capture = `$cmd`;
  if ($::opt_verbose)
  {
    print @capture if $::opt_verbose;
  }
  else
  {
    foreach (@capture)
    {
      print if /^!\s/;
    }
  }
  if ($?)
  {
    die "$Error $? (pdftex)!\n";
  }
}

###
### parse thumbpdf.pdf to make thumbdta.tex
###

if ($::opt_makedef)
{
  print "*** parse \"$pdffile\" ***\n" unless $::opt_quiet;

### reading file and parse obj structure

  my @objno = (); # obj number
  my @objdict = (); # boolean, object is dict
  my @objtext = (); # text of object
  my @objstream = (); # stream of object if any
  my $maxobj = 0;

  my @getobjindex = (); # $getobj[obj number] ==> index for $obj...[index]

  # open file
  my $PDF = $pdffile;
  open(PDF, $PDF) or die "$Error Cannot open '$PDF'!\n";
  binmode(PDF);
  my $lineno = 0;

  # read header
  $_ = <PDF>; $lineno++;
  $_ or die "$Error Cannot read header of '$PDF'!\n";
  /^%PDF/ or die "$Error No PDF specification found!\n";
  print "* pdf header: $_" if ($::opt_debug);

  # read body objects
  my $count = 0;
  while (<PDF>)
  {
    $lineno++;

    # stop at xref
    last if /^xref$/;

    # scan first obj line
    /^(\d+)\s+0\s+obj\s*(<<)?$/ or
      die "$Error 'obj' expected on line $lineno!\n";
    $objno[$count] = $1;
    $getobjindex[$1] = $count;
    $objdict[$count] = ($2); # boolean (if $2 exists)
    my $stream = 0;
    print "* obj $objno[$count]" .
      (($objdict[$count]) ? " (dict)" : "") .
      "\n" if $::opt_debug;

    # get obj
    $objtext[$count] = "";
    while (<PDF>)
    {
      $lineno++;

      if ($objdict[$count])
      {
        if (/^>>/)
        {
          last if /^>>\s+endobj$/; # obj without stream

          # get stream
          $_ = <PDF>; $lineno++;
          /^stream$/ or die "$Error 'stream' expected on line $lineno!\n";

          print "* stream\n" if $::opt_debug;
          $objstream[$count] = "";
          while (<PDF>)
          {
            $lineno++;

            if (/(.*)endstream$/)
            {
              $objstream[$count] .= $1;
              last;
            }
            $objstream[$count] .= $_;
          }

          $_ = <PDF>; $lineno++;
          /^endobj$/ or die "$Error 'endobj' expected on line $lineno!\n";
          last;
        }
      }
      else # no dict
      {
        last if /^endobj$/;
      }
      $objtext[$count] .= $_;
    }
    $count++;
  }
  close(PDF);
  $maxobj = $count;
  print "* $maxobj objects found.\n" if $::opt_debug;

### get thumbnail page numbers
  my @thumbpageno = ();
  my $found = 0;
  foreach (@objtext)
  {
    if (/^\/ListThumbs\s+(.+)$/)
    {
      $_ = $1;
      chomp;
      @thumbpageno = split / /; # split(/ /, $_);
      print "* ListThumbs: @thumbpageno\n" if $::opt_debug;
      $found = 1;
      last;
    }
  }
  $found or die "$Error '/ListThumbs' not found!\n";
  {
    my $j;
    for ($j=0; $j<@thumbpageno; $j++)
    {
      $thumbpageno[$j] = $1 if $thumbpageno[$j] =~ /^{(.+)}$/;
    }
  }

### identify thumb objects

  my @thumbobj = ();    # index for @obj... with image stream
  my @thumblength = (); # stream length values
  my @thumbrgbobj = (); # index for @obj... with rgb stream
  my @thumbrgblength = (); # rgb stream length values
  my $maxthumb = 0;

  $count = 0;
  my $i;
  for ($i=0; $i<$maxobj; $i++)
  {
    if ($objtext[$i] =~
        /^\/Type\s+\/XObject\n\/Subtype\s+\/Image\n/m)
    {
      $thumbobj[$count] = $i;
      $_ = $';
      $objtext[$i] = $_;

      # check width and height
      /\/Width\s+(\d+)\n\/Height\s+(\d+)/m or
        die "$Error width/height of thumbnail not found!\n";
      print "* Size: $1x$2\n" if $::opt_debug;
      print "!!! Caution: Width ($1) too large, not recommanded for Acrobat Reader 3.x!\n"
        if $1 > 106;
      print "!!! Caution: Height ($2) too large, not recommanded for Acrobat Reader 3.x!\n"
        if $2 > 106;

      # get stream length
      if (/\/Length\s+(\d+)\s+([\/\>]|$)/m)
      {
        $thumblength[$count] = $1;
        print "* Length (direct): $1\n" if $::opt_debug;
        # object text remains unchanged.
      }
      else # looking for indirect reference
      {
        /\/Length\s+(\d+)\s+0\s+R/m or
          die "$Error '/Length' entry not found!\n";
        # save obj text for later correction
        my $objpre = $`;
        my $objpost = $';
        # look for length obj
        $getobjindex[$1] or die "$Error Length obj not found!\n";
        $objtext[$getobjindex[$1]] =~ /^(\d+)$/m or
          die "$Error length value not found!\n";
        $thumblength[$count] = $1;
        print "* Length (indirect): $1\n" if $::opt_debug;
        # insert obj length directly:
        $objtext[$i] = $objpre . "/Length $1" . $objpost;
      }

      # check /Indexed /DeviceRGB
      if ($objtext[$i] =~
        /\/ColorSpace\s+\[\/Indexed\s+\/DeviceRGB\s+(\d+)\s+(\d+)\s+0\s+R\]/m)
      {
        # correct thumb object text
        $objtext[$i] =
          "$`/ColorSpace [/Indexed /DeviceRGB $1 \\the\\pdflastobj\\ 0 R]$'";
        # get RGB obj number
        $getobjindex[$2] or die "$Error RGB object not found!\n";
        $_ = $getobjindex[$2];
        $thumbrgbobj[$count] = $_;
        # get stream length
        if ($objtext[$_] =~ /\/Length\s+(\d+)\s+([\/\>]|$)/m)
        {
          $thumbrgblength[$count] = $1;
          print "* RGB length (direct): $1\n" if $::opt_debug;
        }
        else # looking for indirect reference
        {
          $objtext[$_] =~ /\/Length\s+(\d+)\s+0\s+R/m or
            die "$Error Length entry of rgb object not found\n";
          # save obj text for later correction
          my $objrgbpre = $`;
          my $objrgbpost = $';
          # get rgb stream length
          $getobjindex[$1] or die "$Error RGB length object not found!\n";
          $objtext[$getobjindex[$1]] =~ /^(\d+)$/m or
            die "$Error length value not found!\n";
          $thumbrgblength[$count] = $1;
          print "* RGB length (indirect): $1\n" if $::opt_debug;
          # insert RGB object length directly:
          $objtext[$_] = $objrgbpre . "/Length $1" . $objrgbpost;
        }
      }

      $count++;
    }
  }
  $maxthumb = $count;

  if ($maxthumb != @thumbpageno)
  {
    my $pagecount = @thumbpageno;
    die "$Error $maxthumb thumbnails found, but there should be $pagecount!\n";
  }
  print "* $maxthumb thumbnails found.\n" if $::opt_verbose;


###
### write "thumbdta.tex"
###

  print "*** write \"$dtafile\" ***\n" unless $::opt_quiet;

  my $TEX = $dtafile;
  open(TEX, ">$TEX") or die "!!! Error: Cannot open '$TEX'!\n";
  binmode(TEX);

  for ($i=0; $i<$maxthumb; $i++)
  {
    # rgb object
    if ($thumbrgbobj[$i])
    {
      $objtext[$thumbrgbobj[$i]] =~ s/\n/^^J%\n/mg;

      # find the same rgb object
      my $j;
      for ($j=0; $j<$i; $j++)
      {
        next unless $thumbrgbobj[$j];
        next unless $objtext[$thumbrgbobj[$j]] eq
                    $objtext[$thumbrgbobj[$i]];
        next unless $objstream[$thumbrgbobj[$j]] eq
                    $objstream[$thumbrgbobj[$i]];
        last;
      }
      if ($j==$i) # not found
      {
        my $rgbstream = convertstream($objstream[$thumbrgbobj[$i]]);
        print TEX <<"END_TEX";
\\immediate\\pdfobj{<<^^J%
$objtext[$thumbrgbobj[$i]]>>^^J%
stream^^J%
$rgbstream%
endstream}%
\\DefRGB{$i}%
END_TEX
      }
      else # $j with same rgb obj
      {
        $objtext[$thumbobj[$i]] =~
          s/\\the\\pdflastobj/\\UseRGB{$j}/;
        print "* Reuses RGB object $j for $i\n" if $::opt_debug;
      }
    }

    # thumb object
    $objtext[$thumbobj[$i]] =~ s/\n/^^J%\n/mg;
    my $stream = convertstream($objstream[$thumbobj[$i]]);
    print TEX <<"END_TEX";
\\immediate\\pdfobj{<<^^J%
$objtext[$thumbobj[$i]]>>^^J%
stream^^J%
$stream%
endstream}%
\\DefThumb{$thumbpageno[$i]}%
END_TEX
  }

  print TEX "\\endinput%\n";
  close(TEX);
}

sub convertstream
{
  my @ch = split(//, $_[0]);
  my $str = "";
  my $mod = 0;
  foreach (@ch)
  {
    my $num = vec($_, 0, 8);
    if    (/ /)  { $_ = '\\ '; }
    elsif (/%/)  { $_ = '\\%'; }
    elsif (/\\/) { $_ = '\\\\'; }
    elsif (/\^/) { $_ = '\\+'; }
    elsif (/{/)  { $_ = '\\{'; }
    elsif (/}/)  { $_ = '\\}'; }
    elsif ($num == 13) { $_ = '\\/'; }
    elsif ($num < 32 || $num >= 127) {
      $_ = sprintf("^^%02x", $num);
    }
    $str .= $_;
    $mod++;
    if ($mod == 16)
    {
      $mod = 0;
      $str .= "%\n";
    }
  }
  return $str;
}

print "*** ready. ***\n" unless $::opt_quiet;

__END__
