File Coverage

blib/lib/FLAT/Regex/Parser.pm

Criterion	Covered	Total	%
statement	23	23	100.0
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod	0	1	0.0
total	27	28	96.4

package FLAT::Regex::Parser;
use strict;

#### Is this one level of abstraction too far? Parser generator generators..

#### TODO: try YAPP, since recursive descent is SLOOOW
use Parse::RecDescent;
use FLAT::Regex::Op;

our $CHAR = qr{ [A-Za-z0-9_\$\#\%\@\;\:\-\^] | \[[^\]]*\] }x;

sub new {
    my $pkg = shift;
    my @ops = sort {$a->{prec} <=> $b->{prec}}
        map {
        {
            pkg   => "FLAT::Regex::Op::$_",
            prec  => "FLAT::Regex::Op::$_"->precedence,
            spec  => "FLAT::Regex::Op::$_"->parse_spec,
            short => $_
        }
        } @_;

    my $lowest  = shift @ops;
    my $grammar = qq!
            parse:
                $lowest->{short} /^\\Z/ { \$item[1] }
    !;

    my $prev = $lowest;
    for (@ops) {
        my $spec = sprintf $prev->{spec}, $_->{short};

        $grammar .= qq!
            $prev->{short}:
                $spec       { $prev->{pkg}\->from_parse(\@item) }
              | $_->{short} { \$item[1] }
        !;

        $prev = $_;
    }

    my $spec = sprintf $prev->{spec}, "atomic";
    $grammar .= qq!
            $prev->{short}:
                $spec  { $prev->{pkg}\->from_parse(\@item) }
              | atomic { \$item[1] }

            atomic:
                "(" $lowest->{short} ")" { \$item[2] }
              | /\$FLAT::Regex::Parser::CHAR/
                          { FLAT::Regex::Op::atomic->from_parse(\@item) }
    !;

    Parse::RecDescent->new($grammar);
}

1;

__END__