File Coverage

blib/lib/String/Filter.pm

Criterion	Covered	Total	%
statement	39	43	90.7
branch	7	12	58.3
condition	2	5	40.0
subroutine	6	8	75.0
pod	4	4	100.0
total	58	72	80.5

package String::Filter;

use strict;
use warnings;

use Regexp::Assemble;

our $VERSION = '0.01';

sub new {
    my $klass = shift;
    my $args = @_ == 1 ? $_[0] : +{ @_ };
    my $self = bless {
        rules        => [],
        default_rule => $args->{default_rule} || sub { $_[0] },
        _ra          => Regexp::Assemble->new(),
        _re          => undef,
    };
    $self->add_rule(@{$args->{rules}})
        if $args->{rules};
    return $self;
}

sub add_rule {
    my $self = shift;
    die "# of arguments is not even"
        unless @_ % 2 == 0;
    while (@_) {
        my $pattern = shift;
        my $subref = shift;
        $self->{_ra}->add($pattern);
        push @{$self->{rules}}, [ qr/^$pattern/, $subref ];
        $self->{_re} = undef;
    }
}

sub default_rule {
    my $self = shift;
    $self->{default_rule} = shift
        if @_;
    return $self->{default_rule};
}

sub filter {
    my ($self, $text) = @_;
    $self->{_re} ||= do {
        my $assembled = $self->{_ra}->re;
        qr/($assembled)/;
    };
    my @ret;
    for my $token (split /$self->{_re}/, $text) {
        next if $token eq '';
        # FIXME do we have to do this O(n) every time?
        for my $rule (@{$self->{rules}}) {
            if ($token =~ /$rule->[0]/) {
                push @ret, $rule->[1]->($token);
                goto NEXT_TOKEN;
            }
        }
        push @ret, $self->{default_rule}->($token);
    NEXT_TOKEN:
        ;
    }
    return join '', @ret;
}

1;
__END__