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   192763 use 5.008_003;
  40         139  
3 40     40   180 use strict;
  40         56  
  40         756  
4 40     40   159 use warnings::register;
  40         60  
  40         3869  
5 40     40   220 use Carp;
  40         79  
  40         2010  
6 40     40   189 use Scalar::Util qw( openhandle );
  40         59  
  40         1648  
7 40     40   202 use File::Basename;
  40         65  
  40         3246  
8              
9             our $VERSION = '1.006';
10              
11 40     40   225 use XSLoader;
  40         87  
  40         17113  
12             XSLoader::load( 'Search::Tools', $VERSION );
13              
14             our $XS_DEBUG = 0;
15              
16             sub parser {
17 19     19 1 8199 my $class = shift;
18 19         5969 require Search::Tools::QueryParser;
19 19         207 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 2092 my $class = shift;
30 11         2892 require Search::Tools::HiLiter;
31 11         124 return Search::Tools::HiLiter->new(@_);
32             }
33              
34             sub snipper {
35 6     6 1 1126 my $class = shift;
36 6         1689 require Search::Tools::Snipper;
37 6         69 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 6246 my ( $self, $file ) = @_;
54 16         38 my ( $buf, $fh );
55 16         1013 my ( $name, $path, $suffix ) = fileparse( $file, qr/\.[^.]*/ );
56 16         82 $suffix = lc($suffix);
57 16 50       84 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         5730 require IO::File;
69 16   33     94326 $fh = openhandle($file) || IO::File->new( $file, '<' );
70             }
71              
72 16 50       1425 die "Failed to open $file: $!" unless $fh;
73              
74 16         426 while ( my $ln = $fh->getline ) {
75 1918         53977 $buf .= $ln;
76             }
77              
78 16         745 return $buf;
79             }
80              
81             1;
82              
83             __END__