File Coverage

blib/lib/FLAT/Regex.pm

Criterion	Covered	Total	%
statement	43	57	75.4
branch	3	4	75.0
condition	2	3	66.6
subroutine	19	24	79.1
pod	14	16	87.5
total	81	104	77.8

package FLAT::Regex;
use parent 'FLAT';
use strict;
use Carp;

use FLAT::Regex::Parser;
use FLAT::Regex::Op;

my $PARSER = FLAT::Regex::Parser->new(qw[ alt concat star ]);
#### TODO: error checking in the parse

sub _parser { $PARSER }

sub new {
    my ( $pkg, $string ) = @_;
    my $result = $pkg->_parser->parse($string)
      or croak qq[``$string'' is not a valid regular expression];

    $pkg->_from_op($result);
}

sub _from_op {
    my ( $proto, $op ) = @_;
    $proto = ref $proto || $proto;    ## I really do want this

    bless [$op], $proto;
}

sub op {
    $_[0][0];
}

use overload '""' => 'as_string';

sub as_string {
    $_[0]->op->as_string(0);
}

sub as_perl_regex {
    my ( $self, %opts ) = @_;

    my $fmt = $opts{anchored} ? '(?:\A%s\z)' : '(?:%s)';
    return sprintf $fmt, $self->op->as_perl_regex(0);
}

sub contains {
    my ( $self, $string ) = @_;
    $string =~ $self->as_perl_regex( anchored => 1 );
}

sub as_nfa {
    $_[0]->op->as_nfa;
}

sub as_pfa {
    $_[0]->op->as_pfa;
}

#### regular language standard interface implementation:
#### TODO: parameter checking?

sub as_regex {
    $_[0];
}

sub union {
    my $self = $_[0];
    my $op   = FLAT::Regex::Op::alt->new( map { $_->as_regex->op } @_ );
    $self->_from_op($op);
}

sub intersect {
    my @dfas = map { $_->as_dfa } @_;
    my $self = shift @dfas;
    $self->intersect(@dfas)->as_regex;
}

sub complement {
    my $self = shift;
    $self->as_dfa->complement->as_regex;
}

sub concat {
    my $self = $_[0];
    my $op   = FLAT::Regex::Op::concat->new( map { $_->as_regex->op } @_ );
    $self->_from_op($op);
}

sub kleene {
    my $self = shift;
    my $op   = FLAT::Regex::Op::star->new( $self->op );
    $self->_from_op($op);
}

sub reverse {
    my $self = shift;
    my $op   = $self->op->reverse;
    $self->_from_op($op);
}

sub is_empty {
    $_[0]->op->is_empty;
}

sub is_finite {
    $_[0]->op->is_finite;
}

1;

__END__