File Coverage

blib/lib/Grammar/Marpa.pm

Criterion	Covered	Total	%
statement	16	18	88.8
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	22	24	91.6

package Grammar::Marpa;

use strict;
use warnings;
use 5.018;
use utf8;
use overload ('qr' => 'regexify', fallback => 0);

use Marpa::R2;

our $VERSION = '2.004';

sub regexify {
    my ($grammar) = @_;
    use re 'eval';
    return qr/(?{Grammar::Marpa::parse($grammar, "$_")})/;
}

sub new {
    my $class = shift;
    $class = ref($class) || $class;
    my $ebnf = ref($_[0]) eq 'HASH' ? undef : shift(@_);
    my $pkg;
    my %args;
    if (ref ($_[-1]) eq 'HASH') {
        %args = %{pop(@_)};
        $pkg = shift(@_) // (caller)[0];
    }
    elsif (@_ % 2) {
        $pkg = shift;
        %args = @_;
    }
    else {
        $pkg = (caller)[0];
        %args = @_;
    }
    my %Gargs;
    $Gargs{ bless_package } = delete $args{ bless_package } if $args{ bless_package };
    $Gargs{ trace_file_handle } = $args{ trace_file_handle } if $args{ trace_file_handle };
    $ebnf //= delete $args{ source };
    $ebnf = $$ebnf if ref($ebnf);
    my $G = Marpa::R2::Scanless::G->new({ source => \$ebnf, %Gargs });
    return bless [ $G, $pkg, \%args ] => $class;
}

sub parse {
    my ($grammar, $string) = @_;
    my $R = Marpa::R2::Scanless::R->new({ grammar => $grammar->[ 0 ], semantics_package => $grammar->[ 1 ], %{$grammar->[ 2 ]} });
    $R->read(\$string);
    my $V = $R->value or return;
    return $$V;
}

package Grammar;

sub Marpa {
    return Grammar::Marpa->new(@_);
}

1;

__END__