File Coverage

inc/Pegex/Grammar.pm
Criterion Covered Total %
statement 6 72 8.3
branch 1 34 2.9
condition 2 6 33.3
subroutine 2 5 40.0
pod 1 3 33.3
total 12 120 10.0


line stmt bran cond sub pod time code
1             package Pegex::Grammar;
2 1     1   7596 use Pegex::Base;
  1         3  
  1         7  
3              
4             # Grammar can be in text or tree form. Tree will be compiled from text.
5             # Grammar can also be stored in a file.
6             has file => ();
7             has text => (
8             builder => 'make_text',
9             lazy => 1,
10             );
11             has tree => (
12             builder => 'make_tree',
13             lazy => 1,
14             );
15             has start_rules => [];
16              
17             sub make_text {
18 0     0 0 0 my ($self) = @_;
19 0 0       0 my $filename = $self->file
20             or return '';
21 0 0       0 open TEXT, $filename
22             or die "Can't open '$filename' for input\n:$!";
23 0         0 return do {local $/; <TEXT>}
  0         0  
  0         0  
24             }
25              
26             sub make_tree {
27 0     0 1 0 my ($self) = @_;
28 0 0       0 my $text = $self->text
29             or die "Can't create a '" . ref($self) .
30             "' grammar. No tree or text or file.";
31 0         0 require Pegex::Compiler;
32 0 0       0 return Pegex::Compiler->new->compile(
33             $text,
34 0         0 @{$self->start_rules || []}
35             )->tree;
36             }
37              
38             # This import is to support: perl -MPegex::Grammar::Module=compile
39             sub import {
40 2     2   63 my ($package) = @_;
41 2 0 33     19 if (((caller))[1] =~ /^-e?$/ and @_ == 2 and $_[1] eq 'compile') {
      33        
42 0         0 $package->compile_into_module();
43 0         0 exit;
44             }
45 2 50       72 if (my $env = $ENV{PERL_PEGEX_AUTO_COMPILE}) {
46 0           my %modules = map {($_, 1)} split ',', $env;
  0            
47 0 0         if ($modules{$package}) {
48 0 0         if (my $grammar_file = $package->file) {
49 0 0         if (-f $grammar_file) {
50 0           my $module = $package;
51 0           $module =~ s!::!/!g;
52 0           $module .= '.pm';
53 0           my $module_file = $INC{$module};
54 0 0         if (-M $grammar_file < -M $module_file) {
55 0           $package->compile_into_module();
56 0           local $SIG{__WARN__};
57 0           delete $INC{$module};
58 0           require $module;
59             }
60             }
61             }
62             }
63             }
64             }
65              
66             sub compile_into_module {
67 0     0 0   my ($package) = @_;
68 0           my $grammar_file = $package->file;
69 0 0         open GRAMMAR, $grammar_file
70             or die "Can't open $grammar_file for input";
71 0           my $grammar_text = do {local $/; <GRAMMAR>};
  0            
  0            
72 0           close GRAMMAR;
73 0           my $module = $package;
74 0           $module =~ s!::!/!g;
75 0           $module = "$module.pm";
76 0 0         my $file = $INC{$module} or return;
77 0           my $perl;
78             my @rules;
79 0 0         if ($package->can('start_rules')) {
80 0 0         @rules = @{$package->start_rules || []};
  0            
81             }
82 0 0         if ($module eq 'Pegex/Pegex/Grammar.pm') {
83 0           require Pegex::Bootstrap;
84 0           $perl = Pegex::Bootstrap->new->compile($grammar_text, @rules)->to_perl;
85             }
86             else {
87 0           require Pegex::Compiler;
88 0           $perl = Pegex::Compiler->new->compile($grammar_text, @rules)->to_perl;
89             }
90 0 0         open IN, $file or die $!;
91 0           my $module_text = do {local $/; <IN>};
  0            
  0            
92 0           require Pegex;
93 0           my $msg = " # Generated/Inlined by Pegex::Grammar ($Pegex::VERSION)";
94 0           close IN;
95 0           $perl =~ s/^/ /gm;
96 0           $module_text =~ s/^(sub\s+make_tree\s*\{).*?(^\})/$1$msg\n$perl$2/ms;
97 0           $module_text =~ s/^(sub\s+tree\s*\{).*?(^\})/$1$msg\n$perl$2/ms;
98 0           chomp $grammar_text;
99 0           $grammar_text = "<<'...';\n$grammar_text\n...\n";
100 0           $module_text =~ s/^(sub\s+text\s*\{).*?(^\})/$1$msg\n$grammar_text$2/ms;
101 0           $grammar_text =~ s/^/# /gm;
102 0           $module_text =~ s/^(# sub\s+text\s*\{).*?(^# \})/$1$msg\n$grammar_text$2/ms;
103 0 0         open OUT, '>', $file or die $!;
104 0           print OUT $module_text;
105 0           close OUT;
106 0           print "Compiled '$grammar_file' into '$file'.\n";
107             }
108              
109             1;