File Coverage

blib/lib/PostScript/Convert.pm
Criterion Covered Total %
statement 21 137 15.3
branch 0 88 0.0
condition 0 29 0.0
subroutine 7 16 43.7
pod 1 9 11.1
total 29 279 10.3


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__