File Coverage

blib/lib/Parse/Native.pm
Criterion Covered Total %
statement 15 28 53.5
branch 0 2 0.0
condition n/a
subroutine 5 8 62.5
pod n/a
total 20 38 52.6


line stmt bran cond sub pod time code
1              
2              
3             package Parse::Native;
4              
5 2     2   52278 use 5.008002;
  2         7  
  2         69  
6 2     2   11 use strict;
  2         4  
  2         65  
7 2     2   9 use warnings;
  2         3  
  2         53  
8 2     2   2044 use Data::Dumper;
  2         21145  
  2         183  
9              
10             our $VERSION = '0.02';
11              
12              
13              
14             ##########################################################################
15             ##########################################################################
16             ##########################################################################
17 2     2   9856 use Filter::Simple;
  2         83785  
  2         14  
18             ##########################################################################
19             ##########################################################################
20             ##########################################################################
21              
22             my $grammarname='unknown';
23             my $grammarpkg ='unknown';
24             my $rulename='unknown';
25             my $rulepkg='unknown';
26              
27             FILTER
28             {
29             my @caller = caller(0);
30             print Dumper \@caller;
31              
32             my @lines = split(/\n/, $_);
33              
34             foreach my $line (@lines)
35             {
36              
37             if ($line =~ s {^Grammar\s+([\w:]+)\s*;}{})
38             {
39             $grammarname=$1;
40             $grammarpkg = 'Parse::Native::Grammar::'.$grammarname;
41             $line = "package $grammarpkg;"
42             .' BEGIN{Parse::Native::ExportGrammar;} ';
43             }
44            
45             elsif($line=~ s {^Rule\s+([\w:]+)\s*;}{})
46             {
47             $rulename=$1;
48             $rulepkg = $grammarpkg.'::Rule::'.$rulename;
49             $line = "package $rulepkg;"
50             .' BEGIN{Parse::Native::ExportRule;} our ($skip); ';
51             }
52            
53             elsif($line =~ s{^EndGrammar\s*;}{})
54             {
55            
56             }
57              
58             else
59             {
60              
61             }
62             }
63              
64              
65              
66             $_ = join("\n", @lines);
67              
68             # warn "$_ here"; # uncomment this to dump out final source text
69            
70             };
71              
72             ##########################################################################
73             ##########################################################################
74             ##########################################################################
75             ##########################################################################
76             ##########################################################################
77             ##########################################################################
78             # given a string with templates, search and replace templates
79             # and then evaluate the result.
80             ##########################################################################
81             sub Evaluator
82             ##########################################################################
83             {
84 0     0     my ($string)=@_;
85              
86 0           $string =~ s{GRAMMARNAME}{$grammarname}g;
87 0           $string =~ s{GRAMMARPKG}{$grammarpkg}g;
88 0           $string =~ s{RULENAME}{$rulename}g;
89 0           $string =~ s{RULEPKG}{$rulepkg}g;
90              
91             #warn "string is '$string'";
92              
93 0           eval($string);
94              
95 0 0         if($@)
96             {
97 0           warn "ERROR: could not evaluate '$string'";
98 0           die $@;
99             }
100              
101             }
102              
103              
104             ##########################################################################
105             ##########################################################################
106             ##########################################################################
107             ##########################################################################
108             ##########################################################################
109             ##########################################################################
110              
111              
112              
113             ##########################################################################
114             sub ExportGrammar
115             ##########################################################################
116             {
117              
118 0     0     my $string = <<'EVALGRAMMARSTR' ;
119              
120            
121             # define references that point to current mode subroutines
122             # initialize them to stubs
123             $GRAMMARPKG::regx_ref = sub{};
124             $GRAMMARPKG::lit_ref = sub{};
125             $GRAMMARPKG::rule_ref = sub{};
126              
127             # define subs that all rules point to
128             sub GRAMMARPKG::regx
129             {
130             &$GRAMMARPKG::regx_ref;
131             }
132              
133             sub GRAMMARPKG::lit
134             {
135             &$GRAMMARPKG::lit_ref;
136             }
137              
138             sub GRAMMARPKG::rule
139             {
140             &$GRAMMARPKG::rule_ref;
141             }
142              
143             # use this to keep list of all rules under this grammar
144             @GRAMMARPKG::Rules = ();
145              
146             # call this to switch "mode".
147             # this will redefine which regx,lit,rule subroutine
148             # will be called when a rule calls the subroutine
149             sub GRAMMARPKG::Mode
150             {
151             &Parse::Native::Mode('GRAMMARPKG',@_);
152             }
153              
154             &Parse::Native::Mode('GRAMMARPKG','Startup');
155             EVALGRAMMARSTR
156             ;
157 0           Evaluator($string);
158             }
159              
160              
161             ##########################################################################
162             sub ExportRule
163             ##########################################################################
164             {
165 0     0     my $string = <<'EVALRULESTR' ;
166              
167             # each rule gets to define its "skip" value.
168             $RULEPKG::Skip = '\s+';
169              
170             # each rule can invoke a mode switch
171             sub RULEPKG::Mode
172             {
173             &GRAMMARPKG::Mode;
174             }
175              
176             # every rule will need these three subroutines
177             # to do its actual parsing: regx, lit, rule.
178             # call the reference in the Grammar package.
179             # that way, all rules can switch to a new mode
180             # by changing the reference.
181             sub RULEPKG::regx
182             {
183             &GRAMMARPKG::regx($RULEPKG::skip,@_);
184             }
185            
186             sub RULEPKG::lit
187             {
188             &GRAMMARPKG::lit($RULEPKG::skip,@_);
189             }
190              
191             sub RULEPKG::rule
192             {
193             &GRAMMARPKG::rule($RULEPKG::skip,@_);
194             }
195              
196             # keep track of all the rules for this grammar here.
197             push(@GRAMMARPKG::Rules, 'RULEPKG');
198              
199             EVALRULESTR
200             ;
201             #warn "rule string is '$string'";
202 0           Evaluator($string);
203             }
204              
205             ##########################################################################
206             sub Mode
207             ##########################################################################
208             {
209             my @caller=caller(0); print Dumper \@caller; print Dumper \@_;
210              
211             my ($grammarpkg,$mode) = @_;
212              
213             my $string="\n\nuse Parse::Native::Mode::$mode;\n";
214              
215             foreach my $type qw(regx lit rule)
216             {
217             $string .= '$'.$grammarpkg.'::'.$type.'_ref = \&Parse::Native::Mode::'.$mode.'::'.$type.";\n";
218             }
219              
220             $string .= "\n\n\n";
221              
222             eval($string);
223              
224             if($@)
225             {
226             warn "Error: unable to eval '$string'";
227             die $@;
228             }
229              
230              
231              
232              
233             }
234              
235              
236             ##########################################################################
237             ##########################################################################
238             ##########################################################################
239             ##########################################################################
240             ##########################################################################
241              
242             1;
243             __END__