File Coverage

blib/lib/Grammar/Formal.pm
Criterion Covered Total %
statement 4 6 66.6
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 6 8 75.0


line stmt bran cond sub pod time code
1             #####################################################################
2             # Base package for operators
3             #####################################################################
4             package Grammar::Formal::Pattern;
5 2     2   51781 use Modern::Perl;
  2         33594  
  2         12  
6 2     2   2394 use Moose;
  0            
  0            
7             use MooseX::SetOnce;
8              
9             has 'parent' => (
10             is => 'ro',
11             required => 0,
12             isa => 'Maybe[Grammar::Formal::Pattern]',
13             writer => '_set_parent',
14             traits => [qw/SetOnce/],
15             weak_ref => 1,
16             );
17              
18             has 'user_data' => (
19             is => 'rw',
20             required => 0,
21             );
22              
23             #####################################################################
24             # Base package for unary operators
25             #####################################################################
26             package Grammar::Formal::Unary;
27             use Modern::Perl;
28             use Moose;
29              
30             extends 'Grammar::Formal::Pattern';
31              
32             has 'p' => (
33             is => 'ro',
34             required => 1,
35             isa => 'Grammar::Formal::Pattern'
36             );
37              
38             sub BUILD {
39             my $self = shift;
40             $self->p->_set_parent($self);
41             }
42              
43             #####################################################################
44             # Base package for binary operators
45             #####################################################################
46             package Grammar::Formal::Binary;
47             use Modern::Perl;
48             use Moose;
49              
50             extends 'Grammar::Formal::Pattern';
51              
52             has 'p1' => (
53             is => 'ro',
54             required => 1,
55             isa => 'Grammar::Formal::Pattern'
56             );
57              
58             has 'p2' => (
59             is => 'ro',
60             required => 1,
61             isa => 'Grammar::Formal::Pattern'
62             );
63              
64             sub BUILD {
65             my $self = shift;
66             $self->p1->_set_parent($self);
67             $self->p2->_set_parent($self);
68             }
69              
70             #####################################################################
71             # Group
72             #####################################################################
73             package Grammar::Formal::Group;
74             use Modern::Perl;
75             use Moose;
76             extends 'Grammar::Formal::Binary';
77              
78             #####################################################################
79             # Choice
80             #####################################################################
81             package Grammar::Formal::Choice;
82             use Modern::Perl;
83             use Moose;
84             extends 'Grammar::Formal::Binary';
85              
86             #####################################################################
87             # Empty
88             #####################################################################
89             package Grammar::Formal::Empty;
90             use Modern::Perl;
91             use Moose;
92             extends 'Grammar::Formal::Pattern';
93              
94             #####################################################################
95             # NotAllowed
96             #####################################################################
97             package Grammar::Formal::NotAllowed;
98             use Modern::Perl;
99             use Moose;
100             extends 'Grammar::Formal::Pattern';
101              
102             #####################################################################
103             # Whatever
104             #####################################################################
105             package Grammar::Formal::Whatever;
106             use Modern::Perl;
107             use Moose;
108             extends 'Grammar::Formal::Pattern';
109              
110             #####################################################################
111             # ZeroOrMore
112             #####################################################################
113             package Grammar::Formal::ZeroOrMore;
114             use Modern::Perl;
115             use Moose;
116             extends 'Grammar::Formal::Unary';
117              
118             #####################################################################
119             # OneOrMore
120             #####################################################################
121             package Grammar::Formal::OneOrMore;
122             use Modern::Perl;
123             use Moose;
124             extends 'Grammar::Formal::Unary';
125              
126             #####################################################################
127             # SomeOrMore
128             #####################################################################
129             package Grammar::Formal::SomeOrMore;
130             use Modern::Perl;
131             use Moose;
132             extends 'Grammar::Formal::Unary';
133              
134             has 'min' => (
135             is => 'ro',
136             required => 1,
137             isa => 'Int'
138             );
139              
140             #####################################################################
141             # BoundRepetition
142             #####################################################################
143             package Grammar::Formal::BoundRepetition;
144             use Modern::Perl;
145             use Moose;
146             extends 'Grammar::Formal::Unary';
147              
148             has 'min' => (
149             is => 'ro',
150             required => 1,
151             isa => 'Int'
152             );
153              
154             has 'max' => (
155             is => 'ro',
156             required => 1,
157             isa => 'Int'
158             );
159              
160             #####################################################################
161             # Reference
162             #####################################################################
163             package Grammar::Formal::Reference;
164             use Modern::Perl;
165             use Moose;
166             extends 'Grammar::Formal::Pattern';
167              
168             has 'ref' => (
169             is => 'ro',
170             required => 1,
171             isa => 'Str'
172             );
173              
174             sub expand {
175             my ($self) = @_;
176             for (my $p = $self->parent; $p; $p = $p->parent) {
177             next unless $p->isa('Grammar::Formal::Grammar');
178             return $p->rules->{$self->ref} if $p->rules->{$self->ref};
179             }
180             warn "rule expansion for " . $self->ref . " failed.";
181             return
182             }
183              
184             #####################################################################
185             # Rule
186             #####################################################################
187             package Grammar::Formal::Rule;
188             use Modern::Perl;
189             use Moose;
190             extends 'Grammar::Formal::Unary';
191              
192             has 'name' => (
193             is => 'ro',
194             required => 1,
195             isa => 'Str'
196             );
197              
198             #####################################################################
199             # Grammar
200             #####################################################################
201             package Grammar::Formal::Grammar;
202             use Modern::Perl;
203             use Moose;
204             extends 'Grammar::Formal::Pattern';
205              
206             has 'start' => (
207             is => 'ro',
208             required => 0,
209             isa => 'Maybe[Str]',
210             );
211              
212             has 'rules' => (
213             is => 'ro',
214             required => 1,
215             isa => 'HashRef[Grammar::Formal::Rule]',
216             default => sub { {} },
217             );
218              
219             # TODO: lock the rules hashref for external access?
220              
221             sub set_rule {
222             my ($self, $name, $value) = @_;
223             $self->rules->{$name} = $value;
224             $value->_set_parent($self);
225             }
226              
227             # TODO: validate that rules include start symbol?
228              
229             #####################################################################
230             # Factory methods
231             #####################################################################
232             sub NotAllowed {
233             my ($self) = @_;
234             Grammar::Formal::NotAllowed->new();
235             }
236              
237             sub Empty {
238             my ($self) = @_;
239             Grammar::Formal::Empty->new();
240             }
241              
242             sub Whatever {
243             my ($self) = @_;
244             Grammar::Formal::Whatever->new();
245             }
246              
247             sub Choice {
248             my ($self, $p1, $p2) = @_;
249             Grammar::Formal::Choice->new(p1 => $p1, p2 => $p2);
250             }
251              
252             sub Group {
253             my ($self, $p1, $p2) = @_;
254             Grammar::Formal::Group->new(p1 => $p1, p2 => $p2);
255             }
256              
257             sub Optional {
258             my ($self, $p) = @_;
259             $self->Choice($self->Empty, $p);
260             }
261              
262             sub OneOrMore {
263             my ($self, $p) = @_;
264             Grammar::Formal::OneOrMore->new(p => $p);
265             }
266              
267             sub ZeroOrMore {
268             my ($self, $p) = @_;
269             Grammar::Formal::ZeroOrMore->new(p => $p);
270             }
271              
272             #####################################################################
273             # CaseSensitiveString
274             #####################################################################
275             package Grammar::Formal::CaseSensitiveString;
276             use Modern::Perl;
277             use Moose;
278             extends 'Grammar::Formal::Pattern';
279              
280             has 'value' => (
281             is => 'ro',
282             required => 1,
283             isa => 'Str'
284             );
285              
286             #####################################################################
287             # ASCII-Insensitive string
288             #####################################################################
289             package Grammar::Formal::AsciiInsensitiveString;
290             use Modern::Perl;
291             use Moose;
292             extends 'Grammar::Formal::Pattern';
293              
294             has 'value' => (
295             is => 'ro',
296             required => 1,
297             isa => 'Str'
298             );
299              
300             #####################################################################
301             # prose values
302             #####################################################################
303             package Grammar::Formal::ProseValue;
304             use Modern::Perl;
305             use Moose;
306             extends 'Grammar::Formal::Pattern';
307              
308             has 'value' => (
309             is => 'ro',
310             required => 1,
311             isa => 'Str'
312             );
313              
314             #####################################################################
315             # Range
316             #####################################################################
317             package Grammar::Formal::Range;
318             use Modern::Perl;
319             use Moose;
320             extends 'Grammar::Formal::Pattern';
321              
322             has 'min' => (
323             is => 'ro',
324             required => 1,
325             isa => 'Int'
326             );
327              
328             has 'max' => (
329             is => 'ro',
330             required => 1,
331             isa => 'Int'
332             );
333              
334             # TODO: add check min <= max
335              
336             #####################################################################
337             # Character class
338             #####################################################################
339             package Grammar::Formal::CharClass;
340             use Modern::Perl;
341             use Set::IntSpan;
342             use Moose;
343             extends 'Grammar::Formal::Pattern';
344              
345             has 'spans' => (
346             is => 'ro',
347             required => 1,
348             isa => 'Set::IntSpan'
349             );
350              
351             sub from_numbers {
352             my ($class, @numbers) = @_;
353             my $spans = Set::IntSpan->new([@numbers]);
354             return $class->new(spans => $spans);
355             }
356              
357             #####################################################################
358             # Grammar::Formal
359             #####################################################################
360             package Grammar::Formal;
361             use 5.012000;
362             use Modern::Perl;
363             use Moose;
364              
365             extends 'Grammar::Formal::Grammar';
366              
367             our $VERSION = '0.02';
368              
369             1;
370              
371              
372             __END__
373              
374             =head1 NAME
375              
376             Grammar::Formal - Object model to represent formal BNF-like grammars
377              
378             =head1 SYNOPSIS
379              
380             use Grammar::Formal;
381              
382             my $g = Grammar::Formal->new;
383              
384             my $s1 = Grammar::Formal::CaseSensitiveString->new(value => "a");
385             my $s2 = Grammar::Formal::CaseSensitiveString->new(value => "b");
386             my $choice = Grammar::Formal::Choice->new(p1 => $s1, p2 => $s2);
387              
388             $g->set_rule("a-or-b" => $choice);
389              
390             =head1 DESCRIPTION
391              
392             This module provides packages that can be used to model formal grammars
393             with production rules for non-terminals and terminals with arbitrary
394             operators and operands. The idea is to have a common baseline format to
395             avoid transformations between object models. Currently it has enough
396             features to model IETF ABNF grammars without loss of information (minor
397             details like certain syntax choices notwithstanding). All packages use
398             L<Moose>.
399              
400             =head1 API
401              
402             Grammar::Formal::Pattern
403             # Base package for all operators and operands
404             has rw user_data # Simple extension point
405             has ro parent # parent node if any
406              
407             + Grammar::Formal::Binary
408             # Base package for operators with 2 children
409              
410             has ro p1 # first child
411             has ro p2 # second child
412              
413             + Grammar::Formal::Group # concatenation
414             + Grammar::Formal::Choice # alternatives
415              
416             + Grammar::Formal::Unary
417             # Base package for operators with 1 child
418              
419             has ro p # the child pattern
420              
421             + Grammar::Formal::ZeroOrMore # zero or more
422             + Grammar::Formal::OneOrMore # one or more
423             + Grammar::Formal::SomeOrMore # min-bounded
424              
425             has ro min # minimum number of occurences
426              
427             + Grammar::Formal::BoundRepetition
428             # bound repetition
429              
430             has ro min # minimum number of occurences
431             has ro max # maximum number of occurences
432              
433             + Grammar::Formal::Rule
434             # grammar production rule
435              
436             has ro name # name of the non-terminal symbol
437              
438             + Grammar::Formal::Reference
439             # Named reference to a non-terminal symbol
440              
441             has ro ref # name of the referenced non-terminal
442             can expand # returns the associated ::Rule or undef
443              
444             + Grammar::Formal::Grammar
445             # A grammar pattern with named rules
446              
447             has ro rules # Hash mapping rule names to ::Rules
448             has ro start # optional start symbol
449             can set_rule($name, $value) # set rule $name to ::Rule $rule
450              
451             + Grammar::Formal::CaseSensitiveString
452             # Case-sensitive sequence of characters
453              
454             has ro value # Text string this represents
455              
456             + Grammar::Formal::AsciiInsensitiveString
457             # Sequence of characters that treats [A-Z] like [a-z]
458              
459             has ro value # Text string
460              
461             + Grammar::Formal::ProseValue
462             # Free form text description, as in IETF ABNF grammars
463              
464             has ro value # Prose
465              
466             + Grammar::Formal::Range
467             # Range between two integers (inclusive)
468              
469             has ro min # first integer in range
470             has ro max # last integer in range
471              
472             + Grammar::Formal::CharClass
473             # Set of integers
474              
475             has ro spans # a Set::IntSpan object
476             can from_numbers(@ints) # static constructor
477              
478             =head1 EXPORTS
479              
480             None.
481              
482             =head1 TODO
483              
484             Surely there is a better way to automatically generate better POD?
485              
486             =head1 AUTHOR / COPYRIGHT / LICENSE
487              
488             Copyright (c) 2014 Bjoern Hoehrmann <bjoern@hoehrmann.de>.
489             This module is licensed under the same terms as Perl itself.
490              
491             =cut