doc/pspdf.pl

   1 #!/usr/bin/perl
   2 #
   3 # Wrapper around a variety of programs that can do PS -> PDF conversion
   4 #
   5
   6 use strict;
   7 use File::Spec;
   8
   9 my $compress = 1;
  10
  11 my $win32_ok = eval {
  12     require Win32::TieRegistry;
  13     Win32::TieRegistry->import();
  14     1;
  15 };
  16
  17 while ($ARGV[0] =~ /^-(.*)$/) {
  18     my $opt = $1;
  19     shift @ARGV;
  20
  21     if ($opt eq '-nocompress') {
  22         $compress = 0;
  23     }
  24 }
  25
  26 # Ghostscript executable name.  "gs" on Unix-based systems.
  27 my $gs = 'gs';
  28
  29 my ($in, $out, $fontpath) = @ARGV;
  30
  31 if (!defined($out)) {
  32     die "Usage: $0 [-nocompress] infile outfile [fontpath]\n";
  33 }
  34
  35 # If Win32, help GhostScript out with some defaults
  36 sub win32_gs_help() {
  37     return if (!$win32_ok);
  38
  39     use Sort::Versions;
  40     use sort 'stable';
  41
  42     my $Reg = $::Registry->Open('', {Access => 'KEY_READ', Delimiter => '/'});
  43     my $dir;
  44     my @gs;
  45
  46     foreach my $k1 ('HKEY_CURRENT_USER/Software/',
  47                     'HKEY_LOCAL_MACHINE/SOFTWARE/') {
  48         foreach my $k2 ('Artifex/', '') {
  49             foreach my $k3 ('GPL Ghostscript/', 'AFPL Ghostscript/',
  50                             'Ghostscript/') {
  51                 my $r = $Reg->{$k1.$k2.$k3};
  52                 if (ref($r) eq 'Win32::TieRegistry') {
  53                     foreach my $k (keys(%$r)) {
  54                         my $rk = $r->{$k};
  55                         if (ref($rk) eq 'Win32::TieRegistry' &&
  56                             defined($rk->{'/GS_LIB'})) {
  57                             push @gs, $rk;
  58                         }
  59                     }
  60                 }
  61             }
  62         }
  63     }
  64
  65     @gs = sort {
  66         my($av) = $a->Path =~ m:^.*/([^/]+)/$:;
  67         my($bv) = $b->Path =~ m:^.*/([^/]+)/$:;
  68         versioncmp($av, $bv);
  69     } @gs;
  70
  71     return unless (scalar(@gs));
  72
  73     $ENV{'PATH'} .= ';' . $gs[0]->{'/GS_LIB'};
  74     $ENV{'GS_FONTPATH'} .= (defined($ENV{'GS_FONTPATH'}) ? ';' : '')
  75         . $ENV{'windir'}.'\\fonts';
  76
  77     my $gsp = undef;
  78     foreach my $p (split(/\;/, $gs[0]->{'/GS_LIB'})) {
  79         foreach my $exe ('gswin64c.exe', 'gswin32c.exe', 'gs.exe') {
  80             last if (defined($gsp));
  81             my $e = File::Spec->catpath($p, $exe);
  82             $gsp = $e if (-f $e && -x _);
  83         }
  84     }
  85
  86     $gs = $gsp if (defined($gsp));
  87 }
  88
  89 # Remove output file
  90 unlink($out);
  91
  92 # 1. Acrobat distiller
  93 my $r = system('acrodist', '-n', '-q', '--nosecurity', '-o', $out, $in);
  94 exit 0 if ( !$r && -f $out );
  95
  96 # 2. ps2pdf (from Ghostscript)
  97 #
  98 # GhostScript uses # rather than = to separate options and values on Windows,
  99 # it seems.  Similary it uses ; in path lists rather than :.
 100 # Call gs directly rather than ps2pdf, because -dSAFER
 101 # breaks font discovery on some systems, apparently.
 102 win32_gs_help();
 103 my $o = $win32_ok ? '#' : '=';
 104 my $p = $win32_ok ? ';' : ':';
 105 my $fpopt;
 106 if (defined($fontpath)) {
 107     my @fplist = ();
 108     open(my $fp, '<', $fontpath) or die "$0: $fontpath: $!\n";
 109     while (my $fpe = <$fp>) {
 110         chomp $fpe;
 111         push(@fplist, $fpe);
 112     }
 113     close($fp);
 114     $fpopt = "-sFONTPATH${o}" . join($p, @fplist);
 115 }
 116
 117 my $r = system($gs, "-dCompatibilityLevel${o}1.4", "-q",
 118                "-P-", "-dNOPAUSE", "-dBATCH", "-sDEVICE${o}pdfwrite",
 119                "-sstdout${o}%stderr", "-sOutputFile${o}${out}",
 120                "-dOptimize${o}true", "-dEmbedAllFonts${o}true",
 121                $fpopt,
 122                "-dCompressPages${o}" . ($compress ? 'true' : 'false'),
 123                "-dUseFlateCompression${o}true",
 124                "-c", ".setpdfwrite", "-f", $in);
 125 exit 0 if ( !$r && -f $out );
 126
 127 # 3. pstopdf (BSD/MacOS X utility)
 128 my $r = system('pstopdf', $in, '-o', $out);
 129 exit 0 if ( !$r && -f $out );
 130
 131 # Otherwise, fail
 132 unlink($out);
 133 exit 1;