crop.pl (2341B)
1 #!/usr/bin/env perl 2 use strict; use warnings; 3 use PDF::API2; 4 use POSIX; 5 6 # TODO clean this crap up 7 # TODO recursive cuts 8 # TODO respect aspect ratio! 9 my $filename = shift; 10 my $ofilename = shift; 11 my $width = int(shift); 12 my $height = int(shift); 13 my $margin = 10; 14 my $oldpdf = PDF::API2->open($filename); 15 my $newpdf = PDF::API2->new; 16 my $temppdf = PDF::API2->new; 17 for my $page_nb (1..$oldpdf->pages) { 18 my ($page, @cropdata); 19 my $nr = 0; 20 $page = $temppdf->importpage($oldpdf, $page_nb); 21 @cropdata = $page->get_mediabox; 22 if ($cropdata[2] ge $cropdata[3]) { 23 my $t = $cropdata[3]; 24 $cropdata[3] = $cropdata[2]; 25 $cropdata[2] = $t; 26 $nr++; 27 printf "prerotate\n"; 28 }; 29 print "before any cut\n"; 30 print "$cropdata[0] $cropdata[1] $cropdata[2] $cropdata[3]\n"; 31 if ($cropdata[3] ge $height) { 32 printf "rotate it once\n"; 33 print "$cropdata[0] $cropdata[1] $cropdata[2] $cropdata[3]\n"; 34 my $t = $cropdata[3]; 35 $cropdata[3] = $cropdata[2]; 36 $cropdata[2] = $t; 37 $nr++; 38 print "$cropdata[0] $cropdata[1] $cropdata[2] $cropdata[3]\n"; 39 my $aspect = $cropdata[3] / $height; 40 my $realw = $cropdata[2] / $aspect; 41 print "realw $realw aspect $aspect width $width\n"; 42 my $nump = ceil($realw / ($width - 2*$margin)); 43 print "$cropdata[0] $cropdata[1] $cropdata[2] $cropdata[3]\n"; 44 print "will need $nump pages\n"; 45 for my $i (0..($nump-1)) { 46 $page = $newpdf->importpage($oldpdf, $page_nb); 47 for my $r (1..($nr)) { 48 printf "rotate the real page\n"; 49 $page->rotate(-90); 50 } 51 print "subpage was $i\n"; 52 print "$cropdata[0] $cropdata[1] $cropdata[2] $cropdata[3]\n"; 53 @cropdata = $page->get_mediabox; 54 $cropdata[1] = ($nump - $i - 1) * $cropdata[3] / $nump - $margin; 55 $cropdata[3] = ($nump - $i) * $cropdata[3] / $nump + $margin; 56 print "now subpage is $i\n"; 57 print "$cropdata[0] $cropdata[1] $cropdata[2] $cropdata[3]\n"; 58 $page->cropbox(@cropdata); 59 $page->trimbox(@cropdata); 60 $page->mediabox(@cropdata); 61 } 62 } else { 63 print "no need to do anything\n"; 64 $page = $newpdf->importpage($oldpdf, $page_nb); 65 for my $r (1..($nr)) { 66 printf "rotate the real page\n"; 67 $page->rotate(-90); 68 } 69 } 70 } 71 (my $newfilename = $filename) =~ s/(.*)\.(\w+)$/$1.clean.$2/; 72 $newpdf->saveas($ofilename); 73