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


line stmt bran cond sub pod time code
1             package PDF::OCR::Thorough;
2 3     3   16960 use strict;
  3         6  
  3         102  
3 3     3   15 use warnings;
  3         8  
  3         106  
4 3     3   15 use Carp;
  3         5  
  3         270  
5 3     3   16 use Cwd;
  3         3  
  3         196  
6 3     3   2792 use File::Copy;
  3         16717  
  3         233  
7 3     3   2484 use File::Which 'which';
  3         3189  
  3         218  
8 3     3   20 use File::Path;
  3         7  
  3         394  
9 3     3   3465 use PDF::API2;
  3         945967  
  3         128  
10 3     3   5829 use PDF::GetImages;
  0            
  0            
11             use PDF::Burst;
12             use Image::OCR::Tesseract;
13              
14              
15             $PDF::OCR::Thorough::DEBUG = 0;
16              
17             sub DEBUG : lvalue {$PDF::OCR::Thorough::DEBUG}
18              
19             sub new {
20             my($class, $arg) = @_;
21             $arg or croak("missing argument to constructor");
22              
23             my $self = {};
24              
25             $self->{abs_pdf} = Cwd::abs_path($arg)
26             or croak("[$arg] not resolving with Cwd::abs_path()");
27             bless $self, $class;
28            
29             $self->pdf_data_ok
30             or warn("the file ".$self->abs_pdf." does not check ok with PDF::API2") and return;
31            
32             return $self;
33             }
34              
35              
36             sub pdf_data_ok {
37             my $self = shift;
38             unless( defined $self->{pdf_data_ok}) {
39             my $result = eval { PDF::API2->open($self->abs_pdf) };
40             $result ||=0;
41             $self->{pdf_data_ok} = $result;
42             }
43             return $self->{pdf_data_ok};
44             }
45              
46              
47              
48              
49             sub pages {
50             my $self = shift;
51             my $count = scalar @{$self->abs_pages};
52             $count ||= 0;
53             return $count;
54             }
55              
56              
57             sub abs_tmp {
58             my $self = shift;
59             unless( $self->{abs_tmp} ){
60             $self->{abs_tmp} = '/tmp/'.$self->_tmpid;
61             mkdir $self->{abs_tmp};
62             print STDERR "abs tmp created: ".$self->{abs_tmp}."\n" if DEBUG;
63             }
64             return $self->{abs_tmp};
65             }
66              
67             sub abs_pdf {
68             my $self = shift;
69             unless($self->{checked}){
70             -f $self->{abs_pdf} or croak("is not file: $$self{abs_pdf}");
71             $self->{checked}=1;
72             }
73             return $self->{abs_pdf};
74             }
75              
76              
77              
78             sub _tmpid {
79             my $self = shift;
80             $self->{tmpid} ||= time.int(rand(20000));
81             return $self->{tmpid};
82             }
83              
84             sub filename {
85             my $self = shift;
86             my $filename = $self->abs_pdf;
87             $filename=~s/^.+\/+//;
88             return $filename;
89             }
90              
91              
92             sub abs_tmp_pdf {
93             my $self = shift;
94             unless( $self->{abs_tmp_pdf} ){
95             $self->{abs_tmp_pdf} = $self->abs_tmp.'/'.$self->filename;
96             File::Copy::cp($self->abs_pdf, $self->abs_tmp_pdf); # muahahaha
97             print STDERR $self->abs_pdf .' copied to '.$self->abs_tmp_pdf."\n" if DEBUG;
98             }
99             return $self->{abs_tmp_pdf};
100             }
101              
102             sub abs_images {
103             my($self,$abs_page) = @_;
104            
105             unless(defined $abs_page){
106             my @imgs;
107             for(@{$self->abs_pages}){
108             push @imgs, @{$self->_abs_images($_)};
109             }
110             return \@imgs;
111             }
112              
113             return $self->_abs_images($abs_page);
114             }
115              
116             sub _abs_images {
117             my($self,$abs_pdf) =@_; $abs_pdf or croak('missing abs pdf argument to _abs_images');
118              
119             print STDERR "_abs_images [$abs_pdf]\n" if DEBUG;
120             $self->{abs_images} ||={};
121              
122             unless( defined $self->{abs_images}->{$abs_pdf} ){
123            
124             my $images = PDF::GetImages::pdfimages($abs_pdf);
125             $images ||=[];
126             $self->{abs_images}->{$abs_pdf} = $images;
127            
128             }
129              
130             return $self->{abs_images}->{$abs_pdf};
131             }
132              
133              
134             sub get_page_text {
135             my ($self,$abs_page) = @_;
136              
137             if ($abs_page =~/^\d+$/){
138            
139             my $abs = @{$self->abs_pages}[($abs_page+1)];
140             defined $abs or warn("Page [$abs_page] does not exist?") and return;
141              
142             print STDERR " getting page $abs_page\n" if DEBUG;
143             $abs_page = $abs;
144             }
145              
146             my $text = $self->_get_page_text($abs_page);
147             return $text;
148             }
149              
150             sub _pdftotext {
151             my $self = shift;
152             $self->{pdftotextbin} ||= which('pdftotext') or die("missing pdftotext?");
153             return $self->{pdftotextbin};
154             }
155              
156             sub _get_page_text {
157             my ($self,$abs_page) =@_;
158              
159             $self->{pagetext} ||= {};
160            
161             unless ( defined $self->{pagetext}->{$abs_page} ){
162             print STDERR "_get_page_text for [$abs_page]\n" if DEBUG;
163            
164             my $text = '';
165              
166             #first try pdftotext
167             my @command = ($self->_pdftotext,'-q',$abs_page); # even if empty will insert a pagebreak!
168             system(@command); # dont try ==0, it's fruked up
169             my $out = $abs_page; $out=~s/\.pdf/.txt/;
170              
171             if( -f $out ){
172             $text =Image::OCR::Tesseract::_slurp($out);
173             print STDERR " $out text from pdftotext [$text]\n\n" if DEBUG;
174             warn("WARN Y _get_page_text has \f char") if $text=~/\f/ and DEBUG;
175            
176             }
177            
178             if (length($text) <6 ){
179             print STDERR "pdftotext string is too small\n" if DEBUG;
180             }
181              
182             if( length($text) <6 or $self->force_ocr){
183             $text=''; # important.. to clean out what was in there
184             print STDERR "extracting images for ocr\n" if DEBUG;
185              
186             my $imgstext;
187              
188             for( @{$self->abs_images($abs_page)}){
189             $imgstext.= $self->get_ocr($_);
190             if (DEBUG){
191             print STDERR "got ocr for $_\n";
192             warn("WARN X _get_page_text has \f char") if ( $imgstext=~/\f/ );
193             }
194            
195            
196             }
197            
198             $text.=$imgstext;
199             }
200            
201             unless( length($text) > 5 ){
202             print STDERR "Content is negligible\n" if DEBUG;
203             }
204              
205             $self->{pagetext}->{$abs_page} = $text;
206             }
207              
208             return $self->{pagetext}->{$abs_page};
209             }
210              
211              
212              
213              
214              
215             sub get_text {
216             my ($self )= shift;
217              
218             unless( defined $self->{text}){
219             my $text='';
220             my @pgs;
221            
222             for(@{$self->abs_pages}){
223             push @pgs, $self->get_page_text($_);
224             }
225             $text.=join "\f",@pgs;
226            
227             $self->{text} = $text;
228              
229             print STDERR "WARN get_text \\f char" if $text=~/\f/ ;
230            
231             }
232            
233             return $self->{text};
234             }
235              
236              
237              
238             sub get_ocr {
239             my($self,$abs_image) = @_;
240             $self->{imgocr} ||={};
241             unless( defined $self->{imgocr}->{$abs_image} ){
242             my $imgtext = Image::OCR::Tesseract::get_ocr($abs_image);
243             $imgtext ||='';
244              
245             print STDERR "WARN Image::OCR::Tesseract has \\f char" if $imgtext=~/\f/ ;
246             $self->{imgocr}->{$abs_image} =$imgtext;
247             }
248             return $self->{imgocr}->{$abs_image};
249             }
250              
251             sub force_ocr {
252             my $self = shift;
253             my $val = shift;
254             if (defined $val){
255             $self->{force_ocr} = $val;
256             }
257             $self->{force_ocr} ||= 0;
258             return $self->{force_ocr};
259             }
260              
261              
262              
263              
264             sub _pdftk {
265             my $self = shift;
266             $self->{pdftkbin} ||= which('pdftk') or die("pdftk not installed?");
267             return $self->{pdftkbin};
268             }
269              
270              
271              
272              
273             sub abs_pages {
274             my $self = shift;
275             unless( defined $self->{abs_pages} ){
276              
277             my $abs_tmp_pdf = $self->abs_tmp_pdf;
278             my @abs_pages = PDF::Burst::pdf_burst($abs_tmp_pdf);
279              
280             =pod
281             my ($abs_tmp, $tmpid, $abs_tmp_pdf, $abs_pdf) =
282             ($self->abs_tmp, $self->_tmpid, $self->abs_tmp_pdf, $self->abs_pdf);
283              
284             my $abs_outputname = $abs_tmp.'/'.$tmpid.'_page_%04d.pdf';
285             print STDERR " abs outputname format : $abs_outputname\n" if DEBUG;
286            
287              
288             my @args = ($self->_pdftk, $abs_tmp_pdf,'burst','output',$abs_outputname );
289             unless( system(@args) == 0 ){
290             warn("pdftk burst fails... system @args - $?");
291             $self->{abs_pages} = [];
292             return $self->{abs_pages};
293             }
294              
295             print STDERR " pdftkburst ok for $abs_tmp_pdf\n" if DEBUG;
296              
297             opendir(DIR, $abs_tmp);
298             my @abs_pages = map { $_=~s/^/$abs_tmp\//; $_ }
299             sort grep { m/$tmpid\_page_\d+\.pdf/ } readdir DIR;
300             closedir DIR;
301              
302             unless( scalar @abs_pages) {
303             warn("no pages in $abs_pdf"); # or just warn() ?
304             $self->{abs_pages} = [];
305             return $self->{abs_pages};
306             }
307              
308              
309             if (DEBUG){
310             print STDERR "pagefiles:\n";
311             map { print STDERR " $_\n" } @abs_pages;
312             }
313             =cut
314             $self->{abs_pages} = \@abs_pages;
315             }
316              
317             return $self->{abs_pages};
318             }
319              
320              
321              
322              
323              
324              
325              
326              
327              
328              
329              
330              
331             sub cleanup {
332             my $self= shift;
333             File::Path::rmtree($self->abs_tmp);
334             return 1;
335             }
336              
337             sub DESTROY {
338             my $self = shift;
339             if ( ( DEBUG == 0 ) and $self->abs_tmp=~/^\/tmp\/\d+/ ){
340             $self->cleanup;
341             # printf STDERR "took out %s\n", $self->abs_tmp;
342             }
343             return 1;
344             }
345              
346              
347             1;
348              
349              
350              
351              
352             __END__