File Coverage

blib/lib/Perl6/Pod/Grammars.pm
Criterion Covered Total %
statement 11 11 100.0
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 15 15 100.0


line stmt bran cond sub pod time code
1             #===============================================================================
2             #
3             # DESCRIPTION: Pod6 Grammars
4             #
5             # AUTHOR: Aliaksandr P. Zahatski,
6             #===============================================================================
7             package Perl6::Pod::Grammars;
8             =pod
9              
10             =head1 NAME
11              
12             Perl6::Pod::Grammars - set of grammars for Pod6
13              
14             =head1 SYNOPSIS
15              
16             my $r = qr{
17            
18            
19             \A \Z
20             }xms;
21             my $tree ;
22             if ( $src =~ $r ) {
23             $tree = Perl6::Pod::Lex->new(%args)->make_tree( $/{File} );
24             }
25             else {
26             return undef;
27             }
28              
29              
30             =head1 DESCRIPTION
31              
32             Perl6::Pod::Grammars - set of grammars for Pod6
33              
34             =cut
35             our $VERSION = '0.01';
36              
37 6     6   613 use strict;
  6         11  
  6         183  
38 6     6   34 use warnings;
  6         12  
  6         143  
39 6     6   63 use v5.10;
  6         21  
40 6     6   30 use Regexp::Grammars;
  6         10  
  6         40  
41             qr{
42            
43             [ \t]*
44             [ \t]
45             [ \t]+
46             <.hs1>* \n
47             ^ <.hs> \n
48              
49             (?{$MATCH{type}="file"})<[content=block_content]>+
50             begin | for | END | end | config
51            
52             code
53             #io blocks
54             | input
55             | output
56             | comment
57             | table
58             # Named blocks
59             |
60             &&
61             ( $MATCH ne lc($MATCH) ) })>
62            
63             # .*?
64             (?:(?!^?=\w+).)* # match everythig, except
65             # it looks like directive
66             (?{ $MATCH{type} = "raw"})
67              
68            
69            
70             |
71             |
72             |
73             |
74             |
75             |
76             |
77             # |
78              
79            
80             (?{ $MATCH{type} = "ambient"})
81             \s+
82            
83             (?{ $MATCH{type} = "directive"})
84             ^ ? =
85             ( ( <.newline> = )? <.hs> <[attr=pair]>+ % <.hs> )* <.newline>
86            
87             (?{ $MATCH{type} = "directive"})
88             ^ ? = <.newline>
89              
90            
91             (?{ $MATCH{type} = "directive"})
92             ^ ? = <.hsp>
93             ( ( <.newline> = )? <.hsp> <[text=([^\n\r]+)]> )+ <.newline>
94              
95            
96             | \' \'
97             | \" \"
98             |
99             (?:\=\>)
100             \: ?
101             (?{ $MATCH{type} = 'bool' })
102             (
103            
104             # :key[1,2,3]
105             \[ <[items]>+ % [,\s] \]
106             (?{ $MATCH{type} = 'list' })
107            
108             | # :key('str')
109             \( \)
110             (?{ $MATCH{type} = 'string' })
111              
112             | # :key
113             \< \>
114             (?{ $MATCH{type} = 'string' })
115              
116             | # :key<1 2 3>
117             \< <[items]>+ % [\s] \>
118             (?{ $MATCH{type} = 'list' })
119              
120             | # :key{1=>1, 2=> 3 }
121             \{ <[items=kv]>+ % <.delim=([,\s]+)> \}
122             (?{ $MATCH{type} = 'hash' })
123              
124             )?
125            
126             (?{
127             $MATCH{type} eq 'bool'
128             && (
129             $MATCH{items} = $MATCH{not} ? 0 : 1
130             )
131             })
132              
133            
134             (?{ $MATCH{type} = "block"})
135             ^ ? =begin <.hs>
136             ( ( <.newline> = )? <.hs> <[attr=pair]>+ % <.hs> )* <.newline>
137              
138             <[content=raw_content]>?
139              
140             ^ ? =end <.hsp> <\_name> <.hs> <.newline>?
141              
142            
143             (?{ $MATCH{type} = "block"})
144             ^ ? =begin <.hs>
145             ( ( <.newline> = )? <.hs> <[attr=pair]>+ % <.hs> )* <.newline>
146             <[content=block_content]>*
147             <.emptyline>*
148             ^ ? =end <.hs> <\_name> <.hs> <.newline>?
149              
150            
151             (?{ $MATCH{type} = "block"})
152             ^ ? =for <.hs>
153             (
154             (?{ $MATCH{content_type} = "raw"})
155             | )
156             ( ( <.newline> = )? <.hs> <[attr=pair]>+ % <.hs> )* <.newline>
157             <[content=text_content(:content_type)]>*
158             <.newline>?
159              
160            
161             (^ ? (?! <.emptyline> | ? \=\w+ ) # not start with directive
162             [^\n]+ <.newline>)+
163             (?{ $MATCH{type} = $ARG{content_type} // "text"})
164              
165            
166             ( (?! <.emptyline> | ? \=\w+ ) # not start with directive
167             [^\n]+ <.newline>)+
168             (?{ $MATCH{type} = $ARG{content_type} // "text"})
169              
170              
171            
172             (?{ $MATCH{type} = "block"})
173             ^ ? = (
174             (?{ $MATCH{content_type} = "raw" })
175             | ) <.newline>?
176             <[content=text_abbr_content(:content_type)]>*
177             <.emptyline>?
178             };
179              
180             qr{
181            
182             };
183             1;
184              
185             __END__