File Coverage

blib/lib/Text/Trie.pm

Criterion	Covered	Total	%
statement	38	38	100.0
branch	15	22	68.1
condition	4	6	66.6
subroutine	3	3	100.0
pod	2	2	100.0
total	62	71	87.3

package Text::Trie;

use integer;
require 5.000;
require Exporter;

@ISA = qw(Exporter);
@EXPORT_OK = qw(Trie walkTrie);

$step = 1 unless defined $step;	# Length of unit. All the arguments should
				# have length that is multiple of this.
				# Length of any cell in trie will be multiple
				# too.

sub Trie {
  my @list = @_;
  return shift if @_ == 1;
  my %first;
  my @ans;
  foreach (@list) {
    $c = substr $_, 0, $step;
    $first{$c} = [] unless defined $first{$c};
    push @{$first{$c}}, $_;
  }
  foreach (keys %first) {
    # Find common substring
    my $substr = $first{$_}->[0];
    (push @ans, $substr), next if @{$first{$_}} == 1;
    $l = length($substr) / $step * $step;
    foreach (@{$first{$_}}) {
      $l -= $step while substr($_, 0, $l) ne substr($substr, 0, $l);
    }
    $substr = substr $substr, 0, $l;
    # Return value
    @list = map {substr $_, $l} @{$first{$_}};
    push @ans, [$substr, Trie(@list)];
  }
  @ans;
}

sub walkTrie {
  my ($singlesub,$headsub,$notsinglesub,$sepsub,$opensub,$closesub,@trie) = @_;
  my $num = 0;
  foreach (@trie) {
    &$sepsub($_) if $num++ and defined $sepsub;
    if (defined ref $_ and ref $_ eq 'ARRAY') {
      &$opensub($_) if defined $opensub;
      &$headsub(@$_[0]) if defined $headsub;
      if ($#$_ > 1) {
	&$notsinglesub($_) if defined $notsinglesub;
	walkTrie($singlesub, $headsub, $notsinglesub, $sepsub, $opensub,
		 $closesub, @{$_}[1 .. $#$_]);
      }
      &$closesub($_) if defined $closesub;
    } else {
      &$singlesub($_) if defined $singlesub;
    }
  }
}

1;
__END__