File:  [Local Repository] / ratfiv / epstopdf_perl.txt
Revision 1.1.1.1 (vendor branch): download - view: text, annotated - select for diffs
Fri Jun 15 16:14:55 2001 UTC (23 years ago) by brouard
Branches: ratfiv, MAIN
CVS tags: ratfiv-103, HEAD
Created Directory Structure

    1: eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}' && eval 'exec perl -S $0 $argv:q'
    2:   if 0;
    3: use strict;
    4: 
    5: # Change by Thomas Esser, Sept. 1998: The above lines allows us to find
    6: # perl along $PATH rather than guessing a fixed location. The above
    7: # construction should work with most shells.
    8: 
    9: # A script to transform an EPS file so that:
   10: #   a) it is guarenteed to start at the 0,0 coordinate
   11: #   b) it sets a page size exactly corresponding to the BoundingBox
   12: # This means that when Ghostscript renders it, the result needs no
   13: # cropping, and the PDF MediaBox is correct.
   14: #   c) the result is piped to Ghostscript and a PDF version written
   15: #
   16: # It needs a Level 2 PS interpreter.
   17: # If the bounding box is not right, of course, you have problems...
   18: #
   19: # The only thing I have not allowed for is the case of
   20: # "%%BoundingBox: (atend)", which is more complicated.
   21: #
   22: # Sebastian Rahtz, for Elsevier Science
   23: #
   24: # now with extra tricks from Hans Hagen's texutil.
   25: #
   26: # History
   27: #  1999/05/06 v2.5 (Heiko Oberdiek)
   28: #    * New options: --hires, --exact, --filter, --help.
   29: #    * Many cosmetics: title, usage, ...
   30: #    * New code for debug, warning, error
   31: #    * Detecting of cygwin perl
   32: #    * Scanning for %%{Hires,Exact,}BoundingBox.
   33: #    * Scanning only the header in order not to get a wrong
   34: #      BoundingBox of an included file.
   35: #    * (atend) supported.
   36: #    * uses strict; (earlier error detecting).
   37: #    * changed first comment from '%!PS' to '%!';
   38: #    * corrected (atend) pattern: '\s*\(atend\)'
   39: #    * using of $bbxpat in all BoundingBox cases,
   40: #      correct the first white space to '...Box:\s*$bb...'
   41: #    * corrected first line (one line instead of two before 'if 0;';
   42: #
   43: 
   44: ### program identification
   45: my $program = "epstopdf";
   46: my $filedate="1999/05/06";
   47: my $fileversion="2.5";
   48: my $copyright = "Copyright 1998,1999 by Sebastian Rahtz et al.";
   49: my $title = "\U$program\E $fileversion, $filedate - $copyright\n";
   50: 
   51: ### ghostscript command name
   52: my $GS = "gs";
   53: $GS = "gswin32c" if $^O eq 'MSWin32';
   54: $GS = "gswin32c" if $^O =~ /cygwin/;
   55: 
   56: ### options
   57: $::opt_help=0;
   58: $::opt_debug=0;
   59: $::opt_compress=1;
   60: $::opt_gs=1;
   61: $::opt_hires=0;
   62: $::opt_exact=0;
   63: $::opt_filter=0;
   64: $::opt_outfile="";
   65: 
   66: ### usage
   67: my @bool = ("false", "true");
   68: my $usage = <<"END_OF_USAGE";
   69: ${title}Syntax:  $program [options] <eps file>
   70: Options:
   71:   --help:           print usage
   72:   --outfile=<file>: write result to <file>
   73:   --(no)filter:     read standard input   (default: $bool[$::opt_filter])
   74:   --(no)gs:         run ghostscript       (default: $bool[$::opt_gs])
   75:   --(no)compress:   use compression       (default: $bool[$::opt_compress])
   76:   --(no)hires:      scan HiresBoundingBox (default: $bool[$::opt_hires])
   77:   --(no)exact:      scan ExactBoundingBox (default: $bool[$::opt_exact])
   78:   --(no)debug:      debug informations    (default: $bool[$::opt_debug])
   79: Examples for producing 'test.pdf':
   80:   * $program test.eps
   81:   * produce postscript | $program --filter >test.pdf
   82:   * produce postscript | $program -f -d -o=test.pdf
   83: Example: look for HiresBoundingBox and produce corrected PostScript:
   84:   * $program -d --nogs -hires test.ps>testcorr.ps 
   85: END_OF_USAGE
   86: 
   87: ### process options
   88: use Getopt::Long;
   89: GetOptions (
   90:   "help!",
   91:   "debug!",
   92:   "filter!",
   93:   "compress!",
   94:   "gs!",
   95:   "hires!",
   96:   "exact!",
   97:   "outfile=s",
   98: ) or die $usage;
   99: 
  100: ### help functions
  101: sub debug {
  102:   print STDERR "* @_\n" if $::opt_debug;
  103: }
  104: sub warning {
  105:   print STDERR "==> Warning: @_!\n";
  106: }
  107: sub error {
  108:   die "$title!!! Error: @_!\n";
  109: }
  110: sub errorUsage {
  111:   die "$usage\n!!! Error: @_!\n";
  112: }
  113: 
  114: ### option help
  115: die $usage if $::opt_help;
  116: 
  117: ### get input filename
  118: my $InputFilename = "";
  119: if ($::opt_filter) {
  120:   @ARGV == 0 or 
  121:     die errorUsage "Input file cannot be used with filter option";
  122:   $InputFilename = "-";
  123:   debug "Input file: standard input";
  124: }
  125: else {
  126:   @ARGV > 0 or die errorUsage "Input filename missing";
  127:   @ARGV < 2 or die errorUsage "Unknown option or too many input files";
  128:   $InputFilename = $ARGV[0];
  129:   -f $InputFilename or error "'$InputFilename' does not exist";
  130:   debug "Input filename:", $InputFilename;
  131: }
  132: 
  133: ### option compress
  134: my $GSOPTS = "";
  135: $GSOPTS = "-dUseFlateCompression=false " unless $::opt_compress;
  136: 
  137: ### option BoundingBox types
  138: my $BBName = "%%BoundingBox:";
  139: !($::opt_hires and $::opt_exact) or
  140:   error "Options --hires and --exact cannot be used together";
  141: $BBName = "%%HiresBoundingBox:" if $::opt_hires;
  142: $BBName = "%%ExactBoundingBox:" if $::opt_exact;
  143: debug "BoundingBox comment:", $BBName;
  144: 
  145: ### option outfile
  146: my $OutputFilename = $::opt_outfile;
  147: if ($OutputFilename eq "") {
  148:   if ($::opt_gs) {
  149:     $OutputFilename = $InputFilename;
  150:     if (!$::opt_filter) {
  151:       $OutputFilename =~ s/\.[^\.]*$//;
  152:       $OutputFilename .= ".pdf";
  153:     }
  154:   }
  155:   else {
  156:     $OutputFilename = "-"; # standard output
  157:   }
  158: }
  159: if ($::opt_filter) {
  160:   debug "Output file: standard output";
  161: }
  162: else {
  163:   debug "Output filename:", $OutputFilename;
  164: }
  165: 
  166: ### option gs
  167: if ($::opt_gs) {
  168:   debug "Ghostscript command:", $GS;
  169:   debug "Compression:", ($::opt_compress) ? "on" : "off";
  170: }
  171: 
  172: ### open input file
  173: open(IN,"<$InputFilename") or error "Cannot open", 
  174:   ($::opt_filter) ? "standard input" : "'$InputFilename'";
  175: binmode IN;
  176: 
  177: ### open output file
  178: if ($::opt_gs) {
  179:   my $pipe = "$GS -q -sDEVICE=pdfwrite $GSOPTS " .
  180:           "-sOutputFile=$OutputFilename - -c quit";
  181:   debug "Ghostscript pipe:", $pipe;
  182:   open(OUT,"|$pipe") or error "Cannot open Ghostscript for piped input";
  183: }
  184: else {
  185:   open(OUT,">$OutputFilename") or error "Cannot write '$OutputFilename";
  186: }
  187: 
  188: ### scan first line
  189: my $header = 0;
  190: $_ = <IN>;
  191: if (/%!/) {
  192:   # throw away binary junk before %!
  193:   s/(.*)%!/%!/o;
  194: }
  195: $header = 1 if /^%/;
  196: debug "Scanning header for BoundingBox";
  197: print OUT;
  198: 
  199: ### variables and pattern for BoundingBox search
  200: my $bbxpatt = '[0-9eE\.\-]';
  201:                # protect backslashes: "\\" gets '\'
  202: my $BBValues = "\\s*($bbxpatt+)\\s+($bbxpatt+)\\s+($bbxpatt+)\\s+($bbxpatt+)";
  203: my $BBCorrected = 0;
  204: 
  205: sub CorrectBoundingBox {
  206:   my ($llx, $lly, $urx, $ury) = @_;
  207:   debug "Old BoundingBox:", $llx, $lly, $urx, $ury;
  208:   my ($width, $height) = ($urx - $llx, $ury - $lly);
  209:   my ($xoffset, $yoffset) = (-$llx, -$lly);
  210:   debug "New BoundingBox: 0 0", $width, $height;
  211:   debug "Offset:", $xoffset, $yoffset;
  212: 
  213:   print OUT "%%BoundingBox: 0 0 $width $height\n";
  214:   print OUT "<< /PageSize [$width $height] >> setpagedevice\n";
  215:   print OUT "gsave $xoffset $yoffset translate\n";
  216: }
  217: 
  218: ### scan header
  219: if ($header) {
  220:   while (<IN>) {
  221: 
  222:     ### end of header
  223:     if (!/^%/ or /^%%EndComments/) {
  224:       print OUT;
  225:       last;
  226:     }
  227: 
  228:     ### BoundingBox with values
  229:     if (/^$BBName$BBValues/) {
  230:       CorrectBoundingBox $1, $2, $3, $4;
  231:       $BBCorrected = 1;
  232:       last;
  233:     }
  234: 
  235:     ### BoundingBox with (atend)
  236:     if (/^$BBName\s*\(atend\)/) {
  237:       debug $BBName, "(atend)";
  238:       if ($::opt_filter) {
  239:         warning "Cannot look for BoundingBox in the trailer",
  240:                 "with option --filter";
  241:         last;
  242:       }
  243:       my $pos = tell(IN);
  244:       debug "Current file position:", $pos;
  245: 
  246:       # looking for %%BoundingBox
  247:       while (<IN>) {
  248:         # skip over included documents
  249:         if (/^%%BeginDocument/) {
  250:           while (<IN>) {
  251:             last if /^%%EndDocument/;
  252:           }
  253:         }
  254:         if (/^$BBName$BBValues/) {
  255:           CorrectBoundingBox $1, $2, $3, $4;
  256:           $BBCorrected = 1;
  257:           last;
  258:         }
  259:       }
  260: 
  261:       # go back
  262:       seek(IN, $pos, 0) or error "Cannot go back to line '$BBName (atend)'";
  263:       last;
  264:     }
  265:     
  266:     # print header line
  267:     print OUT;
  268:   }
  269: }
  270: 
  271: ### print rest of file
  272: while (<IN>) {
  273:   print OUT;
  274: }
  275: 
  276: ### close files
  277: close(IN);
  278: print OUT "grestore\n" if $BBCorrected;
  279: close(OUT);
  280: warning "BoundingBox not found" unless $BBCorrected;
  281: debug "Ready.";
  282: ;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>