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


line stmt bran cond sub pod time code
1             package Grammar::Marpa;
2              
3 1     1   16808 use strict;
  1         1  
  1         37  
4 1     1   5 use warnings;
  1         1  
  1         26  
5 1     1   18 use 5.018;
  1         6  
  1         20  
6 1     1   553 use utf8;
  1         8  
  1         4  
7 1     1   1007 use overload ('qr' => 'regexify', fallback => 0);
  1         835  
  1         4  
8              
9 1     1   1033 use Marpa::R2;
  0            
  0            
10              
11             our $VERSION = '2.003';
12              
13             sub regexify {
14             my ($grammar) = @_;
15             use re 'eval';
16             return qr/(?{Grammar::Marpa::parse($grammar, "$_")})/;
17             }
18              
19             sub new {
20             my $class = shift;
21             $class = ref($class) || $class;
22             my $ebnf = ref($_[0]) eq 'HASH' ? undef : shift(@_);
23             my $pkg;
24             my %args;
25             if (ref ($_[-1]) eq 'HASH') {
26             %args = %{pop(@_)};
27             $pkg = shift(@_) // (caller)[0];
28             }
29             elsif (@_ % 2) {
30             $pkg = shift;
31             %args = @_;
32             }
33             else {
34             $pkg = (caller)[0];
35             %args = @_;
36             }
37             my %Gargs;
38             $Gargs{ bless_package } = delete $args{ bless_package } if $args{ bless_package };
39             $Gargs{ trace_file_handle } = $args{ trace_file_handle } if $args{ trace_file_handle };
40             $ebnf //= delete $args{ source };
41             $ebnf = $$ebnf if ref($ebnf);
42             my $G = Marpa::R2::Scanless::G->new({ source => \$ebnf, %Gargs });
43             return bless [ $G, $pkg, \%args ] => $class;
44             }
45              
46             sub parse {
47             my ($grammar, $string) = @_;
48             my $R = Marpa::R2::Scanless::R->new({ grammar => $grammar->[ 0 ], semantics_package => $grammar->[ 1 ], %{$grammar->[ 2 ]} });
49             $R->read(\$string);
50             my $V = $R->value or return;
51             return $$V;
52             }
53              
54             package Grammar;
55              
56             sub Marpa {
57             return Grammar::Marpa->new(@_);
58             }
59              
60             1;
61              
62             __END__