File Coverage

blib/lib/Apache/Tika/Async.pm
Criterion Covered Total %
statement 12 55 21.8
branch 0 4 0.0
condition n/a
subroutine 4 17 23.5
pod 0 11 0.0
total 16 87 18.3


line stmt bran cond sub pod time code
1             package Apache::Tika::Async;
2 1     1   425 use strict;
  1         2  
  1         26  
3 1     1   5 use Moo 2;
  1         12  
  1         4  
4 1     1   851 use JSON::XS qw(decode_json);
  1         4270  
  1         50  
5 1     1   604 use File::Temp 'tempfile';
  1         15460  
  1         810  
6              
7             our $VERSION = '0.11';
8              
9             =head1 NAME
10              
11             Apache::Tika::Async - connect to Apache Tika
12              
13             =head1 SYNOPSIS
14              
15             use Apache::Tika::Async;
16              
17             my $tika= Apache::Tika::Async->new;
18              
19             my $fn= shift;
20              
21             use Data::Dumper;
22             my $info = $tika->get_all( $fn );
23             print Dumper $info->meta($fn);
24             print $info->content($fn);
25             # ...
26             print $info->meta->{"meta:language"};
27             # en
28              
29             =head1 ACCESSORS
30              
31             =cut
32              
33             =head2 B
34              
35             jarfile => '/opt/tika/tika-standard-2.9.9.jar',
36              
37             Sets the Tika Jarfile to be used. The default is to look
38             in the directory C below the current directory.
39              
40             =cut
41              
42             has 'jarfile' => (
43             is => 'rw',
44             #isa => 'Str',
45             # tika-server-1.24.1.jar
46             # tika-server-standard-2.3.0.jar
47              
48             default => sub {
49             $ENV{PERL_APACHE_TIKA_PATH} ||
50             __PACKAGE__->best_jar_file(
51             glob 'jar/tika-server-*.jar'
52             );
53             },
54             );
55              
56             =head2 B
57              
58             tika_args => [],
59              
60             Additional Tika command line options.
61              
62             =cut
63              
64              
65             has tika_args => (
66             is => 'rw',
67             #isa => 'Array',
68             default => sub { [ ] },
69             );
70              
71             =head2 B
72              
73             java => '/opt/openjdk-11-jre/bin/java',
74              
75             Sets the Java executable to be used.
76              
77             =cut
78              
79             has java => (
80             is => 'rw',
81             #isa => 'Str',
82             default => 'java',
83             );
84              
85             =head2 B
86              
87             java_args => [],
88              
89             Sets the Java options to be used.
90              
91             =cut
92              
93             has java_args => (
94             is => 'rw',
95             #isa => 'Array',
96             builder => sub { [
97             # So that Tika can re-read some problematic PDF files better
98 0     0     '-Dorg.apache.pdfbox.baseParser.pushBackSize=1000000'
99             ] },
100             );
101              
102             sub _tika_config_xml {
103 0     0     my( $self, %entries ) = @_;
104             return join '',
105             '',
106             '',
107             '',
108             '',
109             '',
110 0           (map { join '', "<$_>" => $entries{ $_ } => "" } sort keys %entries),
  0            
111             '',
112             '',
113             '',
114             }
115              
116             sub tika_config {
117 0     0 0   my( $self, %entries ) = @_;
118 0           return $self->_tika_config_xml(
119             logLevel => $self->loglevel,
120             %entries
121             );
122             }
123              
124             sub tika_config_temp_file {
125 0     0 0   my( $self, %entries ) = @_;
126              
127 0           my( $fh, $name ) = tempfile();
128 0           binmode $fh;
129 0           print {$fh} $self->tika_config(%entries);
  0            
130 0           close $fh;
131              
132 0           return $name;
133             }
134              
135             sub best_jar_file {
136 0     0 0   my( $package, @files ) = @_;
137             # Do a natural sort on the dot-version
138 0 0         (sort { my $ad; $a =~ /\bserver-(?:standard-|)(\d+)\.(\d+)/ and $ad=sprintf '%02d.%04d', $1, $2;
  0            
  0            
139 0 0         my $bd; $b =~ /\bserver-(?:standard-|)(\d+)\.(\d+)/ and $bd=sprintf '%02d.%04d', $1, $2;
  0            
140 0           $bd <=> $ad
141             } @files)[0]
142             }
143              
144             sub cmdline {
145 0     0 0   my( $self )= @_;
146             $self->java,
147 0           @{$self->java_args},
148             '-jar',
149             $self->jarfile,
150             '--config', $self->tika_config_temp_file,
151 0           @{$self->tika_args},
  0            
152             };
153              
154             sub fetch {
155 0     0 0   my( $self, %options )= @_;
156 0           my @cmd= $self->cmdline;
157 0           push @cmd, $options{ type };
158 0           push @cmd, $options{ filename };
159 0           @cmd= map { qq{"$_"} } @cmd;
  0            
160             #die "Fetching from local process is currently disabled";
161             #warn "[@cmd]";
162 0           '' . readpipe(@cmd)
163             }
164              
165             sub decode_csv {
166 0     0 0   my( $self, $line )= @_;
167 0           $line =~ m!"([^"]+)"!g;
168             }
169              
170             sub get_meta {
171 0     0 0   my( $self, $file )= @_;
172             #return decode_json($self->fetch( filename => $file, type => 'meta' ));
173             # Hacky CSV-to-hash decode :-/
174 0           return $self->fetch( filename => $file, type => 'meta' )->meta->get;
175             };
176              
177             sub get_text {
178 0     0 0   my( $self, $file )= @_;
179 0           return $self->fetch( filename => $file, type => 'text' )->get;
180             };
181              
182             sub get_test {
183 0     0 0   my( $self, $file )= @_;
184 0           return $self->fetch( filename => $file, type => 'test' )->get;
185             };
186              
187             sub get_all {
188 0     0 0   my( $self, $file )= @_;
189 0           return $self->fetch( filename => $file, type => 'all' )->get;
190             };
191              
192             sub get_language {
193 0     0 0   my( $self, $file )= @_;
194 0           return $self->fetch( filename => $file, type => 'language' )->get;
195             };
196              
197             # ->detect_stream wants not a file but the input bytes
198             # sub detect_stream {
199             # my( $self, $file )= @_;
200             # return $self->fetch( filename => $file, type => 'all' )->get;
201             # };
202              
203             # __PACKAGE__->meta->make_immutable;
204              
205             1;
206              
207             =head1 ENVIRONMENT
208              
209             To specify the Tika jar file from the outside, you can set the
210             C environment variable.
211              
212             =head1 REPOSITORY
213              
214             The public repository of this module is
215             L.
216              
217             =head1 SUPPORT
218              
219             The public support forum of this module is
220             L.
221              
222             =head1 BUG TRACKER
223              
224             Please report bugs in this module via the RT CPAN bug queue at
225             L
226             or via mail to L.
227              
228             =head1 AUTHOR
229              
230             Max Maischein C
231              
232             =head1 COPYRIGHT (c)
233              
234             Copyright 2014-2019 by Max Maischein C.
235              
236             =head1 LICENSE
237              
238             This module is released under the same terms as Perl itself.
239              
240             =cut