#!/usr/bin/perl
# ==============================================================================
# pdfcrop.pl ------------------------------------------------ Jean-Michel Sarlat
# VERSION : 1.0 (28 juin 2011)
# Usage : pdfcrop.pl [-marges=xx[:xx[:xx:xx]]]  fichier.pdf
# Pour les marges :
#   - xx (une seule marge), elle s'applique aux quatre côtés
#   - xx:xx (deux marges), la  première s'applique au haut et bas, la seconde à
#     gauche et droite
#   - xx:xx:xx:xx (quatre marges), elles s'appliquent dans l'ordre aux côtés
#     haut, droit, bas, gauche (comme en HTML :)
# Ce script est proposé sans garanties... Il permet de détourer les pages d'un
# fichier PDF sans en affecter la structure (seules les CropBox sont modifiées);
# pour un usage avec pdf2swf, c'est suffisant : on conserve les liens...
# ------------------------------------------------------------------------------
use Getopt::Long;
# ===  Acquisition des options de la ligne de commande -------------------------
GetOptions(
    "marges=s",  # Spécification des marges
    "d"          # Debug
);
 
# === Commande pour l'exécution de GhostScript en quête des BoundingBox --------
our $GSBBOX = "gs -sDEVICE=bbox -dBATCH -dNOPAUSE -dNOSAFER -P -c save pop -f";
# === Commande pour la production du fichier PDF final -------------------------
our $PDFWRITE = "gs -sDEVICE=pdfwrite ";
 
# === Acquisition des BoundingBox des différentes pages du fichier en entrée ---
sub getBBox {
  my $f = shift;
  my @BB = ();
  my $p  = 0;
  open(CMD, "$GSBBOX $f 2>&1 |");
  while (<CMD>) {
    /^%%BoundingBox:\s*([\-\.\d]+) ([\-\.\d]+) ([\.\d]+) ([\.\d]+)/o and
       push @BB, [$1,$2,$3,$4];
  }
  close(CMD);
  return \@BB;
}
 
# === Ajustement des BoundingBox en fonction des besoins spécifiés -------------
sub setBBox {
  my ($f, $m) = @_;
  # $f  - fichier
  # $m  - marges : référence sur une table de 4 nombres
  my $b = getBBox($f);
  $_ = &Marges4($_, $m) foreach @$b;
  # Mise à plat des BoundingBox -----------------------
  my $l = "";
  $l .= join(" ", @$_)." " foreach @$b;
  $l =~ s/\s+$//;
  return $l;
}
 
# === Cropping du fichier ------------------------------------------------------
sub crop {
  my ($f, $m) = @_;
  my $l = setBBox($f, $m);
  open  PS, ">prologue-crop.ps";
  print PS << "eop";
%!PS-Adobe-3.0
%%BeginProlog
/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse
/BBoxCrop [$l] def
<<
  /EndPage {
    exch /NumeroPage exch store
    2 lt {
      gsave
       initgraphics
       [/CropBox BBoxCrop NumeroPage 4 mul 4 getinterval /PAGE pdfmark
      grestore
      true
    } {
      false
    } ifelse
  }
>> setpagedevice
%%EndProlog
eop
  close PS;
  use File::Basename;
  my ($pre, $dir, $ext) = fileparse($f,qw{\..*});
  print STDERR qx{$PDFWRITE -o $pre-crop.pdf prologue-crop.ps $f};
  $opt_d or qx{rm -f prologue-crop.ps};
}
 
# ==============================================================================
# Programme Principal
# ==============================================================================
our $fichier = $ARGV[0];
-f $fichier or die "ERREUR> [$fichier] est introuvable...\n";
 
our $marges = [];
if ($opt_marges) {
  my @l = split /:/, $opt_marges;
  my $n = scalar @l;
  $n == 1 and $marges = [$l[0], $l[0], $l[0], $l[0]];
  $n == 2 and $marges = [$l[1], $l[0], $l[1], $l[0]];
  $n == 4 and $marges = [$l[3], $l[2], $l[1], $l[0]];
  $marges or die "ERREUR> Les marges sont incorrectement spécifiées...\n";
} else {
  $marges = [10, 10, 10, 10];
}
 
&crop($fichier, $marges);
 
# === Procédures additionnelles ------------------------------------------------
sub Marges4 {
  # À PEAUFINER : les nouvelles dimensions doivent rester dans un cadre
  # raisonnable
  my ($b, $m) = @_;
  $$b[0] -= $$m[0];
  $$b[1] -= $$m[1];
  $$b[2] += $$m[2];
  $$b[3] += $$m[3];
  return $b;
}
 
1;