File Coverage

blib/lib/Regexp/Trie.pm

Criterion	Covered	Total	%
statement	9	36	25.0
branch	0	16	0.0
condition	0	5	0.0
subroutine	3	7	42.8
pod	0	3	0.0
total	12	67	17.9

#
# $Id: Trie.pm,v 0.2 2006/04/27 05:24:40 dankogai Exp dankogai $
#

package Regexp::Trie;
use 5.008001;
use strict;
use warnings;

our $VERSION = sprintf "%d.%02d", q$Revision: 0.2 $ =~ /(\d+)/g;

# use overload q("") => sub { shift->regexp };

sub new{ bless {} => shift }
sub add{
    my $self = shift;
    my $str  = shift;
    my $ref  = $self;
    for my $char (split //, $str){
        $ref->{$char} ||= {};
        $ref = $ref->{$char};
    }
    $ref->{''} = 1; # { '' => 1 } as terminator
    $self;
}
sub _regexp{
    my $self = shift;
    return if $self->{''} and scalar keys %$self == 1; # terminator
    my (@alt, @cc);
    my $q = 0;
    for my $char (sort keys %$self){
        my $qchar = quotemeta $char;
        if (ref $self->{$char}){
            if (defined (my $recurse = _regexp($self->{$char}))){
                push @alt, $qchar . $recurse;
            }else{
                push @cc, $qchar;
            }
        }else{
            $q = 1;
        }
    }
    my $cconly = !@alt;
    @cc and push @alt, @cc == 1 ? $cc[0] : '['. join('', @cc). ']';
    my $result = @alt == 1 ? $alt[0] : '(?:' . join('|', @alt) . ')';
    $q and $result = $cconly ? "$result?" : "(?:$result)?";
    return $result;
}
sub regexp{ my $str = shift->_regexp; qr/$str/ }

1;
__END__