root/lang/perl/Text-Nyarlax/trunk/lib/Text/Nyarlax/Parser/PRD.pm @ 811

Revision 811, 21.1 kB (checked in by nyarla, 6 years ago)

lang/perl/Text-Nyarlax: fix of 'Modification of a read-only value attempted error' in Text::Nyarlax::Parser::PRD and modified Makefile.PL

Line 
1package Text::Nyarlax::Parser::PRD;
2
3use strict;
4use warnings;
5
6use Parse::RecDescent;
7use base qw( Text::Nyarlax::Parser );
8
9our $VERSION = '0.1';
10
11__PACKAGE__->mk_classdata( $_ ) for qw( engine grammer );
12
13__PACKAGE__->grammer(<<'__GRAMMER__');
14    {
15        use Text::Nyarlax::ParserUtil qw( element );
16        use Text::Nyarlax::ElementUtil qw( :node );
17        use List::MoreUtils qw( uniq );
18        use Scalar::Util qw( blessed );
19        use Regexp::Common qw( URI );
20        use vars qw(
21            %bracket %variable
22            $exclude_re $text_re $text_re_orig $variable_re
23        );
24
25        %bracket = (
26            Quote           =>  [qw(  " "  )],
27            Citation        =>  [qw( >> << )],
28            Notes           =>  ['(((',')))'],
29            Comparison      =>  [qw( // // )],
30            Emphasis        =>  [qw( ** ** )],
31            Definition      =>  [qw( ?? ?? )],
32            SubScript       =>  [qw( __ __ )],
33            SuperScript     =>  [qw( ~~ ~~ )],
34            Inserted        =>  [qw( ++ ++ )],
35            Deleted         =>  [qw( -- -- )],
36            InputText       =>  [qw( [| |] )],
37            InputCommand    =>  [qw( [$ $] )],
38            Keyboard        =>  [qw( <[ ]> )],
39            Sample          =>  [qw( [! !] )],
40            Code            =>  [qw(  ` `  )],
41            Abbreviation    =>  [  '((','))'],
42            Acronym         =>  [  '((','))'],
43            Ruby            =>  [  '((','))'],
44            Variable        =>  [qw(  { }  )],
45            Embedding       =>  [qw( {{ }} )],
46            HyperLink       =>  [qw( [[ ]] )],
47        );
48
49        {
50            my @exclude = ();
51            for my $def ( values %bracket ) {
52                for ( @{ $def } ) {
53                    $_ = quotemeta( $_ );
54                    push @exclude, $_;
55                }
56            }
57            $exclude_re = join q{|}, ( @exclude, quotemeta( '\\' ) );
58            $text_re = qr{(?: (?! $exclude_re ) [^\n] )+}x;
59            $text_re_orig = $text_re;
60        }
61
62        %variable = (
63            '$' => 'string',
64            '#' => 'number',
65            '?' => 'boolean',
66            ':' => 'reference',
67            '*' => 'pointer',
68            '&' => 'function',
69            '@' => 'array',
70            '%' => 'hash',
71            '=' => 'structure',
72            '+' => 'object',
73            '!' => 'class',
74        );
75
76        {
77            my @symbols = ();
78            for my $symbol ( keys %variable ) {
79                push @symbols, quotemeta( $symbol );
80            }
81            $variable_re = join q{}, @symbols;
82            $variable_re = qr{[$variable_re]};
83        }
84
85    }
86    parse               :   <rulevar: local $h_level = 1 >
87
88    parse               :   <skip: ''> Root
89                        { $return = $item{'Root'} }
90
91    Root                :   /\n*/ Content(s)
92                        {
93                            my $tree = $item{'Content(s)'};
94                               $tree = join_node( $tree, element => 'Section' );
95                            $return = $tree;
96                        }
97
98    Content             :   Section
99                        |   List[ marker => quotemeta( '*' ), name => 'UnorderedList', indent => 0 ]
100                        |   List[ marker => quotemeta( '#' ), name => 'OrderedList', indent => 0 ]
101                        |   DefinitionList[ indent => 0 ]
102                        |   BlockQuote
103                        |   BlockNotes
104                        |   BlockEdited[ marker => quotemeta('+'), name => 'BlockInserted' ]
105                        |   BlockEdited[ marker => quotemeta('-'), name => 'BlockDeleted' ]
106                        |   PreformattedText
107                        |   Paragraph
108
109    Section             :   Heading Root(?)
110                        {
111                            $h_level--;
112                            my $elm = element( $item[0] );
113                            $elm->push_content( $item{'Heading'}, @{ flatten($item{'Root(?)'}) } );
114                            $return = $elm;
115                        }
116
117    Heading             :   <rulevar: local $text_re = qr{(?: (?! $exclude_re ) [^\n=] )+}x >
118    Heading             :   /[=]{$h_level}/ InlineNode(s) "$item[1]" Blank Identifier(?) Blank /\n*/
119                        {
120                            $h_level++;
121                            my $elm = element( $item[0] );
122
123                            my @text = @{ $item{'InlineNode(s)'} };
124                            $text[0] =~ s{^[ \t]*}{}g       if ( ! ref $text[0] );
125                            $text[$#text] =~ s{[ \t]*$}{}g  if ( ! ref $text[$#text] );
126                            $elm->push_content( @text );
127
128                            $elm->attr->{'id'} = $item{'Identifier(?)'}->[0]
129                                if ( $item{'Identifier(?)'}->[0] );
130
131                            $return = $elm;
132                        }
133
134    List                :   ListItem[ marker => $arg{'marker'}, indent => $arg{'indent'} ](s)
135                        {
136                            my $elm = element( $arg{'name'} );
137                            $elm->push_content( @{ $item{'ListItem(s)'} } );
138                            $return = $elm;
139                        }
140
141    ListItem            :   /[ \t]{$arg{'indent'}} $arg{'marker'} [ \t]*/x ListContent[ indent => $arg{'indent'} ]
142                            {
143                                my $elm = element( $item[0] );
144                                $elm->push_content( @{ $item{'ListContent'} } );
145                                $elm->join_content( text => q{} );
146                                $return = $elm;
147                            }
148
149    ListContent         :  ListConetntFirst[ indent => $arg{'indent'} ] ListChild[ indent => $arg{'indent'} ](s?)
150                        {
151                            my $content = [];
152                            push @{ $content }, @{ $item{'ListConetntFirst'} };
153                            if ( @{ flatten($item{'ListChild(s?)'}) } > 0 ) {
154                                if ( ! blessed($item{'ListChild(s?)'}->[0])  ) {
155                                    push @{ $content }, "\n";
156                                }
157                                push @{ $content }, @{ flatten($item{'ListChild(s?)'}) };
158                            }
159                            $return = $content;
160                        }
161
162    ListConetntFirst    :   />>/ parse / [ \t]{$arg{'indent'}} [ \t]{2} << \n /x
163                            { $return = $item{'parse'} }
164                        |   InlineNode(s?) /\n/
165                            { $return = $item{'InlineNode(s?)'} }
166   
167
168    ListChild           :   List[ marker => quotemeta( '*' ), name => 'UnorderedList', indent => $arg{'indent'} + 2 ]
169                        |   List[ marker => quotemeta( '#' ), name => 'OrderedList', indent => $arg{'indent'} + 2 ]
170                        |   DefinitionList[ indent => $arg{'indent'} + 2 ]
171                        |   ListChildText[ indent => $arg{'indent'} ]
172
173    ListChildText       :   /[ \t]{$arg{'indent'}} [ \t]{2,}/x InlineNode(s) /\n/
174                            { $return = [ @{ $item{'InlineNode(s)'} }, "\n" ] }
175
176    DefinitionList      :   DefinitionItem[ indent => $arg{'indent'} ](s)
177                        {
178                            my $elm = element( $item[0] );
179                            $elm->push_content( @{ $item{'DefinitionItem(s)'} } );
180                            $return = $elm;
181                        }
182
183    DefinitionItem      :   /[ \t]{$arg{'indent'}}/ DefinitionTerm Blank DefinitionContent[ indent => $arg{'indent'} ]
184                        {
185                            my $elm = element $item[0];
186                            $elm->push_content( $item{'DefinitionTerm'}, @{ $item{'DefinitionContent'} } );
187                            $return = $elm;
188                        }
189
190    DefinitionTerm      :   <rulevar: local $text_re = qr{(?: (?! $exclude_re | [:] ) [^\n] )+}x >
191    DefinitionTerm      :   /[:]/ InlineNode(s) /[:]/
192                        {
193                            my $elm = element $item[0];
194                            $elm->push_content( @{ $item{'InlineNode(s)'} } );
195                            $elm->join_content( text => q{} );
196                            $return = $elm;
197                        }
198
199    DefinitionContent   :   /\n/ DefinitionDescription[ indent => $arg{'indent'} + 2 ](s)
200                            { $return = $item{'DefinitionDescription(s)'} }
201                        |   ListContent[ indent => $arg{'indent'} ]
202                            {
203                                my $elm = element 'DefinitionDescription';
204                                $elm->push_content( @{ $item{'ListContent'} } );
205                                $elm->join_content( text => q{} );
206                                $return = [ $elm ];
207                            }
208
209    DefinitionDescription:  /[ \t]{$arg{'indent'}} [?] [ \t]*/x ListContent[ indent => $arg{'indent'} ]
210                        {
211                            my $elm = element $item[0];
212                            $elm->push_content( @{ $item{'ListContent'} } );
213                            $elm->join_content( text => q{} );
214                            $return = $elm;
215                        }
216
217    BlockQuote          :   />>>/ Blank Text(?) Blank /\n/
218                                Root
219                            /<<</ Blank URI(?) Blank /\n/
220                        {
221                            my $elm = element( $item[0] );
222                            $elm->push_content( @{ $item{'Root'} } );
223                            $elm->attr->{'title'} = $item{'Text(?)'}->[0] if ( $item{'Text(?)'}->[0] );
224                            $elm->attr->{'cite'}  = $item{'URI(?)'}->[0]  if ( $item{'URI(?)'}->[0] );
225                            $return = $elm;
226                        }
227
228    BlockNotes          :   /[(]{3}\n/ Root /[)]{3}\n/
229                        {
230                            my $elm = element( $item[0] );
231                            $elm->push_content( @{ $item{'Root'} } );
232                            $return = $elm;
233                        }
234
235    BlockEdited         :   /(?:$arg{'marker'}){3}/ Blank Text(?) Blank /\n/
236                                Root
237                            /(?:$arg{'marker'}){3}/ Blank DateTime(?) Blank /\n/
238                        {
239                            my $elm = element( $arg{'name'} );
240                            $elm->push_content( @{ $item{'Root'} } );
241                            $elm->attr->{'title'} = $item{'Text(?)'}->[0]
242                                if ( $item{'Text(?)'}->[0] );
243                            $elm->attr->{'datetime'} = $item{'DateTime(?)'}->[0]
244                                if ( $item{'DateTime(?)'}->[0] );
245                            $return = $elm;
246                        }
247
248    PreformattedText    :   /[{]{3}/ Blank PFTType(?) Blank PFTSyntax(?) Blank /\n/
249                                BlockText[ exclude => quotemeta('}}}') ]
250                            /[}]{3}/ Blank PFTLicense(?) Blank PFTLink(?) Blank /\n/
251                        {
252                            my $elm = element( $item[0] );
253
254                            for my $name ( qw( type syntax license link ) ) {
255                                my $value = $item{'PFT' . ucfirst($name) . '(?)'}->[0];
256                                $elm->attr->{$name} = $value if ( $value );
257                            }
258                            $elm->attr->{'type'} ||= 'text';
259
260                            my $text = $item{'BlockText'};
261                            $text =~ s{^\n|\n$}{}g;
262                            $text .= "\n";
263                            $elm->push_content( $text );
264
265                            $return = $elm;
266                        }
267    PFTType             :   /[^\[\n]+/
268                        { my $str = $item[1]; $str =~ s{^[ \t]*|[ \t]*$}{}g; $return = $str; }
269    PFTSyntax           :   /\[ ([^\]]+) \]/x
270                        { $return = $1 }
271    PFTLicense          :   /[^<\n]+/
272                        { my $str = $item[1]; $str =~ s{^[ \t]*|[ \t]*$}{}g; $return = $str; }
273    PFTLink             :   /</ Blank URI Blank />/
274                        { $return = $item{'URI'} }
275
276    # Paragraph
277    Paragraph           :   Line(s)
278                        {
279                            my $elm = element($item[0]);
280                            $elm->push_content( @{ $item{'Line(s)'} } );
281                            $return = $elm;
282                        }
283
284    Line                :   OneLine(s) /\n*/
285                        {
286                            my $elm = element($item[0]);
287                            $elm->push_content( @{ flatten( $item{'OneLine(s)'} ) } );
288                            $elm->join_content( text => q{} );
289                            $return = $elm;
290                        }
291
292    OneLine             :   ...!/[=]/ InlineNode(s) /\n/
293                        {
294                            $return = [ @{ $item{'InlineNode(s)'} }, "\n" ];
295                        }
296    InlineNode          :   PlainText
297                        |   HyperLink
298                        |   InlineElement[ name => 'Quote' ]
299                        |   InlineElement[ name => 'Citation' ]
300                        |   InlineElement[ name => 'Notes' ]
301                        |   InlineElement[ name => 'Comparison' ]
302                        |   InlineElement[ name => 'Emphasis' ]
303                        |   InlineElement[ name => 'Definition' ]
304                        |   InlineElement[ name => 'SubScript' ]
305                        |   InlineElement[ name => 'SuperScript' ]
306                        |   InlineElement[ name => 'Inserted' ]
307                        |   InlineElement[ name => 'Deleted' ]
308                        |   Abbreviation[ name => 'Acronym', sep => quotemeta( ':=' ) ]
309                        |   Abbreviation[ name => 'Abbreviation', sep => quotemeta( '=' ) ]
310                        |   Ruby
311                        |   InlineElement[ name => 'InputText' ]
312                        |   InlineCodeElement[ name => 'InputCommand' ]
313                        |   InlineCodeElement[ name => 'Keyboard' ]
314                        |   InlineCodeElement[ name => 'Sample' ]
315                        |   InlineCodeElement[ name => 'Code' ]
316                        |   Embedding
317                        |   Variable
318
319    InlineElement       :   <rulevar: local $text_re = $text_re_orig >
320    InlineElement       :   /$bracket{$arg{'name'}}->[0]/ InlineNode(s) /$bracket{$arg{'name'}}->[1]/
321                        {
322                            my $elm = element( $arg{'name'} );
323                            $elm->push_content( @{ $item{'InlineNode(s)'} } );
324                            $return = $elm;
325                        }
326
327    InlineCodeElement   :   m{
328                            $bracket{$arg{'name'}}->[0]
329                                ( (?: (?! $bracket{$arg{'name'}}->[1] ) [^\n] )+ )
330                            $bracket{$arg{'name'}}->[1]
331                            }x
332                        {
333                            my $elm = element( $arg{'name'} );
334                            my $content = $1;
335                            $elm->push_content( $content );
336                            $return = $elm;
337                        }
338
339    Abbreviation        :   <rulevar: local $text_re = qr{(?: (?! $exclude_re | $arg{'sep'} ) [^\n] )+}x >
340    Abbreviation        :   /$bracket{$arg{'name'}}->[0]/
341                                InlineNode(s) /$arg{'sep'}/ /(?:(?!$bracket{$arg{'name'}}->[1])[^\n])+/
342                            /$bracket{$arg{'name'}}->[1]/
343                        {
344                            my $elm = element( $arg{'name'} );
345                            $elm->push_content( @{ $item{'InlineNode(s)'} } );
346                            $elm->attribute->{'title'} = $item[4];
347                            $return = $elm;
348                        }
349
350    Ruby                :   /$bracket{$item[0]}->[0]/
351                                RubyItem[ name => 'RubyBase', end => '>' ]
352                                RubyItem[ name => 'RubyText', end => '>' ](s)
353                            /$bracket{$item[0]}->[1]/
354                            {
355                                my $elm = element( $item[0] );
356                                $elm->push_content( $item{'RubyItem'}, @{ $item{'RubyItem(s)'} } );
357                                $return = $elm;
358                            }
359
360    RubyItem            :   <rulevar: local $text_re = qr{(?: (?! $exclude_re | [|] | $arg{'end'} ) [^\n] )+}x >
361    RubyItem            :   /</ <leftop: PlainText(s) '|' PlainText(s) > />/
362                            {
363                                my $elm = element( $arg{'name'} );
364                                $elm->push_content( @{ flatten( $item[2] ) } );
365                                $return = $elm;
366                            }
367
368    Variable            :  m{
369                            $bracket{$item[0]}->[0]
370                                ($variable_re)
371                                    [ \t]+
372                                        ( (?: (?! \1 $bracket{$item[0]}->[1] ) [^\n])+ )
373                                    [ \t]+
374                                \1
375                            $bracket{$item[0]}->[1]
376                            }x
377                        {
378                            my $elm = element( $item[0] );
379                            $elm->attr->{'type'} = $variable{$1};
380                            my $content = $2;
381                            $elm->push_content( $content );
382                            $return = $elm;
383                        }
384                        |  m{
385                            $bracket{$item[0]}->[0]
386                                ([^:]+)
387                                    [:]
388                                ( (?: (?! $bracket{$item[0]}->[1] ) [^\n] )+ )
389                            $bracket{$item[0]}->[1]
390                        }x
391                        {
392                            my $elm = element( $item[0] );
393                            $elm->attr->{'type'} = $1;
394                            my $content = $2;
395                            $elm->push_content( $content );
396                            $return = $elm;
397                        }
398
399    Embedding           :  m{
400                            $bracket{$item[0]}->[0]
401                                ([a-zA-Z0-9]+)
402                                (?: [:] [\n]?
403                                    ( (?: (?! $bracket{$item[0]}->[1] ) [\s\S])+ )
404                                )?
405                            $bracket{$item[0]}->[1]
406                            }x
407                            {
408                                my $elm = element( $item[0] );
409                                $elm->attr->{'require'} = $1;
410                                my $content = $2;
411                                $elm->push_content( $content ) if ( $content );
412                                $return = $elm;
413                            }
414
415    HyperLink           :   /$bracket{$item[0]}->[0]/
416                                HyperLinkTitle(?) HyperLinkRef
417                            /$bracket{$item[0]}->[1]/
418                            {
419                                my $elm = element($item[0]);
420                                my ( $wikiname, $link ) = @{ $item{'HyperLinkRef'} }{qw( wikiname link )};
421                                my $title = $item{'HyperLinkTitle(?)'}->[0];
422                                   $title ||= ( $wikiname ) ? "$wikiname:$link" : $link;
423                                $elm->push_content( $title );
424                                $elm->attr->{'link'} = $link;
425                                $elm->attr->{'wikiname'} = $wikiname if ( $wikiname );
426                                $return = $elm;
427                            }
428
429    HyperLinkTitle      :  m{ ([^|]+?) [|] }x
430                            { $return = $1 }
431
432    HyperLinkRef        :  m{ ([^\[]+?) \[ ([^\]]+?) \] }x
433                            { $return = { wikiname => $1, link => $2 } }
434                        |  m{
435                                $RE{'URI'}
436                              | (?: (?! $bracket{'HyperLink'}->[1] ) [^\n] )+
437                            }x
438                            { $return = { link => $item[1] } }
439
440    PlainText           :  m{[\\]{3} ( (?:(?![\\]{3}).)+ ) [\\]{3}}x
441                            { $return = $1 }
442                        |  m{[\\](.)}
443                            { $return = $1 }
444                        |  m{$text_re}
445
446    # Token
447    Text                :   /[^\n]+/
448    BlockText           :   /(?: (?! $arg{'exclude'} ) [\s\S] )+/x
449    Blank               :   /[ \t]*/
450    Identifier          :   /[a-zA-Z]+/
451    URI                 :   /$RE{'URI'}/
452    DateTime            :   /\d{4}-\d{2}-\d{2}T\d{2}:\d{2}:\d{2}[\-+]\d{2}:\d{2}/
453__GRAMMER__
454
455__PACKAGE__->engine( Parse::RecDescent->new( __PACKAGE__->grammer ) );
456
457sub parse {
458    my ( $self, $text ) = @_;
459    $text .= "\n" if ( $text !~ m{\n$} );
460    return $self->engine->parse( $text );
461}
462
4631;
464__END__
Note: See TracBrowser for help on using the browser.