File Coverage

blib/lib/PDF/Tk.pm

Criterion	Covered	Total	%
statement	15	105	14.2
branch	0	42	0.0
condition	0	11	0.0
subroutine	5	12	41.6
pod	6	6	100.0
total	26	176	14.7

package PDF::Tk;

use IO::All;
use IPC::Open2;
use File::Temp qw/tempdir tempfile/;
use Cwd;
use strict;
our $VERSION='0.02';

sub new {
    my ($proto,%options)=@_;
    my $class= ref $proto || $proto;
    my $self=\%options;
    bless $self,$class;
    die "Can't take both a file and document argument"
     if ($self->{file} && $self->{document});
    $self->{pdftk} ||= "/usr/bin/pdftk";
    $self->_get_document if $self->{file};
    die "Can't find executablable ".$self->{pdftk}
        unless -x $self->{pdftk};
    return $self;
}

sub _get_document {
   my $self=shift;
   my @targets;
   if (ref($self->{file}) eq "ARRAY") {
   	warn "Setting together an arrayref";
   	foreach my $file (@{$self->{file}}) {
	  if (ref($file) eq "SCALAR") {
	  	local $/;
		my ($fh,$filename)=tempfile();
		print $fh $$file; # put data in a file
		$file=$filename; # set the filename
		push @targets,$filename;
	  }
	}
      $self->call_pdftk($self->{file},\($self->{document}),"cat");
       die "Could not load ".$self->{file} unless $self->{document};
   } else {
       $self->{document} = io($self->{file})->binary->all;
       die "Could not load ".$self->{file} unless $self->{document};
   }
   delete $self->{file};
   unlink @targets;
}

sub call_pdftk {
    my ($self,$input,$output,@args)=@_;
    local $/;
    if (ref $input eq "SCALAR" &&  ref $output eq "SCALAR") {
      my ($rdfh,$wrfh);
      my $pid=open2($rdfh,$wrfh,$self->{pdftk},"-",@args,"output","-")
         or die "pdftk - @args - failed: $?";
      print $wrfh $$input;
      close $wrfh;
      $$output=<$rdfh>;
      close  $rdfh;
      waitpid $pid,0;
    } elsif (ref $input eq "SCALAR") {
      my $fh;
      open($fh,"|-",$self->{pdftk},"-",@args,"output",$output)
         or die $self->{pdftk}." - @args output $output failed: $?";
      print $fh $$input;
      close $fh;
    } elsif (ref $output eq "SCALAR") {
      my $fh;
      open($fh,"-|",$self->{pdftk},(ref $input eq "ARRAY" ? @$input : $input),@args,"output","-")
       or die "pdftk $input @args - failed: $?";
      $$output=<$fh>;
      close $fh;
    } else {
      system($self->{pdftk},(ref $input eq "ARRAY" ? @$input : $input),@args,"output",$output) == 0
       or die "pdftk $input @args $output failed: $?";
    }
}

sub document {
    my ($self,$doc)=@_;
    if ($doc) { $self->{document}=$doc; }
    else      { return $self->{document}; }
}

sub pages {
    my $self=shift;
    my $tmpdir=tempdir;
    my ($pdftk,@pages);
    chdir $tmpdir;
    $self->call_pdftk(\($self->{document}),'%d.pdf','burst');
    my $page=1;
    while (-f "./$page.pdf") {
        push @pages,io(cwd."/$page.pdf")->binary->all;
	unlink (cwd."/$page.pdf");
	$page++;
    }
    unlink ("doc_data.txt");
    chdir "/";
    rmdir $tmpdir;
    return (wantarray ? @pages :\@pages);
}

sub page {
    my ($self,$page)=@_;
    my $tmpdir=tempdir;
    chdir $tmpdir;
    $self->call_pdftk(\($self->{document}),'%d.pdf','burst');
    my $res=io(cwd."/$page.pdf")->binary->all;
    unlink <*.pdf>;
    unlink ("doc_data.txt");
    chdir "/";
    rmdir $tmpdir;
    return $res;

}

sub docinfo {
    my ($self,$arg)=@_;
    unless ($self->{documentinfo}) {
        my $documentinfo;
        $self->call_pdftk(\($self->{document}),\$documentinfo,"dump_data");
        my @lines=split "\n",$documentinfo;
        my %documentinfo;
        while (my $line=shift @lines) {
            my ($key,$val)=split m/\:\s*/,$line;
            if ($key eq "InfoKey") {
                $key=$val;
                $line=shift @lines;
                ($val)=$line=~m/InfoValue\:\s*(.+)/;
            }
            $documentinfo{lc($key)}=$val;
        }
        $self->{documentinfo}=\%documentinfo;
   }
   return $self->{documentinfo}->{$arg}if ($arg);
   return $self->{documentinfo};
}


1;

=head1 NAME

PDF::Tk - Perl integration for the pdf toolkit (pdftk)

=head1 SYNOPSIS

  use PDF::Tk;
  my $doc=PDF::Tk->new(file=>["/tmp/my1.pdf","/tmp/my2.pdf"]);
  my @parts=$doc->pages();

=head1 DESCRIPTION

This module is a interface for the command line pdftk command.

=head1 METHODS

=over 4

=item new

The constructor for the pdftk module. Takes a hash of arguments

    document - a scalar containing a PDF document,
    file - either a PDF filename or a arrayref of filenames.
    pdftf - path to the pdftk binary, defaults to "/usr/bin/pdftk"

note that document and file are mutually exclusive!

=item call_pdftk

Calls up pdftk command, takes input, output and pdftk operation as arguments
input and output can either be files or scalar refs. input can also be an
array ref of files

=item pages

returns an array in list context, or arrayref, containing the content of all
pages in the document.

=item page

Takes a page as an argument, and returns the contents of that page.

=item docinfo

If you provide an argument, it will return that value (lower cased), or
else it will return a hash of values;
Common values are B ,B, B<producer>,B<author>, B<moddate>, </td>
</tr>

<tr>
<td  class="h" >
<a name="189">189</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> B<creationdate>, B<pdfid0>, B<pdfid1>, B<numberofpages>. </td>
</tr>

<tr>
<td  class="h" >
<a name="190">190</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">   </td>
</tr>

<tr>
<td  class="h" >
<a name="191">191</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> =item document </td>
</tr>

<tr>
<td  class="h" >
<a name="192">192</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">   </td>
</tr>

<tr>
<td  class="h" >
<a name="193">193</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> Accessor for the actual document. </td>
</tr>

<tr>
<td  class="h" >
<a name="194">194</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">   </td>
</tr>

<tr>
<td  class="h" >
<a name="195">195</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> =back </td>
</tr>

<tr>
<td  class="h" >
<a name="196">196</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">   </td>
</tr>

<tr>
<td  class="h" >
<a name="197">197</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> =head1 SEE ALSO </td>
</tr>

<tr>
<td  class="h" >
<a name="198">198</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">   </td>
</tr>

<tr>
<td  class="h" >
<a name="199">199</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> L<http://www.accesspdf.com/pdftk/> </td>
</tr>

<tr>
<td  class="h" >
<a name="200">200</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">   </td>
</tr>

<tr>
<td  class="h" >
<a name="201">201</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> =head1 AUTHOR </td>
</tr>

<tr>
<td  class="h" >
<a name="202">202</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">   </td>
</tr>

<tr>
<td  class="h" >
<a name="203">203</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> Marcus Ramberg, E<lt>[e-mail]<gt> </td>
</tr>

<tr>
<td  class="h" >
<a name="204">204</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">   </td>
</tr>

<tr>
<td  class="h" >
<a name="205">205</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> =head1 COPYRIGHT AND LICENSE </td>
</tr>

<tr>
<td  class="h" >
<a name="206">206</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">   </td>
</tr>

<tr>
<td  class="h" >
<a name="207">207</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> Copyright 2004 by Mediaflex A/S. </td>
</tr>

<tr>
<td  class="h" >
<a name="208">208</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">   </td>
</tr>

<tr>
<td  class="h" >
<a name="209">209</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> This library is free software; you can redistribute it and/or modify </td>
</tr>

<tr>
<td  class="h" >
<a name="210">210</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> it under the same terms as Perl itself.  </td>
</tr>

<tr>
<td  class="h" >
<a name="211">211</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">   </td>
</tr>

<tr>
<td  class="h" >
<a name="212">212</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> =cut </td>
</tr>

</table>

</body>
</html>