aboutsummaryrefslogtreecommitdiffstats
path: root/doc/pspdf.pl
blob: 569f974b96afc0dbb98b783f447f06c80aabae84 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
#!/usr/bin/perl
#
# Wrapper around a variety of programs that can do PS -> PDF conversion
#

use strict;
use File::Spec;

my $compress = 1;

my $win32_ok = eval {
    require Win32::TieRegistry;
    Win32::TieRegistry->import();
    1;
};

while ($ARGV[0] =~ /^-(.*)$/) {
    my $opt = $1;
    shift @ARGV;

    if ($opt eq '-nocompress') {
        $compress = 0;
    }
}

# Ghostscript executable name.  "gs" on Unix-based systems.
my $gs = 'gs';

my ($in, $out, $fontpath) = @ARGV;

if (!defined($out)) {
    die "Usage: $0 [-nocompress] infile outfile [fontpath]\n";
}

# If Win32, help GhostScript out with some defaults
sub win32_gs_help() {
    return if (!$win32_ok);

    use Sort::Versions;
    use sort 'stable';

    my $Reg = $::Registry->Open('', {Access => 'KEY_READ', Delimiter => '/'});
    my $dir;
    my @gs;

    foreach my $k1 ('HKEY_CURRENT_USER/Software/',
                    'HKEY_LOCAL_MACHINE/SOFTWARE/') {
        foreach my $k2 ('Artifex/', '') {
            foreach my $k3 ('GPL Ghostscript/', 'AFPL Ghostscript/',
                            'Ghostscript/') {
                my $r = $Reg->{$k1.$k2.$k3};
                if (ref($r) eq 'Win32::TieRegistry') {
                    foreach my $k (keys(%$r)) {
                        my $rk = $r->{$k};
                        if (ref($rk) eq 'Win32::TieRegistry' &&
                            defined($rk->{'/GS_LIB'})) {
                            push @gs, $rk;
                        }
                    }
                }
            }
        }
    }

    @gs = sort {
        my($av) = $a->Path =~ m:^.*/([^/]+)/$:;
        my($bv) = $b->Path =~ m:^.*/([^/]+)/$:;
        versioncmp($av, $bv);
    } @gs;

    return unless (scalar(@gs));

    $ENV{'PATH'} .= ';' . $gs[0]->{'/GS_LIB'};
    $ENV{'GS_FONTPATH'} .= (defined($ENV{'GS_FONTPATH'}) ? ';' : '')
        . $ENV{'windir'}.'\\fonts';

    my $gsp = undef;
    foreach my $p (split(/\;/, $gs[0]->{'/GS_LIB'})) {
	foreach my $exe ('gswin64c.exe', 'gswin32c.exe', 'gs.exe') {
	    last if (defined($gsp));
	    my $e = File::Spec->catpath($p, $exe);
	    $gsp = $e if (-f $e && -x _);
	}
    }

    $gs = $gsp if (defined($gsp));
}

# Remove output file
unlink($out);

# 1. Acrobat distiller
my $r = system('acrodist', '-n', '-q', '--nosecurity', '-o', $out, $in);
exit 0 if ( !$r && -f $out );

# 2. ps2pdf (from Ghostscript)
#
# GhostScript uses # rather than = to separate options and values on Windows,
# it seems.  Similary it uses ; in path lists rather than :.
# Call gs directly rather than ps2pdf, because -dSAFER
# breaks font discovery on some systems, apparently.
win32_gs_help();
my $o = $win32_ok ? '#' : '=';
my $p = $win32_ok ? ';' : ':';
my $fpopt;
if (defined($fontpath)) {
    my @fplist = ();
    open(my $fp, '<', $fontpath) or die "$0: $fontpath: $!\n";
    while (my $fpe = <$fp>) {
	chomp $fpe;
	push(@fplist, $fpe);
    }
    close($fp);
    $fpopt = "-sFONTPATH${o}" . join($p, @fplist);
}

my $r = system($gs, "-dCompatibilityLevel${o}1.4",
	       "-I".File::Spec->curdir(),
	       "-P-", "-dNOPAUSE", "-dBATCH", "-sDEVICE${o}pdfwrite",
	       "-sstdout${o}%stderr", "-sOutputFile${o}${out}",
	       "-dOptimize${o}true", "-dEmbedAllFonts${o}true",
	       $fpopt,
               "-dCompressPages${o}" . ($compress ? 'true' : 'false'),
               "-dUseFlateCompression${o}true",
	       "-c", ".setpdfwrite", "-f", $in);
exit 0 if ( !$r && -f $out );

# 3. pstopdf (BSD/MacOS X utility)
my $r = system('pstopdf', $in, '-o', $out);
exit 0 if ( !$r && -f $out );

# Otherwise, fail
unlink($out);
exit 1;