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

#---------------------------------------------------------------------
package PostScript::Convert;
#
# Copyright 2012 Christopher J. Madsen
#
# Author: Christopher J. Madsen
# Created: November 9, 2009
#
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See either the
# GNU General Public License or the Artistic License for more details.
#
# ABSTRACT: Use Ghostscript to convert PostScript or PDF to other formats
#---------------------------------------------------------------------

use 5.008;
our $VERSION = '0.03';          ## no critic

use strict;
use warnings;
use Carp qw(croak verbose);
use File::Spec ();
use Scalar::Util qw(blessed openhandle reftype);


use Exporter 5.57 'import';     # exported import method

our @EXPORT = qw(psconvert);

#=====================================================================
# Package PostScript::Convert:

our $Debug;  # Set this to a true value for debugging output to STDERR

our %default = (
  ghostscript => ($^O =~ 'MSWin32' ? 'gswin32c.exe' : 'gs'),
);

our %format = do {
  my @png_param = (
    extension    => 'png',
    format_param => [qw(-dTextAlphaBits=4 -dGraphicsAlphaBits=4)],
  );

  my @pdf_param  = (
    device      => 'pdfwrite',
    extension   => 'pdf',
    format_code => [qw(-c .setpdfwrite)],
    'format_param' # => VALUE
  );

  (
    png     => { device => 'png16m',  @png_param },
    pnggray => { device => 'pnggray', @png_param },
    pngmono => { device => 'pngmono', extension => 'png' },
    jpeggray=> { device => 'jpeggray', extension => 'jpeg' },
    jpeg    => { device => 'jpeg', extension => 'jpeg' },
    jpg     => { device => 'jpeg', extension => 'jpg' },
    pdf14   => { @pdf_param => ['-dCompatibilityLevel=1.4'] },
    pdf13   => { @pdf_param => ['-dCompatibilityLevel=1.3'] },
    pdf12   => { @pdf_param => ['-dCompatibilityLevel=1.2'] },
  );
}; # end %format

$format{pdf} = $format{pdf14};

our %paper_size = (
  executive           => [522, 756],
  folio               => [595, 935],
  'half-letter'       => [612, 397],
  letter              => [612, 792],
  legal               => [612, 1008],
  tabloid             => [792, 1224],
  superb              => [843, 1227],
  ledger              => [1224, 792],

  'comm #10 envelope' => [297, 684],
  'envelope-monarch'  => [280, 542],
  'envelope-c5'       => [459.21260, 649.13386],
  'envelope-dl'       => [311.81102, 623.62205],

  a0  => [2383.93701, 3370.39370],
  a1  => [1683.77953, 2383.93701],
  a2  => [1190.55118, 1683.77953],
  a3  => [ 841.88976, 1190.55118],
  a4  => [ 595.27559,  841.88976],
  a5  => [ 419.52756,  595.27559],
  a6  => [ 297.63780,  419.52756],
  a7  => [ 209.76378,  297.63780],
  a8  => [ 147.40157,  209.76378],
  a9  => [ 104.88189,  147.40157],
  a10 => [  73.70079,  104.88189],

  b0  => [2834.64567, 4008.18898],
  b1  => [2004.09449, 2834.64567],
  b2  => [1417.32283, 2004.09449],
  b3  => [1000.62992, 1417.32283],
  b4  => [ 708.66142, 1000.62992],
  b5  => [ 498.89764,  708.66142],
  b6  => [ 354.33071,  498.89764],
  b7  => [ 249.44882,  354.33071],
  b8  => [ 175.74803,  249.44882],
  b9  => [ 124.72441,  175.74803],
  b10 => [  87.87402,  124.72441],
);

$paper_size{"us-$_"} = $paper_size{$_} for qw(letter legal);
$paper_size{europostcard} = $paper_size{a6};

#---------------------------------------------------------------------
sub psconvert
{
  my $ps = shift;

  unshift @_, 'filename' if @_ % 2;
  my %opt = (%default, @_);

  return convert_fh( openhandle $ps, \%opt) if openhandle $ps;
  return convert_object($ps, \%opt) if blessed $ps;
  return convert_ref(   $ps, \%opt) if ref $ps;
  convert_filename(     $ps, \%opt);
} # end psconvert

#---------------------------------------------------------------------
sub convert_object
{
  my ($obj, $opt) = @_;

  return convert_psfile($obj, $opt) if $obj->isa('PostScript::File');

  return convert_psfile($obj->get__PostScript_File, $opt)
      if $obj->can('get__PostScript_File');

  croak "Don't know how to handle a " . blessed($obj);
} # end convert_object


#---------------------------------------------------------------------
sub convert_psfile
{
  my ($ps, $opt) = @_;

  # Check version of PostScript::File:
  my $v = PostScript::File->VERSION;
  croak "Must have PostScript::File 2.00 or later, this is only $v"
      unless $v >= 2;


  # Get paper size, if necessary:
  $opt->{paper_size} ||= [ $ps->get_width, $ps->get_height ];

  # Save old filename:
  my $oldFN  = $ps->get_filename;
  $opt->{input} ||= "$oldFN.ps" if defined $oldFN;

  require File::Temp; File::Temp->VERSION(0.19); # need newdir method

  if ($ps->get_eps and $ps->get_pagecount > 1) {
    # Compute output filename:
    apply_format($opt);
    my ($outVol, $outDir, $outFN) =
        File::Spec->splitpath( guess_output_filename($opt) );

    $outFN =~ s/(\.\w+)$// or croak "No extension in $outFN";
    my $ext = $1;


    my $dir = File::Temp->newdir;

    my $oldExt = $ps->get_file_ext;
    $ps->set_filename($outFN, $dir);
    $ps->set_file_ext(undef);

    # Process the file(s):
    my @files = $ps->output;

    foreach my $fn (@files) {
      $outFN = (File::Spec->splitpath($fn))[2];
      $outFN =~ s/\.\w+$/$ext/ or die "Expected extension in $outFN";

      $opt->{filename} = File::Spec->catpath( $outVol, $outDir, $outFN );

      convert_filename($fn, $opt);
    } # end foreach $fn in @files

    # Restore settings:
    $ps->set_filename($oldFN);
    $ps->set_file_ext($oldExt);
  } # end if EPS with multiple pages
  else {
    # Only one file, we don't need a temporary directory:
    my $fh = File::Temp->new;

    $ps->output($fh);

    seek($fh, 0,0) or croak "Can't seek temporary file: $!";

    convert_fh($fh, $opt);
  } # end else only one PostScript file to process
} # end convert_psfile

#---------------------------------------------------------------------
sub convert_ref
{
  my ($ref, $opt) = @_;

  my $type = reftype $ref;

  croak "Don't know how to handle a $type ref"
      unless $type eq 'SCALAR' or $type eq 'ARRAY';


  require File::Temp;

  my $fh = File::Temp->new;

  if ($type eq 'ARRAY') { print $fh @$ref }
  else                  { print $fh $$ref }

  seek($fh, 0,0) or croak "Can't seek temporary file: $!";

  convert_fh($fh, $opt);
} # end convert_ref

#---------------------------------------------------------------------
sub convert_filename
{
  my ($filename, $opt) = @_;

  $opt->{input} ||= $filename;
  open(my $in, '<:raw', $filename) or croak "Unable to open $filename: $!";


  convert_fh($in, $opt);
} # end convert_filename

#---------------------------------------------------------------------
sub check_options
{
  my ($opt) = @_;

  my @cmd = ($opt->{ghostscript} || croak "ghostscript not defined");


  foreach my $dir (@{ $opt->{include} || [] }) {
    push @cmd, "-I$dir";
  } # end foreach $dir

  push @cmd, qw(-q -sstdout=%stderr -dBATCH -dNOPAUSE);
  push @cmd, ($opt->{unsafe} ? '-dNOSAFER' : '-dSAFER');

  apply_format($opt);

  push @cmd, "-sOutputFile=" . guess_output_filename($opt);

  my $device = $opt->{device};
  croak "No output device supplied" unless defined $device and length $device;
  push @cmd, "-sDEVICE=$device";

  if (defined(my $size = $opt->{paper_size})) {
    unless (ref $size) {
      if ($paper_size{lc $size}) {
        $size = $paper_size{lc $size};
      } elsif ($size =~ /\A(\d+(?:\.\d+)?)x(\d+(?:\.\d+)?)\Z/i) {
        $size = [ $1 * 72, $2 * 72 ];
      } else {
        croak "Unknown paper size '$size'";


      }
    } # end unless ref $size
    push @cmd, '-dDEVICEWIDTHPOINTS='  . $size->[0],
               '-dDEVICEHEIGHTPOINTS=' . $size->[1];
  } # end if $opt->{paper_size}

  push @cmd, "-r$opt->{resolution}"    if $opt->{resolution};
  push @cmd, @{ $opt->{format_param} } if $opt->{format_param};
  push @cmd, @{ $opt->{gs_param} }     if $opt->{gs_param};
  push @cmd, @{ $opt->{format_code} }  if $opt->{format_code};

  print STDERR "@cmd\n" if $Debug;

  @cmd;
} # end check_options

#---------------------------------------------------------------------
sub apply_format
{
  my ($opt) = @_;

  unless ($opt->{format}) {
    my $outFN = $opt->{filename};

    croak "No output format or filename supplied"
        unless defined $outFN and length $outFN;

    $outFN =~ /\.([^.\s]+)$/ or croak "Unable to determine format from $outFN";
    $format{ $opt->{format} = lc $1 } or croak "Unknown extension .$1";
  }

  my $fmt = $format{ $opt->{format} } or croak "Unknown format $opt->{format}";


  while (my ($key, $val) = each %$fmt) {
    $opt->{$key} = $val unless defined $opt->{key};
  }
} # end apply_format

#---------------------------------------------------------------------
sub guess_output_filename
{
  my ($opt) = @_;

  my $fn = $opt->{filename};

 CHOICE: {
    last CHOICE if defined $fn;

    $fn = $opt->{input};
    last CHOICE unless defined $fn and length $fn;

    my $ext = $opt->{extension};
    croak "No extension defined for format $opt->{format}" unless $ext;

    $fn =~ s/(?:\.\w*)?$/.$ext/;
  }


  croak "No output filename supplied" unless defined $fn and length $fn;

  $fn;
} # end guess_output_filename

#---------------------------------------------------------------------
sub convert_fh
{
  my ($fh, $opt) = @_;

  my @cmd = (check_options($opt), '-_');

  open(my $oldin, '<&STDIN') or croak "Can't dup STDIN: $!";
  open(STDIN, '<&', $fh)     or croak "Can't redirect STDIN: $!";
  system @cmd;
  open(STDIN, '<&', $oldin)  or croak "Can't restore STDIN: $!";


  if ($?) {
    my $exit   = $? >> 8;
    my $signal = $? & 127;
    my $core   = $? & 128;

    my $err = "Ghostscript failed: exit status $exit";
    $err .= " (signal $signal)" if $signal;
    $err .= " (core dumped)"    if $core;

    croak $err;
  } # end if ghostscript failed
} # end convert_fh

#=====================================================================
# Package Return Value:

1;

__END__