File Coverage

blib/lib/Search/WuManber.pm
Criterion Covered Total %
statement 28 35 80.0
branch 7 14 50.0
condition 4 9 44.4
subroutine 5 7 71.4
pod 0 4 0.0
total 44 69 63.7


line stmt bran cond sub pod time code
1             #
2             # WuManber.pm
3             #
4             # Copyright (c) 2007-2011, Juergen Weigert, openSUSE.org
5             # This module is free software. It may be used, redistributed
6             # and/or modified under the same terms as Perl (version 5.8.8) itself.
7             #
8             # This used to have a first() / next() iterator interface, which turned out to be
9             # incompatible with the chaotic state machine of wu manber mgrep implementation.
10             # Deprecated if favour of a simpler but more memory hungry find_all().
11              
12             package Search::WuManber;
13              
14 2     2   60147 use strict;
  2         6  
  2         99  
15 2     2   10 use warnings;
  2         3  
  2         135  
16              
17             require Exporter;
18             require DynaLoader;
19              
20 2     2   60 use base qw(Exporter DynaLoader);
  2         8  
  2         9820  
21             our @EXPORT_OK = qw(); # exportable
22             our $VERSION = '0.25';
23              
24             bootstrap Search::WuManber $VERSION;
25              
26             sub new
27             {
28 1     1 0 26 my ($self, $list, $opts) = @_;
29 1   33     8 my $class = ref($self) || $self;
30 1 50       7 die "new: patterns parameter not an ARRAY-ref\n" unless ref $list eq 'ARRAY';
31 1         4 my $this = { patterns => $list };
32              
33 1         11 my %opt =
34             (
35             return_string => 0,
36             case_sensitive => 1,
37             );
38              
39 1         6 for my $o (keys %opt)
40             {
41 2 100 66     18 $this->{$o} = ($opts && defined($opts->{$o})) ? $opts->{$o} : $opt{$o};
42 2 50       11 delete $opts->{$o} if $opts;
43             }
44              
45 1 50       6 die "new: unknown options: ". join(',', keys %$opts) . "\n try these: " . join(',', keys %opt) . "\n" if keys %$opts;
46              
47 1         6 my $time = time();
48 1 50       820 init_tables($this) or die "internal error: init_tables failed.\n";
49 1         5 $this->{init_time_sec} = time() - $time;
50              
51 1         8 return bless $this, $class;
52             }
53              
54             sub first
55             {
56 0     0 0 0 my ($self, $text) = @_;
57 0         0 delete $self->{result};
58 0         0 return $self->next($text);
59             }
60              
61             # This is a method, not a bare subroutine.
62             sub next ## no critic (ProhibitBuiltinHomonyms)
63             {
64 0     0 0 0 my ($self,$text) = @_;
65 0 0       0 $self->{result} = $self->all($text) unless $self->{result};
66              
67             # my $o = shift @{$self->{result}};
68             # my $i = shift @{$self->{result}};
69             # return [$o, $i];
70 0         0 return shift @{$self->{result}};
  0         0  
71             }
72              
73             sub all
74             {
75 1     1 0 40 my ($self, $text) = @_;
76 1         48 my $m = find_all($self, $text);
77 1 50 33     11 if ($m && $self->{return_string})
78             {
79 1         4 for my $p (@$m)
80             {
81 16         32 push @$p, $self->{patterns}[$p->[1]];
82             }
83             }
84 1         9 return $m;
85             }
86              
87             1;
88             __END__