line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
2
|
|
|
|
|
|
|
package PostScript::Convert; |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# Copyright 2012 Christopher J. Madsen |
5
|
|
|
|
|
|
|
# |
6
|
|
|
|
|
|
|
# Author: Christopher J. Madsen |
7
|
|
|
|
|
|
|
# Created: November 9, 2009 |
8
|
|
|
|
|
|
|
# |
9
|
|
|
|
|
|
|
# This program is free software; you can redistribute it and/or modify |
10
|
|
|
|
|
|
|
# it under the same terms as Perl itself. |
11
|
|
|
|
|
|
|
# |
12
|
|
|
|
|
|
|
# This program is distributed in the hope that it will be useful, |
13
|
|
|
|
|
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
14
|
|
|
|
|
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either the |
15
|
|
|
|
|
|
|
# GNU General Public License or the Artistic License for more details. |
16
|
|
|
|
|
|
|
# |
17
|
|
|
|
|
|
|
# ABSTRACT: Use Ghostscript to convert PostScript or PDF to other formats |
18
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
19
|
|
|
|
|
|
|
|
20
|
1
|
|
|
1
|
|
27437
|
use 5.008; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
57
|
|
21
|
|
|
|
|
|
|
our $VERSION = '0.03'; ## no critic |
22
|
|
|
|
|
|
|
|
23
|
1
|
|
|
1
|
|
7
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
43
|
|
24
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
31
|
|
25
|
1
|
|
|
1
|
|
5
|
use Carp qw(croak verbose); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
187
|
|
26
|
1
|
|
|
1
|
|
7
|
use File::Spec (); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
31
|
|
27
|
1
|
|
|
1
|
|
5
|
use Scalar::Util qw(blessed openhandle reftype); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
138
|
|
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
|
30
|
1
|
|
|
1
|
|
110
|
use Exporter 5.57 'import'; # exported import method |
|
1
|
|
|
|
|
22
|
|
|
1
|
|
|
|
|
3718
|
|
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
our @EXPORT = qw(psconvert); |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
#===================================================================== |
35
|
|
|
|
|
|
|
# Package PostScript::Convert: |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
our $Debug; # Set this to a true value for debugging output to STDERR |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
our %default = ( |
40
|
|
|
|
|
|
|
ghostscript => ($^O =~ 'MSWin32' ? 'gswin32c.exe' : 'gs'), |
41
|
|
|
|
|
|
|
); |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
our %format = do { |
44
|
|
|
|
|
|
|
my @png_param = ( |
45
|
|
|
|
|
|
|
extension => 'png', |
46
|
|
|
|
|
|
|
format_param => [qw(-dTextAlphaBits=4 -dGraphicsAlphaBits=4)], |
47
|
|
|
|
|
|
|
); |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
my @pdf_param = ( |
50
|
|
|
|
|
|
|
device => 'pdfwrite', |
51
|
|
|
|
|
|
|
extension => 'pdf', |
52
|
|
|
|
|
|
|
format_code => [qw(-c .setpdfwrite)], |
53
|
|
|
|
|
|
|
'format_param' # => VALUE |
54
|
|
|
|
|
|
|
); |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
( |
57
|
|
|
|
|
|
|
png => { device => 'png16m', @png_param }, |
58
|
|
|
|
|
|
|
pnggray => { device => 'pnggray', @png_param }, |
59
|
|
|
|
|
|
|
pngmono => { device => 'pngmono', extension => 'png' }, |
60
|
|
|
|
|
|
|
jpeggray=> { device => 'jpeggray', extension => 'jpeg' }, |
61
|
|
|
|
|
|
|
jpeg => { device => 'jpeg', extension => 'jpeg' }, |
62
|
|
|
|
|
|
|
jpg => { device => 'jpeg', extension => 'jpg' }, |
63
|
|
|
|
|
|
|
pdf14 => { @pdf_param => ['-dCompatibilityLevel=1.4'] }, |
64
|
|
|
|
|
|
|
pdf13 => { @pdf_param => ['-dCompatibilityLevel=1.3'] }, |
65
|
|
|
|
|
|
|
pdf12 => { @pdf_param => ['-dCompatibilityLevel=1.2'] }, |
66
|
|
|
|
|
|
|
); |
67
|
|
|
|
|
|
|
}; # end %format |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
$format{pdf} = $format{pdf14}; |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
our %paper_size = ( |
72
|
|
|
|
|
|
|
executive => [522, 756], |
73
|
|
|
|
|
|
|
folio => [595, 935], |
74
|
|
|
|
|
|
|
'half-letter' => [612, 397], |
75
|
|
|
|
|
|
|
letter => [612, 792], |
76
|
|
|
|
|
|
|
legal => [612, 1008], |
77
|
|
|
|
|
|
|
tabloid => [792, 1224], |
78
|
|
|
|
|
|
|
superb => [843, 1227], |
79
|
|
|
|
|
|
|
ledger => [1224, 792], |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
'comm #10 envelope' => [297, 684], |
82
|
|
|
|
|
|
|
'envelope-monarch' => [280, 542], |
83
|
|
|
|
|
|
|
'envelope-c5' => [459.21260, 649.13386], |
84
|
|
|
|
|
|
|
'envelope-dl' => [311.81102, 623.62205], |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
a0 => [2383.93701, 3370.39370], |
87
|
|
|
|
|
|
|
a1 => [1683.77953, 2383.93701], |
88
|
|
|
|
|
|
|
a2 => [1190.55118, 1683.77953], |
89
|
|
|
|
|
|
|
a3 => [ 841.88976, 1190.55118], |
90
|
|
|
|
|
|
|
a4 => [ 595.27559, 841.88976], |
91
|
|
|
|
|
|
|
a5 => [ 419.52756, 595.27559], |
92
|
|
|
|
|
|
|
a6 => [ 297.63780, 419.52756], |
93
|
|
|
|
|
|
|
a7 => [ 209.76378, 297.63780], |
94
|
|
|
|
|
|
|
a8 => [ 147.40157, 209.76378], |
95
|
|
|
|
|
|
|
a9 => [ 104.88189, 147.40157], |
96
|
|
|
|
|
|
|
a10 => [ 73.70079, 104.88189], |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
b0 => [2834.64567, 4008.18898], |
99
|
|
|
|
|
|
|
b1 => [2004.09449, 2834.64567], |
100
|
|
|
|
|
|
|
b2 => [1417.32283, 2004.09449], |
101
|
|
|
|
|
|
|
b3 => [1000.62992, 1417.32283], |
102
|
|
|
|
|
|
|
b4 => [ 708.66142, 1000.62992], |
103
|
|
|
|
|
|
|
b5 => [ 498.89764, 708.66142], |
104
|
|
|
|
|
|
|
b6 => [ 354.33071, 498.89764], |
105
|
|
|
|
|
|
|
b7 => [ 249.44882, 354.33071], |
106
|
|
|
|
|
|
|
b8 => [ 175.74803, 249.44882], |
107
|
|
|
|
|
|
|
b9 => [ 124.72441, 175.74803], |
108
|
|
|
|
|
|
|
b10 => [ 87.87402, 124.72441], |
109
|
|
|
|
|
|
|
); |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
$paper_size{"us-$_"} = $paper_size{$_} for qw(letter legal); |
112
|
|
|
|
|
|
|
$paper_size{europostcard} = $paper_size{a6}; |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
115
|
|
|
|
|
|
|
sub psconvert |
116
|
|
|
|
|
|
|
{ |
117
|
0
|
|
|
0
|
1
|
|
my $ps = shift; |
118
|
|
|
|
|
|
|
|
119
|
0
|
0
|
|
|
|
|
unshift @_, 'filename' if @_ % 2; |
120
|
0
|
|
|
|
|
|
my %opt = (%default, @_); |
121
|
|
|
|
|
|
|
|
122
|
0
|
0
|
|
|
|
|
return convert_fh( openhandle $ps, \%opt) if openhandle $ps; |
123
|
0
|
0
|
|
|
|
|
return convert_object($ps, \%opt) if blessed $ps; |
124
|
0
|
0
|
|
|
|
|
return convert_ref( $ps, \%opt) if ref $ps; |
125
|
0
|
|
|
|
|
|
convert_filename( $ps, \%opt); |
126
|
|
|
|
|
|
|
} # end psconvert |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
129
|
|
|
|
|
|
|
sub convert_object |
130
|
|
|
|
|
|
|
{ |
131
|
0
|
|
|
0
|
0
|
|
my ($obj, $opt) = @_; |
132
|
|
|
|
|
|
|
|
133
|
0
|
0
|
|
|
|
|
return convert_psfile($obj, $opt) if $obj->isa('PostScript::File'); |
134
|
|
|
|
|
|
|
|
135
|
0
|
0
|
|
|
|
|
return convert_psfile($obj->get__PostScript_File, $opt) |
136
|
|
|
|
|
|
|
if $obj->can('get__PostScript_File'); |
137
|
|
|
|
|
|
|
|
138
|
0
|
|
|
|
|
|
croak "Don't know how to handle a " . blessed($obj); |
139
|
|
|
|
|
|
|
} # end convert_object |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
143
|
|
|
|
|
|
|
sub convert_psfile |
144
|
|
|
|
|
|
|
{ |
145
|
0
|
|
|
0
|
0
|
|
my ($ps, $opt) = @_; |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
# Check version of PostScript::File: |
148
|
0
|
|
|
|
|
|
my $v = PostScript::File->VERSION; |
149
|
0
|
0
|
|
|
|
|
croak "Must have PostScript::File 2.00 or later, this is only $v" |
150
|
|
|
|
|
|
|
unless $v >= 2; |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
# Get paper size, if necessary: |
154
|
0
|
|
0
|
|
|
|
$opt->{paper_size} ||= [ $ps->get_width, $ps->get_height ]; |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
# Save old filename: |
157
|
0
|
|
|
|
|
|
my $oldFN = $ps->get_filename; |
158
|
0
|
0
|
0
|
|
|
|
$opt->{input} ||= "$oldFN.ps" if defined $oldFN; |
159
|
|
|
|
|
|
|
|
160
|
0
|
|
|
|
|
|
require File::Temp; File::Temp->VERSION(0.19); # need newdir method |
|
0
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
|
162
|
0
|
0
|
0
|
|
|
|
if ($ps->get_eps and $ps->get_pagecount > 1) { |
163
|
|
|
|
|
|
|
# Compute output filename: |
164
|
0
|
|
|
|
|
|
apply_format($opt); |
165
|
0
|
|
|
|
|
|
my ($outVol, $outDir, $outFN) = |
166
|
|
|
|
|
|
|
File::Spec->splitpath( guess_output_filename($opt) ); |
167
|
|
|
|
|
|
|
|
168
|
0
|
0
|
|
|
|
|
$outFN =~ s/(\.\w+)$// or croak "No extension in $outFN"; |
169
|
0
|
|
|
|
|
|
my $ext = $1; |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
|
172
|
0
|
|
|
|
|
|
my $dir = File::Temp->newdir; |
173
|
|
|
|
|
|
|
|
174
|
0
|
|
|
|
|
|
my $oldExt = $ps->get_file_ext; |
175
|
0
|
|
|
|
|
|
$ps->set_filename($outFN, $dir); |
176
|
0
|
|
|
|
|
|
$ps->set_file_ext(undef); |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
# Process the file(s): |
179
|
0
|
|
|
|
|
|
my @files = $ps->output; |
180
|
|
|
|
|
|
|
|
181
|
0
|
|
|
|
|
|
foreach my $fn (@files) { |
182
|
0
|
|
|
|
|
|
$outFN = (File::Spec->splitpath($fn))[2]; |
183
|
0
|
0
|
|
|
|
|
$outFN =~ s/\.\w+$/$ext/ or die "Expected extension in $outFN"; |
184
|
|
|
|
|
|
|
|
185
|
0
|
|
|
|
|
|
$opt->{filename} = File::Spec->catpath( $outVol, $outDir, $outFN ); |
186
|
|
|
|
|
|
|
|
187
|
0
|
|
|
|
|
|
convert_filename($fn, $opt); |
188
|
|
|
|
|
|
|
} # end foreach $fn in @files |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
# Restore settings: |
191
|
0
|
|
|
|
|
|
$ps->set_filename($oldFN); |
192
|
0
|
|
|
|
|
|
$ps->set_file_ext($oldExt); |
193
|
|
|
|
|
|
|
} # end if EPS with multiple pages |
194
|
|
|
|
|
|
|
else { |
195
|
|
|
|
|
|
|
# Only one file, we don't need a temporary directory: |
196
|
0
|
|
|
|
|
|
my $fh = File::Temp->new; |
197
|
|
|
|
|
|
|
|
198
|
0
|
|
|
|
|
|
$ps->output($fh); |
199
|
|
|
|
|
|
|
|
200
|
0
|
0
|
|
|
|
|
seek($fh, 0,0) or croak "Can't seek temporary file: $!"; |
201
|
|
|
|
|
|
|
|
202
|
0
|
|
|
|
|
|
convert_fh($fh, $opt); |
203
|
|
|
|
|
|
|
} # end else only one PostScript file to process |
204
|
|
|
|
|
|
|
} # end convert_psfile |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
207
|
|
|
|
|
|
|
sub convert_ref |
208
|
|
|
|
|
|
|
{ |
209
|
0
|
|
|
0
|
0
|
|
my ($ref, $opt) = @_; |
210
|
|
|
|
|
|
|
|
211
|
0
|
|
|
|
|
|
my $type = reftype $ref; |
212
|
|
|
|
|
|
|
|
213
|
0
|
0
|
0
|
|
|
|
croak "Don't know how to handle a $type ref" |
214
|
|
|
|
|
|
|
unless $type eq 'SCALAR' or $type eq 'ARRAY'; |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
|
217
|
0
|
|
|
|
|
|
require File::Temp; |
218
|
|
|
|
|
|
|
|
219
|
0
|
|
|
|
|
|
my $fh = File::Temp->new; |
220
|
|
|
|
|
|
|
|
221
|
0
|
0
|
|
|
|
|
if ($type eq 'ARRAY') { print $fh @$ref } |
|
0
|
|
|
|
|
|
|
222
|
0
|
|
|
|
|
|
else { print $fh $$ref } |
223
|
|
|
|
|
|
|
|
224
|
0
|
0
|
|
|
|
|
seek($fh, 0,0) or croak "Can't seek temporary file: $!"; |
225
|
|
|
|
|
|
|
|
226
|
0
|
|
|
|
|
|
convert_fh($fh, $opt); |
227
|
|
|
|
|
|
|
} # end convert_ref |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
230
|
|
|
|
|
|
|
sub convert_filename |
231
|
|
|
|
|
|
|
{ |
232
|
0
|
|
|
0
|
0
|
|
my ($filename, $opt) = @_; |
233
|
|
|
|
|
|
|
|
234
|
0
|
|
0
|
|
|
|
$opt->{input} ||= $filename; |
235
|
0
|
0
|
|
|
|
|
open(my $in, '<:raw', $filename) or croak "Unable to open $filename: $!"; |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
|
238
|
0
|
|
|
|
|
|
convert_fh($in, $opt); |
239
|
|
|
|
|
|
|
} # end convert_filename |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
242
|
|
|
|
|
|
|
sub check_options |
243
|
|
|
|
|
|
|
{ |
244
|
0
|
|
|
0
|
0
|
|
my ($opt) = @_; |
245
|
|
|
|
|
|
|
|
246
|
0
|
|
0
|
|
|
|
my @cmd = ($opt->{ghostscript} || croak "ghostscript not defined"); |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
|
249
|
0
|
0
|
|
|
|
|
foreach my $dir (@{ $opt->{include} || [] }) { |
|
0
|
|
|
|
|
|
|
250
|
0
|
|
|
|
|
|
push @cmd, "-I$dir"; |
251
|
|
|
|
|
|
|
} # end foreach $dir |
252
|
|
|
|
|
|
|
|
253
|
0
|
|
|
|
|
|
push @cmd, qw(-q -sstdout=%stderr -dBATCH -dNOPAUSE); |
254
|
0
|
0
|
|
|
|
|
push @cmd, ($opt->{unsafe} ? '-dNOSAFER' : '-dSAFER'); |
255
|
|
|
|
|
|
|
|
256
|
0
|
|
|
|
|
|
apply_format($opt); |
257
|
|
|
|
|
|
|
|
258
|
0
|
|
|
|
|
|
push @cmd, "-sOutputFile=" . guess_output_filename($opt); |
259
|
|
|
|
|
|
|
|
260
|
0
|
|
|
|
|
|
my $device = $opt->{device}; |
261
|
0
|
0
|
0
|
|
|
|
croak "No output device supplied" unless defined $device and length $device; |
262
|
0
|
|
|
|
|
|
push @cmd, "-sDEVICE=$device"; |
263
|
|
|
|
|
|
|
|
264
|
0
|
0
|
|
|
|
|
if (defined(my $size = $opt->{paper_size})) { |
265
|
0
|
0
|
|
|
|
|
unless (ref $size) { |
266
|
0
|
0
|
|
|
|
|
if ($paper_size{lc $size}) { |
|
|
0
|
|
|
|
|
|
267
|
0
|
|
|
|
|
|
$size = $paper_size{lc $size}; |
268
|
|
|
|
|
|
|
} elsif ($size =~ /\A(\d+(?:\.\d+)?)x(\d+(?:\.\d+)?)\Z/i) { |
269
|
0
|
|
|
|
|
|
$size = [ $1 * 72, $2 * 72 ]; |
270
|
|
|
|
|
|
|
} else { |
271
|
0
|
|
|
|
|
|
croak "Unknown paper size '$size'"; |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
} |
275
|
|
|
|
|
|
|
} # end unless ref $size |
276
|
0
|
|
|
|
|
|
push @cmd, '-dDEVICEWIDTHPOINTS=' . $size->[0], |
277
|
|
|
|
|
|
|
'-dDEVICEHEIGHTPOINTS=' . $size->[1]; |
278
|
|
|
|
|
|
|
} # end if $opt->{paper_size} |
279
|
|
|
|
|
|
|
|
280
|
0
|
0
|
|
|
|
|
push @cmd, "-r$opt->{resolution}" if $opt->{resolution}; |
281
|
0
|
0
|
|
|
|
|
push @cmd, @{ $opt->{format_param} } if $opt->{format_param}; |
|
0
|
|
|
|
|
|
|
282
|
0
|
0
|
|
|
|
|
push @cmd, @{ $opt->{gs_param} } if $opt->{gs_param}; |
|
0
|
|
|
|
|
|
|
283
|
0
|
0
|
|
|
|
|
push @cmd, @{ $opt->{format_code} } if $opt->{format_code}; |
|
0
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
|
285
|
0
|
0
|
|
|
|
|
print STDERR "@cmd\n" if $Debug; |
286
|
|
|
|
|
|
|
|
287
|
0
|
|
|
|
|
|
@cmd; |
288
|
|
|
|
|
|
|
} # end check_options |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
291
|
|
|
|
|
|
|
sub apply_format |
292
|
|
|
|
|
|
|
{ |
293
|
0
|
|
|
0
|
0
|
|
my ($opt) = @_; |
294
|
|
|
|
|
|
|
|
295
|
0
|
0
|
|
|
|
|
unless ($opt->{format}) { |
296
|
0
|
|
|
|
|
|
my $outFN = $opt->{filename}; |
297
|
|
|
|
|
|
|
|
298
|
0
|
0
|
0
|
|
|
|
croak "No output format or filename supplied" |
299
|
|
|
|
|
|
|
unless defined $outFN and length $outFN; |
300
|
|
|
|
|
|
|
|
301
|
0
|
0
|
|
|
|
|
$outFN =~ /\.([^.\s]+)$/ or croak "Unable to determine format from $outFN"; |
302
|
0
|
0
|
|
|
|
|
$format{ $opt->{format} = lc $1 } or croak "Unknown extension .$1"; |
303
|
|
|
|
|
|
|
} |
304
|
|
|
|
|
|
|
|
305
|
0
|
0
|
|
|
|
|
my $fmt = $format{ $opt->{format} } or croak "Unknown format $opt->{format}"; |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
|
308
|
0
|
|
|
|
|
|
while (my ($key, $val) = each %$fmt) { |
309
|
0
|
0
|
|
|
|
|
$opt->{$key} = $val unless defined $opt->{key}; |
310
|
|
|
|
|
|
|
} |
311
|
|
|
|
|
|
|
} # end apply_format |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
314
|
|
|
|
|
|
|
sub guess_output_filename |
315
|
|
|
|
|
|
|
{ |
316
|
0
|
|
|
0
|
0
|
|
my ($opt) = @_; |
317
|
|
|
|
|
|
|
|
318
|
0
|
|
|
|
|
|
my $fn = $opt->{filename}; |
319
|
|
|
|
|
|
|
|
320
|
0
|
0
|
|
|
|
|
CHOICE: { |
321
|
0
|
|
|
|
|
|
last CHOICE if defined $fn; |
322
|
|
|
|
|
|
|
|
323
|
0
|
|
|
|
|
|
$fn = $opt->{input}; |
324
|
0
|
0
|
0
|
|
|
|
last CHOICE unless defined $fn and length $fn; |
325
|
|
|
|
|
|
|
|
326
|
0
|
|
|
|
|
|
my $ext = $opt->{extension}; |
327
|
0
|
0
|
|
|
|
|
croak "No extension defined for format $opt->{format}" unless $ext; |
328
|
|
|
|
|
|
|
|
329
|
0
|
|
|
|
|
|
$fn =~ s/(?:\.\w*)?$/.$ext/; |
330
|
|
|
|
|
|
|
} |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
|
333
|
0
|
0
|
0
|
|
|
|
croak "No output filename supplied" unless defined $fn and length $fn; |
334
|
|
|
|
|
|
|
|
335
|
0
|
|
|
|
|
|
$fn; |
336
|
|
|
|
|
|
|
} # end guess_output_filename |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
#--------------------------------------------------------------------- |
339
|
|
|
|
|
|
|
sub convert_fh |
340
|
|
|
|
|
|
|
{ |
341
|
0
|
|
|
0
|
0
|
|
my ($fh, $opt) = @_; |
342
|
|
|
|
|
|
|
|
343
|
0
|
|
|
|
|
|
my @cmd = (check_options($opt), '-_'); |
344
|
|
|
|
|
|
|
|
345
|
0
|
0
|
|
|
|
|
open(my $oldin, '<&STDIN') or croak "Can't dup STDIN: $!"; |
346
|
0
|
0
|
|
|
|
|
open(STDIN, '<&', $fh) or croak "Can't redirect STDIN: $!"; |
347
|
0
|
|
|
|
|
|
system @cmd; |
348
|
0
|
0
|
|
|
|
|
open(STDIN, '<&', $oldin) or croak "Can't restore STDIN: $!"; |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
|
351
|
0
|
0
|
|
|
|
|
if ($?) { |
352
|
0
|
|
|
|
|
|
my $exit = $? >> 8; |
353
|
0
|
|
|
|
|
|
my $signal = $? & 127; |
354
|
0
|
|
|
|
|
|
my $core = $? & 128; |
355
|
|
|
|
|
|
|
|
356
|
0
|
|
|
|
|
|
my $err = "Ghostscript failed: exit status $exit"; |
357
|
0
|
0
|
|
|
|
|
$err .= " (signal $signal)" if $signal; |
358
|
0
|
0
|
|
|
|
|
$err .= " (core dumped)" if $core; |
359
|
|
|
|
|
|
|
|
360
|
0
|
|
|
|
|
|
croak $err; |
361
|
|
|
|
|
|
|
} # end if ghostscript failed |
362
|
|
|
|
|
|
|
} # end convert_fh |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
#===================================================================== |
365
|
|
|
|
|
|
|
# Package Return Value: |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
1; |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
__END__ |