#! /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::Open2;
use POSIX qw(floor);
use strict;


=head1 NAME

pdftool.pl - a PDF swiss army knife

=head1 SYNOPSIS

B<pdftool.pl> [-s I<pages>] [-p I<paper>] [-m I<margin>] [-c] [-b]
[-n I<nup>] [-q] [I<infile> [I<outfile>]]

=head1 DESCRIPTION

I<PDFTool>

=head1 OPTIONS

=over 8

=item B<-s, --select>

=item B<-p, --paper>

=item B<-m, --margin>

=item B<-c, --crop>

=item B<-b, --book>

=item B<-n, --nup>

=item B<-q, --quiet>

I<PDFTool> 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<PDFTool> program.

=item B<--man>

Display the manual page.

=back

=head1 REQUIRE

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

=head1 AUTHOR

Public domain, (c) Guilhem Moulin.

=head1 VERSION

Version: 0.1, 25 September 2010

=cut



my $tmpdir   = '/tmp';

#
# Options & arguments 
#

my $select;
my $paper;
my $margin;
my $crop;
my $book;
my $nup = 1;
my $quiet;
my $man;

# TODO: choose the output type
GetOptions( "select|s=s" => \$select,
            "paper|p=s"  => \$paper,
            "margin|m=s" => \$margin,
            "crop|c"     => \$crop,
            "book|b"     => \$book,
            "nup|n=i"    => \$nup,
            "1"          => sub { $nup = 1 },
            "2"          => sub { $nup = 2 },
            "3"          => sub { $nup = 3 },
            "4"          => sub { $nup = 4 },
            "5"          => sub { $nup = 5 },
            "6"          => sub { $nup = 6 },
            "7"          => sub { $nup = 7 },
            "8"          => sub { $nup = 8 },
            "9"          => sub { $nup = 9 },
            "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 output papersize
$paper = "a4"  unless  defined $paper;


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

# Default unit: PostScript point
&topoints (\$margin);

# Inner and outer margins
my ($mresize, $mnup) = (0,0);
if ($nup > 1 && not defined $book) {
    $mresize = $margin/2;
    $mnup    = $mresize;
} else {
    $mresize = $margin;
}



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

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



#
# Detect filetype
#
my $filetype;
my $fstline  = <FIN>;
if (defined $fstline && $fstline =~ /^%!PS.*/) {
    $filetype = "PS";
} elsif (defined $fstline && $fstline =~ /^%PDF.*/) {
    $filetype = "PDF";
} else {
    die "Can't recognize the type of `$infile_display'";
}

# Auxiliary files, to remove
my @auxfiles;

# Auxiliary file descriptors, to close
my @auxfds;

# Pids, to waid for
my @pids;
my $pid;



#
# Conversion from PDF to PS, if necessary 
#
my @cmd;
if ($filetype eq "PDF") {
    unless (defined $infile) {
        # Need to copy the whole input to an auxiliary file, since
        # conversion from PDF to PS requires random access to the data
        
        $infile = "$tmpdir/pdftool-stdin-$$" . lc ".$filetype";

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

        # cat > $filename
        # TODO: useless seek
        seek FIN, 0, 0  or die $!;
        while (<FIN>) {
            print FIN2 $_  or  die "Can't print: $!";
        }
        close FIN2;
    }
    close FIN;

    # Convert to PS
    @cmd = ('pdftops', "$infile", '-');
    push @cmd, '-q'  if  defined $quiet;
    $pid = open *PSIN, "-|", @cmd
               or die "Can't run: `" . &printcmd (@cmd) . "'";
    push @pids, $pid;
} else {
    # TODO: useless seek
    seek FIN, 0, 0  or die $!;
    *PSIN = *FIN;
}


#
# Select, if necessary
#
# TODO: preselection, during the conversion from pdf?
if (defined $select) {
    @cmd = ('psselect', "-p$select");
    push @cmd, '-q'  if  defined $quiet;
    $pid = open2 *PSSELECT, "<&PSIN", @cmd
               or die "Can't run: `" . &printcmd (@cmd) . "'";
    push @pids, $pid;
} else {
    *PSSELECT = *PSIN;
}



#
# Resize file to our paper
#
@cmd = ('./psresize2.pl', "-p$paper", "-m$mresize");
push @cmd, "-c" if defined $crop;
push @cmd, '-q'  if  defined $quiet;

$pid = open2 *PSRESIZE, "<&PSSELECT", @cmd
           or die "Can't run: `" . &printcmd (@cmd) . "'";
push @pids, $pid;
# Note: open2 closes the filehandles for us :)



#
# PSBook
#
if (defined $book) {
    @cmd = ('psbook');
    push @cmd, '-q'  if  defined $quiet;
    $pid = open2 *PSBOOK, "<&PSRESIZE", @cmd
               or die "Can't run: `" . &printcmd (@cmd) . "'";
    push @pids, $pid;
} else {
    *PSBOOK = *PSRESIZE;
}



#
# PSNup
# 
if ($nup > 1) {
    @cmd = ('psnup', "-p$paper", "-m$mnup", "-$nup");
    push @cmd, '-q'  if  defined $quiet;
    $pid = open2 *PSOUT, "<&PSBOOK", @cmd
               or die "Can't run: `" . &printcmd (@cmd) . "'";
    push @pids, $pid;
} else {
    *PSOUT = *PSBOOK;
}



#
# Final file
#
if ($filetype eq "PDF") {
    # Convert back to PDF

    @cmd = ('ps2pdf', "-dEmbedAllFonts=true", "-sPAPERSIZE=$paper", '-', '-');
    $pid = open2 ">&FOUT", "<&PSOUT", @cmd
           or die "Can't run: `" . &printcmd (@cmd) . "'";
    push @pids, $pid;
} else {
    # cat > FOUT
    while (<PSOUT>) {
        print FOUT $_  or  die "Can't print: $!";
    }
}


# Avoid zombies
map {waitpid $_, 0} @pids;


# Close auxiliary filehandles
map {close $_} @auxfds;
close FIN;
close FOUT;


# Delete auxiliary files
unlink @auxfiles;




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

#
# In-place convert the given length to PostScript points
#
sub topoints {
    my $l = $_;
    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 = floor ($r + .5);
}


#
# 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; 
}