File Coverage

lib/PDF/OCR/Thorough.pm

Criterion	Covered	Total	%
statement	25	27	92.5
branch			n/a
condition			n/a
subroutine	9	9	100.0
pod			n/a
total	34	36	94.4

package PDF::OCR::Thorough;
use strict;
use warnings;
use Carp;
use Cwd;
use File::Copy;
use File::Which 'which';
use File::Path;
use PDF::API2;
use PDF::GetImages;
use PDF::Burst;
use Image::OCR::Tesseract;


$PDF::OCR::Thorough::DEBUG = 0;

sub DEBUG : lvalue {$PDF::OCR::Thorough::DEBUG}

sub new {
	my($class, $arg) = @_;
	$arg or croak("missing argument to constructor");

	my $self = {};

	$self->{abs_pdf} = Cwd::abs_path($arg)
      or croak("[$arg] not resolving with Cwd::abs_path()");
	bless $self, $class;

	$self->pdf_data_ok
      or warn("the file ".$self->abs_pdf." does not check ok with PDF::API2") and return;

	return $self;
}


sub pdf_data_ok {
	my $self = shift;
	unless( defined $self->{pdf_data_ok}) {
		my $result = eval { PDF::API2->open($self->abs_pdf) };
		$result ||=0;
		$self->{pdf_data_ok} = $result;
	}
	return $self->{pdf_data_ok};
}




sub pages {
	my $self = shift;
	my $count = scalar @{$self->abs_pages};
	$count ||= 0;
	return $count;
}


sub abs_tmp {
	my $self = shift;
	unless( $self->{abs_tmp} ){
		$self->{abs_tmp} = '/tmp/'.$self->_tmpid;
		mkdir $self->{abs_tmp};
		print STDERR "abs tmp created: ".$self->{abs_tmp}."\n" if DEBUG;
	}
	return $self->{abs_tmp};
}

sub abs_pdf {
	my $self = shift;
	unless($self->{checked}){
		-f $self->{abs_pdf} or croak("is not file: $$self{abs_pdf}");
		$self->{checked}=1;
	}
	return $self->{abs_pdf};
}



sub _tmpid {
	my $self = shift;
	$self->{tmpid} ||= time.int(rand(20000));
	return $self->{tmpid};
}

sub filename {
	my $self = shift;
	my $filename = $self->abs_pdf;
	$filename=~s/^.+\/+//;
	return $filename;
}


sub abs_tmp_pdf {
	my $self = shift;
	unless( $self->{abs_tmp_pdf} ){
		$self->{abs_tmp_pdf} = $self->abs_tmp.'/'.$self->filename;
		File::Copy::cp($self->abs_pdf, $self->abs_tmp_pdf);	 # muahahaha
		print STDERR $self->abs_pdf .' copied to '.$self->abs_tmp_pdf."\n" if DEBUG;
	}
	return $self->{abs_tmp_pdf};
}

sub abs_images {
	my($self,$abs_page) = @_;

	unless(defined $abs_page){
		my @imgs;
		for(@{$self->abs_pages}){
			push @imgs, @{$self->_abs_images($_)};
		}
		return \@imgs;
	}

	return $self->_abs_images($abs_page);
}

sub _abs_images {
	my($self,$abs_pdf) =@_; $abs_pdf or croak('missing abs pdf argument to _abs_images');

	print STDERR "_abs_images [$abs_pdf]\n" if DEBUG;
	$self->{abs_images} ||={};

	unless( defined $self->{abs_images}->{$abs_pdf} ){

		my $images = PDF::GetImages::pdfimages($abs_pdf);
		$images ||=[];
		$self->{abs_images}->{$abs_pdf} = $images;

	}

	return $self->{abs_images}->{$abs_pdf};
}


sub get_page_text {
	my ($self,$abs_page) = @_;

	if ($abs_page =~/^\d+$/){

		my $abs = @{$self->abs_pages}[($abs_page+1)];
		defined $abs or warn("Page [$abs_page] does not exist?") and return;

		print STDERR " getting page $abs_page\n" if DEBUG;
		$abs_page = $abs;
	}

	my $text = $self->_get_page_text($abs_page);
	return $text;
}

sub _pdftotext {
	my $self = shift;
	$self->{pdftotextbin} ||= which('pdftotext') or die("missing pdftotext?");
	return $self->{pdftotextbin};
}

sub _get_page_text {
	my ($self,$abs_page) =@_;

	$self->{pagetext} ||= {};

	unless ( defined $self->{pagetext}->{$abs_page} ){
		print STDERR "_get_page_text for [$abs_page]\n" if DEBUG;

		my $text = '';

		#first try pdftotext
		my @command = ($self->_pdftotext,'-q',$abs_page); # even if empty will insert a pagebreak!
		system(@command); # dont try ==0, it's fruked up
		my $out = $abs_page; $out=~s/\.pdf/.txt/;

		if( -f $out	){
			$text =Image::OCR::Tesseract::_slurp($out);
			print STDERR " $out text from pdftotext [$text]\n\n" if DEBUG;
         warn("WARN Y _get_page_text has \f char") if $text=~/\f/ and DEBUG;

		}

		if (length($text) <6 ){
			print STDERR "pdftotext string is too small\n" if DEBUG;
		}

		if( length($text) <6 or $self->force_ocr){
         $text=''; # important.. to clean out what was in there
			print STDERR "extracting images for ocr\n" if DEBUG;

			my $imgstext;

			for( @{$self->abs_images($abs_page)}){
				$imgstext.= $self->get_ocr($_);
            if (DEBUG){
				   print STDERR "got ocr for $_\n";
               warn("WARN X _get_page_text has \f char") if ( $imgstext=~/\f/ );
            }


			}

			$text.=$imgstext;
		}

		unless( length($text) > 5 ){
			print STDERR "Content is negligible\n" if DEBUG;
		}

		$self->{pagetext}->{$abs_page} = $text;
	}

	return $self->{pagetext}->{$abs_page};
}





sub get_text {
	my ($self )= shift;

	unless( defined $self->{text}){
		my $text='';
      my @pgs;

		for(@{$self->abs_pages}){
			push @pgs, $self->get_page_text($_);
		}
      $text.=join "\f",@pgs;

		$self->{text} = $text;

      print STDERR "WARN get_text \\f char" if $text=~/\f/ ;

	}

	return $self->{text};
}



sub get_ocr {
	my($self,$abs_image) = @_;
	$self->{imgocr} ||={};
	unless( defined $self->{imgocr}->{$abs_image} ){
		my $imgtext = Image::OCR::Tesseract::get_ocr($abs_image);
		$imgtext ||='';

      print STDERR "WARN Image::OCR::Tesseract has \\f char" if $imgtext=~/\f/ ;
		$self->{imgocr}->{$abs_image} =$imgtext;
	}
	return $self->{imgocr}->{$abs_image};
}

sub force_ocr {
	my $self = shift;
	my $val = shift;
	if (defined $val){
		$self->{force_ocr} = $val;
	}
	$self->{force_ocr} ||= 0;
	return $self->{force_ocr};
}




sub _pdftk {
	my $self = shift;
	$self->{pdftkbin} ||= which('pdftk') or die("pdftk not installed?");
	return $self->{pdftkbin};
}




sub abs_pages {
	my $self = shift;
	unless( defined $self->{abs_pages} ){

      my $abs_tmp_pdf = $self->abs_tmp_pdf;
      my @abs_pages = PDF::Burst::pdf_burst($abs_tmp_pdf);

=pod
		my ($abs_tmp, $tmpid, $abs_tmp_pdf, $abs_pdf) =
         ($self->abs_tmp, $self->_tmpid, $self->abs_tmp_pdf, $self->abs_pdf);

		my $abs_outputname = $abs_tmp.'/'.$tmpid.'_page_%04d.pdf';
		print STDERR " abs outputname format : $abs_outputname\n" if DEBUG;


		my @args = ($self->_pdftk, $abs_tmp_pdf,'burst','output',$abs_outputname );
		unless( system(@args) == 0 ){
			warn("pdftk burst fails... system @args - $?");
			$self->{abs_pages} = [];
			return $self->{abs_pages};
		}

		print STDERR " pdftkburst ok for $abs_tmp_pdf\n" if DEBUG;

		opendir(DIR, $abs_tmp);
		my @abs_pages = map { $_=~s/^/$abs_tmp\//; $_ }
         sort grep { m/$tmpid\_page_\d+\.pdf/  } readdir DIR;
		closedir DIR;

		unless( scalar @abs_pages) {
			warn("no pages in $abs_pdf"); # or just warn() ?
			$self->{abs_pages} = [];
			return $self->{abs_pages};
		}


		if (DEBUG){
			print STDERR "pagefiles:\n";
			map { print STDERR " $_\n" } @abs_pages;
		}
=cut
		$self->{abs_pages} = \@abs_pages;
	}

	return $self->{abs_pages};
}












sub cleanup {
	my $self= shift;
	File::Path::rmtree($self->abs_tmp);
	return 1;
}

sub DESTROY {
	my $self = shift;
	if ( ( DEBUG == 0 ) and $self->abs_tmp=~/^\/tmp\/\d+/ ){
		$self->cleanup;
	#	printf STDERR "took out %s\n", $self->abs_tmp;
	}
	return 1;
}


1;




__END__