File Coverage

blib/lib/Search/Tools.pm
Criterion Covered Total %
statement 40 52 76.9
branch 3 8 37.5
condition 1 3 33.3
subroutine 11 14 78.5
pod 7 7 100.0
total 62 84 73.8


line stmt bran cond sub pod time code
1             package Search::Tools;
2 40     40   265997 use 5.008_003;
  40         195  
3 40     40   224 use strict;
  40         79  
  40         1012  
4 40     40   229 use warnings::register;
  40         75  
  40         5388  
5 40     40   330 use Carp;
  40         95  
  40         2664  
6 40     40   265 use Scalar::Util qw( openhandle );
  40         86  
  40         2363  
7 40     40   293 use File::Basename;
  40         94  
  40         4583  
8              
9             our $VERSION = '1.007';
10              
11 40     40   311 use XSLoader;
  40         123  
  40         23359  
12             XSLoader::load( 'Search::Tools', $VERSION );
13              
14             our $XS_DEBUG = 0;
15              
16             sub parser {
17 19     19 1 9353 my $class = shift;
18 19         8971 require Search::Tools::QueryParser;
19 19         277 return Search::Tools::QueryParser->new(@_);
20             }
21              
22             sub regexp {
23 0     0 1 0 my $class = shift;
24              
25 0         0 croak("as of version 0.24 you should use parser() instead of regexp()");
26             }
27              
28             sub hiliter {
29 11     11 1 1966 my $class = shift;
30 11         3932 require Search::Tools::HiLiter;
31 11         214 return Search::Tools::HiLiter->new(@_);
32             }
33              
34             sub snipper {
35 6     6 1 1399 my $class = shift;
36 6         2532 require Search::Tools::Snipper;
37 6         109 return Search::Tools::Snipper->new(@_);
38             }
39              
40             sub transliterate {
41 0     0 1 0 my $class = shift;
42 0         0 require Search::Tools::Transliterate;
43 0         0 return Search::Tools::Transliterate->new->convert(@_);
44             }
45              
46             sub spellcheck {
47 0     0 1 0 my $class = shift;
48 0         0 require Search::Tools::SpellCheck;
49 0         0 return Search::Tools::SpellCheck->new(@_);
50             }
51              
52             sub slurp {
53 16     16 1 9427 my ( $self, $file ) = @_;
54 16         53 my ( $buf, $fh );
55 16         1310 my ( $name, $path, $suffix ) = fileparse( $file, qr/\.[^.]*/ );
56 16         108 $suffix = lc($suffix);
57 16 50       110 if ( $suffix eq '.gz' ) {
    50          
58 0         0 require IO::Uncompress::Gunzip;
59 0         0 $fh = IO::Uncompress::Gunzip->new($file);
60             }
61             elsif ( $suffix eq '.bz2' ) {
62 0         0 require IO::Uncompress::Bunzip2;
63 0 0       0 $fh = IO::Uncompress::Bunzip2->new($file)
64             or die "bunzip2 failed: $IO::Uncompress::Bunzip2::Bunzip2Error\n";
65              
66             }
67             else {
68 16         8187 require IO::File;
69 16   33     129072 $fh = openhandle($file) || IO::File->new( $file, '<' );
70             }
71              
72 16 50       2213 die "Failed to open $file: $!" unless $fh;
73              
74 16         558 while ( my $ln = $fh->getline ) {
75 1918         78161 $buf .= $ln;
76             }
77              
78 16         1165 return $buf;
79             }
80              
81             1;
82              
83             __END__