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

#
# WuManber.pm
#
# Copyright (c) 2007-2011, Juergen Weigert, openSUSE.org
# This module is free software. It may be used, redistributed
# and/or modified under the same terms as Perl (version 5.8.8) itself.
#
# This used to have a first() / next() iterator interface, which turned out to be
# incompatible with the chaotic state machine of wu manber mgrep implementation.
# Deprecated if favour of a simpler but more memory hungry find_all().

package Search::WuManber;

use strict;
use warnings;

require Exporter;
require DynaLoader;

use base qw(Exporter DynaLoader);
our @EXPORT_OK = qw();          # exportable
our $VERSION = '0.25';

bootstrap Search::WuManber $VERSION;

sub new
{
  my ($self, $list, $opts) = @_;
  my $class = ref($self) || $self;
  die "new: patterns parameter not an ARRAY-ref\n" unless ref $list eq 'ARRAY';
  my $this = { patterns => $list };

  my %opt =
    (
      return_string => 0,
      case_sensitive => 1,
    );

  for my $o (keys %opt)
    {
      $this->{$o} = ($opts && defined($opts->{$o})) ? $opts->{$o} : $opt{$o};
      delete $opts->{$o} if $opts;
    }

  die "new: unknown options: ". join(',', keys %$opts) . "\n try these: " . join(',', keys %opt) . "\n" if keys %$opts;

  my $time = time();
  init_tables($this) or die "internal error: init_tables failed.\n";
  $this->{init_time_sec} = time() - $time;

  return bless $this, $class;
}

sub first
{
  my ($self, $text) = @_;
  delete $self->{result};
  return $self->next($text);
}

# This is a method, not a bare subroutine.
sub next             ## no critic (ProhibitBuiltinHomonyms)
{
  my ($self,$text) = @_;
  $self->{result} = $self->all($text) unless $self->{result};

#  my $o = shift @{$self->{result}};
#  my $i = shift @{$self->{result}};
#  return [$o, $i];
  return shift @{$self->{result}};
}

sub all
{
  my ($self, $text) = @_;
  my $m = find_all($self, $text);
  if ($m && $self->{return_string})
    {
      for my $p (@$m)
        {
	  push @$p, $self->{patterns}[$p->[1]];
	}
    }
  return $m;
}

1;
__END__