#!/usr/bin/perl -w


use Getopt::Long qw(:config posix_default no_ignore_case gnu_compat
                            bundling auto_version auto_help); 
use Pod::Usage;
use IPC::Open3;
use POSIX qw(floor);
use strict;


=head1 NAME

psresize2.pl - a better I<psresize>

=head1 SYNOPSIS

B<psresize2.pl> [-w I<width> ] [-h I<heigth>] [-p I<paper>] [-W I<width>]
[-H I<heigth>] [-P I<paper>] [-r I<rotation>] [-m I<margin>] [-c] [-q]
[I<infile> [I<outfile>]]

=head1 DESCRIPTION

I<PSResize2> rescales and centres a document on a different size of paper.
The input PostScript file should follow the Adobe Document Structuring
Conventions.

If no input file is given, or if a single hyphen-minus (B<->) is given as
file name, I<PSResize2> will read the PostScript data from the standard
input. In that case, and if the crop option (B<-c>) is set, an auxiliary
file will be created, and removed afterwards.

If no output file is given, or if a single hyphen-minus (B<->) is given as
file name, I<PSResize2> will send the PostScript data to the standard
output.

=head1 OPTIONS

=over 8

=item B<-w, --width>

Specify the width of the output file. If the height is not specified as
well, it will be ignored. The known units are B<pt>, B<in>, B<cm> and
B<mm>. The default unit is B<pt>.

=item B<-h, --height>

Specify the height of the output file. If the width is not specified as
well, it will be ignored. The known units are B<pt>, B<in>, B<cm> and
B<mm>. The default unit is B<pt>.

=item B<-p, --paper>

Specify the paper size of the output file, as an alternative to B<-w>
and B<-h>. Can be set to B<a0>, B<a1>, B<a2>, B<a3>, B<a4>, B<a5>, B<b5>,
B<letter>, B<legal>, B<tabloid>, B<statement>, B<executive>, B<folio>,
B<quarto>, or B<10x14>. The  default output paper size is B<a4>.

=item B<-W, --Width>

Same as the option B<-w>, but for the input file.

=item B<-H, --Height>

Same as the option B<-h>, but for the input file.

=item B<-P, --Paper>

Same as the option B<-p>, but for the input file. By default,
I<PSResize2> will try to guess this value from the header of the file,
and fail if the information is missing. This option is useless if the
crop option (B<-c>) is set.

=item B<-r, --rotdir>

If the file has to be rotated, this option determines the direction of
the rotation. Can be set to B<L>, B<left>, B<R>, or B<right>. The default
direction is B<L>.

=item B<-m, --margin>

Add a margin to the output file. Possible units are B<pt>, B<in>, B<cm>
and B<mm>. The default unit is B<pt>. The default margin is B<1cm> if the
crop option (B<-c>) is set, and B<0> otherwise.

=item B<-c, --crop>

If this option is set, I<PSResize2> will interpret the PostScript code to
calculate the maximal effective bounding box. This operation may be quite
demanding for the CPU.

=item B<-q, --quiet>

I<PSResize2> normally prints the page numbers of the pages output; this
option suppresses this.

=item B<-?,--help>

Display a brief help.

=item B<--version>

Display the version number of the I<PSResize2> program.

=item B<--man>

Display the manual page.

=back

=head1 EXAMPLES

The following comand can be used to remotely crop a PDF file, and
convert it to A4 paper

pdftops in.pdf - | ssh remote psresize2.pl -cpA4 | ps2pdf - out.pdf

=head1 REQUIRE

Requires psutils installed and available in the command line
http://www.tardis.ed.ac.uk/~ajcd/psutils/.

=head1 AUTHOR

I<PSResize2> is based on psnup2, by Oleg Parashchenko and Lionel Guy.

Public domain, (c) Guilhem Moulin.

=head1 VERSION

Version: 0.1, 25 September 2010

=cut

# TODO: inline it in the header
$main::VERSION = "0.1, 25 September 2010";

my $tmpdir = "/tmp";

#
# Options & arguments 
#

my ($outwidth,$outheight, $inwidth,$inheight);
my $margin;
my $crop;
my $rotdir = 'L';
my $quiet;
my $man;

# TODO: "-m h1cm:v3cm": horizontal, vertical
GetOptions( "w|width=s"  => \$outwidth,
            "h|height=s" => \$outheight,
            "p|paper=s"  => sub { &papersize ($_[1],\$outwidth,\$outheight) },
            "W|Width=s"  => \$inwidth,
            "H|Height=s" => \$inheight,
            "P|Paper=s"  => sub { &papersize ($_[1],\$inwidth,\$inheight) },
            "r|rotdir=s" => \$rotdir,
            "m|margin=s" => \$margin,
            "c|crop"     => \$crop,
            "q|quiet"    => \$quiet,
            "man"        => \$man )
    or  pod2usage(2);

pod2usage(2)  if  ($#ARGV > 1);
pod2usage(-exitstatus => 0, -verbose => 2)  if  defined $man;

# Input and output files
my ($infile, $outfile) = @ARGV;



#
# Default values
#

# Default margin
unless (defined $margin) {
    $margin = 0;
    $margin = "1cm" if defined $crop;
}

# Default output papersize
&papersize ("a4", \$outwidth, \$outheight)
    unless  (defined $outwidth  and  defined $outheight);

# Default unit: PostScript point
map {&topoints ($_)} ( \$outwidth, \$outheight,
                       \$inwidth, \$inheight,
                       \$margin );

# Rotation
if (lc $rotdir eq "left" or uc $rotdir eq 'L') {
    $rotdir = 'L'
} elsif (lc $rotdir eq "right" or uc $rotdir eq 'R') {
    $rotdir = 'R'
} else {
    die "Unknown rotation direction: `$rotdir'"
}

# Auxiliary files, to remove
my @auxfiles;

# Open input and output files
if (defined $infile && $infile ne "-") {
    open FIN, '<', "$infile"  or  die "Can't read `$infile': $!";
} else {
    *FIN = *STDIN;
}

if (defined $outfile && $outfile ne "-") {
    open FOUT, '>', "$outfile"  or  die "Can't create `$outfile': $!";
} else {
    *FOUT = *STDOUT;
}

*LOG = *STDERR;



#
# Bounding box
#
my @bbox;
if (defined $crop) {
    # Calculate the maximal bounding box
    
    unless (seek FIN, 0, 1) {
        # The input is not seekable: have to create a seekable auxiliary file

        my $auxfile = "$tmpdir/psresize-stdin-$$.ps";

        open FINAUX, '>', "$auxfile"
            or die "Can't write into `$auxfile': $!";
        push @auxfiles, $auxfile;

        # cat > $auxfile
        while (<FIN>) {
            print FINAUX  or  die "Can't print: $!";
        }
        close FINAUX  or  die "Can't close: $!";
        close FIN  or  die "Can't close: $!";

        open FIN, '<', "$auxfile"  or  die "Can't read `$auxfile': $!";
    }
 
    # Need to duplicate FIN, since it will be closed in the parent process
    open *GSIN, '<&FIN';

    my @cmd = ('gs', '-sDEVICE=bbox', '-dBATCH', '-dNOPAUSE', '-');
    my $pid = open3 "<&GSIN", ">&GSOUT", *GSOUT, @cmd;
    
    my ($p,$c) = (0,0); # Page & character counter
    my ($x0, $y0, $x1, $y1) = (1<<16, 1<<16, -(1<<16), -(1<<16));
    while (<GSOUT>) {
        if ($_ =~ m/^\%\%BoundingBox: (\d+) (\d+) (\d+) (\d+)/) {
            $x0 = $1 if $1 < $x0;
            $y0 = $2 if $2 < $y0;
            $x1 = $3 if $3 > $x1;
            $y1 = $4 if $4 > $y1;
            unless (defined $quiet) {
                my $s = "[" . ++$p . "] ";
                $c += length $s;
                if ($c >= 80) {
                    print LOG "\n"  or  die "Can't close: $!";
                    $c = length $s;
                }
                print LOG $s  or  die "Can't close: $!";
            }
        }
    }
    close GSOUT  or  die "Can't close: $!";;
    print LOG "\n"  or  die "Can't close: $!"  unless  defined $quiet;
    
    # No zombie processes
    waitpid $pid, 0;
    die "Can't run `" . &printcmd (@cmd) . "'"  if  $? >> 8;
    
    die "Error when calculating bounding box" if ($x0 >= $x1 || $y0 >= $y1);
    @bbox = ($x0, $y0, $x1, $y1);

    # Let's go back to the beginning of the input
    seek FIN, 0, 0  or  die "$!";

} elsif (defined $inwidth and defined $inheight) {
    @bbox = (0, 0, $inwidth, $inheight);
} else {
    # Guess page size from the input file
   
    # To avoid to seek into FIN, it gonna be copied from WRITE to READ
    # in background, once the Bounding Box has been read
    pipe *READ, *WRITE  or  die "Can't pipe: $!";

    while (not (@bbox) && defined (my $l = <FIN>)) {
        print WRITE $l  or  die "Can't close: $!";
        @bbox = ($1, $2, $3, $4)
            if ($l =~ m/^\%\%BoundingBox: (\d+) (\d+) (\d+) (\d+)/);
    }
   
    die "Cannot guess input page size!"  unless  @bbox;

    unless (my $pid = fork) {
        # Child: cat FIN > WRITE in background
        die "Can't fork: $!" unless defined $pid;
        close READ  or  die "Can't close: $!";;
        
        while (<FIN>) {
            print WRITE  or  die "Can't close: $!";
        }
        exit;
    }
    # Parent

    close WRITE  or  die "Can't close: $!";
    close FIN  or  die "Can't close: $!";
        
    open *FIN, "<&READ"  or  die "Can't dup: $!";
}




#
# Calculate PStoPS specification
#
my ($x0,$x1) = &calculate_coordinates($outwidth , $margin);
my ($y0,$y1) = &calculate_coordinates($outheight, $margin);

my $spec = 0 . &calc_pstops_page(@bbox, $x0, $y0, $x1, $y1);



#
# Run the program and filter the output
#

my @cmd = ('pstops', "-w$outwidth", "-h$outheight", "$spec");
push @cmd, '-q'  if  defined $quiet;
my $pid = open3 "<&FIN", *PS2PS, ">&LOG", @cmd;

my $l;
# Header and comments
while (defined ($l = <PS2PS>)  &&  $l ne "\%\%EndComments\n") {
    # Optional, but nice: tune how "gv" will show the document
    next if $l =~ m/^\%\%DocumentMedia:/;

    if ($l =~ m/^\%\%BoundingBox:/) {
        print FOUT "\%\%BoundingBox: 0 0 $outwidth $outheight\n"
            or  die "Can't print: $!";
        next;
    }
    print FOUT $l  or  die "Can't print: $!";
}

# Important to print the document right
# TODO: die "Can't print: $!"
print FOUT  <<  "EOF";
\%\%EndComments
\%\%BeginFeature: *PageSize ($outwidth $outheight)
<< /PageSize [$outwidth $outheight] >> setpagedevice
\%\%EndFeature
EOF

# Body
while (<PS2PS>) {
    print FOUT  or  die "Can't print: $!";

    # PStoPSclip hack: increase clipping box by 10
    if ($_ =~ m/^userdict\/PStoPSclip{0 0 moveto$/) {
        $l = <PS2PS>;
        $l =~ s/\./0./g;
        print FOUT $l  or  die "Can't print: $!";
    }
}

# No zombie processes
waitpid $pid, 0;
die "Can't run `" . &printcmd (@cmd) . "'"  if  $? >> 8;

close FIN;
close FOUT;

# Delete auxiliary files
unlink @auxfiles;

# Useless, but Perl doesn't see that this filehandle is used more than
# one time (and even automatically closed by `open3')
exit;
close GSIN;



# =========================================================

#
# Calculate an item of the pstops specification
#
sub calc_pstops_page {
    my ($fx0, $fy0, $fx1, $fy1,
        $tx0, $ty0, $tx1, $ty1) = @_;

    # From and to width / height
    my ($wf, $hf) = ($fx1 - $fx0,  $fy1 - $fy0);
    my ($wt, $ht) = ($tx1 - $tx0,  $ty1 - $ty0);

    # Check if rotation required
    my $rotation = (($wf > $hf) xor ($wt > $ht));

    # Scale factor width / height
    my ($sw, $sh);
    if ($rotation) {
        ($sw, $sh) = ($ht / $wf,  $wt / $hf);
    } else {
        ($sw, $sh) = ($wt / $wf,  $ht / $hf);
    }

    # We take the smallest scale
    my $scale = ($sw > $sh) ? $sh : $sw;
    
    # Calculate the centers of the boxes
    my ($cxf, $cyf) = ( .5 * ($fx0 + $fx1),  .5 * ($fy0 + $fy1) );
    my ($cxt, $cyt) = ( .5 * ($tx0 + $tx1),  .5 * ($ty0 + $ty1) );

    # First, PStoPs scales, then rotates, then moves
    ($cxf, $cyf) = ($cxf * $scale, $cyf * $scale);
    if ($rotation) {
        if ($rotdir eq 'L') {
            ($cxf, $cyf) = (-$cyf, $cxf);
        } else {
            ($cxf, $cyf) = ($cyf, -$cxf);
        }
    } else {
        $rotdir = '';
    }
    my ($movex, $movey) = ($cxt - $cxf,  $cyt - $cyf);

    # Generate the summary
    return sprintf( '%s@%.3f(%.3f,%.3f)', $rotdir, $scale, $movex, $movey);
}


#
# Calculate the begining and ending coordinates, after shaving 2 times
# the margin
#
sub calculate_coordinates {
    my ($length, $margin) = @_;
    my $skip     = $length - $margin;
    my $outwidth = $skip - $margin;
    return ( &round( &round($skip) - $outwidth ), &round($skip) );
}


#
# Round a float number
# 
sub round {
    return floor ($_[0] + .5);
}


#
# In-place convert the given length to PostScript points
#
sub topoints {
    my $l = $_[0];
    return unless defined $$l;
 
    $$l =~ /^([+-]?\d*\.?\d+)(\w*)$/  or  die "Unable to parse `$$l'";

    my $r = $1;
    if ($2 eq "" or $2 eq "pt") {
        # nothing
    } elsif ($2 eq "in") {
        $r *= 72;
    } elsif ($2 eq "cm") {
        $r *= 72/2.54;
    } elsif ($2 eq "mm") {
        $r *= 72/25.4;
    } else {
        die "Unknown unit: `$2'";
    }
    $$l = &round ($r);
}


#
# In-place set the given width and height to the predefined papersize
#
sub papersize {
    my ($p,$w,$h) = @_;
    $p = lc $p;

    if ($p eq "a0") {
        ($$w,$$h) = ("841mm",  "1189mm");
    } elsif ($p eq "a1") {
        ($$w,$$h) = ("594mm",  "841mm");
    } elsif ($p eq "a2") {
        ($$w,$$h) = ("420mm",  "594mm");
    } elsif ($p eq "a3") {
        ($$w,$$h) = ("297mm",  "420mm");
    } elsif ($p eq "a4") {
        ($$w,$$h) = ("210mm",  "297mm");
    } elsif ($p eq "a5") {
        ($$w,$$h) = ("148mm",  "210mm");
    } elsif ($p eq "letter") {
        ($$w,$$h) = ("8.5in",  "11in");
    } elsif ($p eq "legal") {
        ($$w,$$h) = ("8.5in",  "14in");
    } elsif ($p eq "tabloid") {
        ($$w,$$h) = ("11in",   "17in");
    } elsif ($p eq "statement") {
        ($$w,$$h) = ("5.5in",  "8.5in");
    } elsif ($p eq "executive") {
        ($$w,$$h) = ("7.25in", "10.5in");
    } elsif ($p eq "folio") {
        ($$w,$$h) = ("8.27in", "13in");
    } elsif ($p eq "quarto") {
        ($$w,$$h) = ("9in",    "11in");
    } elsif ($p eq "10x14") {
        ($$w,$$h) = ("10in",   "14in");
    } else {
        die "Unknown paper size: `$p'";
    }
}



#
# Print a command just like you'd do in a shell
#
sub printcmd {
    my @cmd;

    for (@_) {
        my $s = $_;
        $s =~ s/"/\\"/;
        $s = "\"$s\""  if  $s =~ /[ ()';#{}*?~&|`]/;
        push @cmd, $s;
    }

    join ' ', @cmd; 
}