File Coverage

blib/lib/YAML/Parser.pm
Criterion Covered Total %
statement 946 1430 66.1
branch 153 292 52.4
condition 77 138 55.8
subroutine 277 417 66.4
pod 0 70 0.0
total 1453 2347 61.9


line stmt bran cond sub pod time code
1             # This module was GENERATED!
2             #
3             # By https://github.com/ingydotnet/yaml-parser-pm
4              
5 2     2   71662 use v5.12;
  2         13  
6             package YAML::Parser;
7              
8             our $VERSION = '0.0.5';
9              
10 2     2   989 use XXX;
  2         3167  
  2         9  
11              
12             sub new {
13 2     2 0 93 my ($class, %self) = @_;
14              
15 2         9 my $self = bless {
16             %self,
17             }, $class;
18              
19 2 100       11 if (not defined $self->{receiver}) {
20 1         3 $self->{events} = [];
21             $self->{receiver} = PerlYamlReferenceParserReceiver->new(
22             callback => sub {
23 13     13   20 my ($event) = @_;
24 13         16 push @{$self->{events}}, $event;
  13         37  
25             },
26 1         9 );
27             }
28              
29 2         6 return $self;
30             }
31              
32             sub parse {
33 2     2 0 14 my ($self, $yaml_string) = @_;
34             $self->{parser} = PerlYamlReferenceParserParser->new(
35             $self->{receiver},
36 2         12 );
37 2         7 $self->{parser}->parse($yaml_string);
38 2         16 return $self;
39             }
40              
41             sub receiver {
42 1     1 0 3 my ($self) = @_;
43 1         5 return $self->{parser}{receiver};
44             }
45              
46             sub events {
47 1     1 0 3 my ($self) = @_;
48 1         1 return @{$self->{events}};
  1         6  
49             }
50              
51             BEGIN {
52 2     2   712 $INC{'PerlYamlReferenceParserParser.pm'} = __FILE__;
53 2         5 $INC{'PerlYamlReferenceParserGrammar.pm'} = __FILE__;
54 2         69 $INC{'PerlYamlReferenceParserPrelude.pm'} = __FILE__;
55             };
56              
57             1;
58              
59             ### INCLUDE code from yaml-reference-parser/perl/lib/
60              
61             BEGIN {
62              
63 2     2   45 use v5.12;
  2         8  
64              
65             package PerlYamlReferenceParserFunc;
66             use overload
67 104     104   234 eq => sub { 0 },
68 2     2   1279 bool => sub { 1 };
  2     0   1068  
  2         22  
  0         0  
69             sub new {
70 9184     9184   15884 my ($class, $func, $name, $trace, $num) = @_;
71 9184   66     50978 bless {
72             func => $func,
73             name => $name,
74             trace => $trace || $name,
75             num => $num,
76             receivers => undef,
77             }, $class;
78             }
79 0     0   0 sub TO_JSON { $_[0]->{func} }
80              
81             package PerlYamlReferenceParserPrelude;
82              
83 2     2   1330 use boolean;
  2         2347  
  2         9  
84 2     2   143 use Carp;
  2         5  
  2         121  
85 2     2   1200 use Encode;
  2         22232  
  2         180  
86 2     2   18 use Exporter 'import';
  2         4  
  2         60  
87 2     2   1588 use JSON::PP;
  2         34243  
  2         195  
88 2     2   2036 use Time::HiRes qw< gettimeofday tv_interval >;
  2         3361  
  2         12  
89 2     2   1612 use YAML::PP::Perl;
  2         174266  
  2         159  
90 2     2   22 use XXX;
  2         5  
  2         17  
91              
92 2     2   181 use constant DEBUG => $ENV{DEBUG};
  2         5  
  2         302  
93              
94 2     2   11 our @EXPORT;
95 30     30 0 72 sub export { push @EXPORT, @_ }
96              
97 2         23 export qw< true false >;
98              
99 2         6 export 'rule';
100             sub rule {
101 424     424 0 811 my ($num, $name, $func) = @_;
102 424         922 my ($pkg) = caller;
103             {
104 2     2   15 no strict 'refs';
  2         5  
  2         2863  
  424         604  
105 424         528 *{"${pkg}::$name"} = $func;
  424         2038  
106             }
107 424         811 $func = name($name, $func);
108 424         877 $func->{num} = $num;
109 424         876 return $func;
110             }
111              
112 2         7 export 'name';
113             sub name {
114 5526     5526 0 10982 my ($name, $func, $trace) = (@_, '');
115 5526         7356 my $f = $func;
116 5526         6389 if (DEBUG) {
117             $f = sub {
118 0     0   0 my ($n, @args) = @_;
119 0         0 my $args = join ',', map stringify($_), @args;
120 0         0 debug("$name($args)");
121 0         0 goto $func;
122             }
123             }
124 5526         10910 return PerlYamlReferenceParserFunc->new($f, $name, $trace);
125             }
126              
127 2         6 export qw;
128 6478     6478 0 13366 sub isNull { not defined $_[0] }
129 6488     6488 0 23116 sub isBoolean { ref($_[0]) eq 'boolean' }
130 6558 100   6558 0 20085 sub isNumber { not(ref $_[0]) and $_[0] =~ /^-?\d+$/ }
131 9178   100 9178 0 34704 sub isString { not(ref $_[0]) and $_[0] !~ /^-?\d+$/ }
132 19128     19128 0 49456 sub isFunction { ref($_[0]) eq 'PerlYamlReferenceParserFunc' }
133 16494     16494 0 41268 sub isArray { ref($_[0]) eq 'ARRAY' }
134 2798     2798 0 5199 sub isObject { ref($_[0]) eq 'HASH' }
135              
136 2         4 export 'typeof';
137             sub typeof {
138 6478     6478 0 10047 my ($value) = @_;
139 6478 50       9481 return 'null' if isNull $value;
140 6478 100       10163 return 'boolean' if isBoolean $value;
141 18 100       31 return 'number' if isNumber $value;
142 6 50       11 return 'string' if isString $value;
143 0 0       0 return 'function' if isFunction $value;
144 0 0       0 return 'array' if isArray $value;
145 0 0       0 return 'object' if isObject $value;
146 0         0 XXX [$value, ref($value)];
147             }
148              
149 2         34 my $json = JSON::PP->new->canonical->allow_unknown->allow_nonref->convert_blessed;
150             sub json_stringify {
151 2752     2752 0 3330 my $string;
152 2752         4201 eval {
153 2752         7230 $string = $json->encode($_[0]);
154             };
155 2752 50       180426 confess $@ if $@;
156 2752         5390 return $string;
157             }
158              
159 2         280 export 'stringify';
160             sub stringify;
161             sub stringify {
162 2982     2982 0 5074 my ($o) = @_;
163 2982 100       6367 if ($o eq "\x{feff}") {
164 80         332 return "\\uFEFF";
165             }
166 2902 100       4503 if (isFunction $o) {
167 104         395 return "\@$o->{trace}";
168             }
169 2798 100       4769 if (isObject $o) {
170 72         469 return json_stringify [ sort keys %$o ];
171             }
172 2726 100       4559 if (isArray $o) {
173 46         69 return "[${\ join ',', map stringify($_), @$o}]";
  46         115  
174             }
175 2680 100       4367 if (isString $o) {
176 2630         4659 $_ = json_stringify $o;
177 2630         11698 s/^"(.*)"$/$1/;
178 2630         10405 return $_;
179             }
180 50         117 return json_stringify $o;
181             }
182              
183 2         4 export 'hex_char';
184             sub hex_char {
185 788     788 0 1786 my ($chr) = @_;
186 788         3209 return sprintf "x%x", ord $chr;
187             }
188              
189 2         5 export 'func';
190             sub func {
191 3658     3658 0 6211 my ($self, $name) = @_;
192 3658 50       10918 my $func = $self->can($name) or
193             die "Can't find parser function '$name'";
194 3658         7107 PerlYamlReferenceParserFunc->new($func, $name);
195             }
196              
197 2         4 export 'file_read';
198             sub file_read {
199 0     0 0 0 decode_utf8(do { local $/; <> });
  0         0  
  0         0  
200             }
201              
202 2         5 export 'debug';
203             sub debug {
204 0     0 0 0 my ($msg) = @_;
205 0         0 warn ">>> $msg\n";
206             }
207              
208 2         15 export 'debug_rule';
209             sub debug_rule {
210 0     0 0 0 my ($name, @args) = @_;
211 0         0 my $args = join ',', map stringify($_), @args;
212 0         0 debug "$name($args)";
213             }
214              
215 2         6 export qw< WWW XXX YYY ZZZ www xxx yyy zzz >;
216 2         9 *www = \&www;
217 2         6 *xxx = \&xxx;
218 2         13 *yyy = \&yyy;
219 2         6 *zzz = \&zzz;
220              
221 2         7 export 'dump';
222             sub dump {
223 0     0 0 0 YAML::PP::Perl->new->dump(@_);
224             }
225              
226 2         21 export 'FAIL';
227             sub FAIL {
228 0     0 0 0 WWW [@_];
229 0   0     0 confess "FAIL '${\ $_[0] // '???'}'";
  0         0  
230             }
231              
232 2         5 export 'timer';
233             sub timer {
234 0 0   0 0 0 if (@_) {
235 0         0 tv_interval(shift);
236             }
237             else {
238 0         0 [gettimeofday];
239             }
240             }
241              
242 2         52 1;
243              
244             # vim: sw=2:
245             }
246              
247              
248             ###
249             # This grammar class was generated from https://yaml.org/spec/1.2/spec.html
250             ###
251              
252 2     2   41 use v5.12;
  2         8  
253             package PerlYamlReferenceParserGrammar;
254 2     2   14 use PerlYamlReferenceParserPrelude;
  2         5  
  2         290  
255              
256 2     2   15 use constant DEBUG => $ENV{DEBUG};
  2         3  
  2         30304  
257              
258             rule '000', TOP => sub {
259 2     2   5 my ($self) = @_;
260 2         6 $self->func('l_yaml_stream');
261             };
262              
263              
264             # [001]
265             # c-printable ::=
266             # x:9 | x:A | x:D | [x:20-x:7E]
267             # | x:85 | [x:A0-x:D7FF] | [x:E000-x:FFFD]
268             # | [x:10000-x:10FFFF]
269              
270             rule '001', c_printable => sub {
271 82     82   129 my ($self) = @_;
272 82         114 debug_rule("c_printable") if DEBUG;
273 82         207 $self->any(
274             $self->chr("\x{09}"),
275             $self->chr("\x{0A}"),
276             $self->chr("\x{0D}"),
277             $self->rng("\x{20}", "\x{7E}"),
278             $self->chr("\x{85}"),
279             $self->rng("\x{A0}", "\x{D7FF}"),
280             $self->rng("\x{E000}", "\x{FFFD}"),
281             $self->rng("\x{010000}", "\x{10FFFF}")
282             );
283             };
284              
285              
286              
287             # [002]
288             # nb-json ::=
289             # x:9 | [x:20-x:10FFFF]
290              
291             rule '002', nb_json => sub {
292 0     0   0 my ($self) = @_;
293 0         0 debug_rule("nb_json") if DEBUG;
294 0         0 $self->any(
295             $self->chr("\x{09}"),
296             $self->rng("\x{20}", "\x{10FFFF}")
297             );
298             };
299              
300              
301              
302             # [003]
303             # c-byte-order-mark ::=
304             # x:FEFF
305              
306             rule '003', c_byte_order_mark => sub {
307 80     80   136 my ($self) = @_;
308 80         110 debug_rule("c_byte_order_mark") if DEBUG;
309 80         174 $self->chr("\x{FEFF}");
310             };
311              
312              
313              
314             # [004]
315             # c-sequence-entry ::=
316             # '-'
317              
318             rule '004', c_sequence_entry => sub {
319 0     0   0 my ($self) = @_;
320 0         0 debug_rule("c_sequence_entry") if DEBUG;
321 0         0 $self->chr('-');
322             };
323              
324              
325              
326             # [005]
327             # c-mapping-key ::=
328             # '?'
329              
330             rule '005', c_mapping_key => sub {
331 0     0   0 my ($self) = @_;
332 0         0 debug_rule("c_mapping_key") if DEBUG;
333 0         0 $self->chr('?');
334             };
335              
336              
337              
338             # [006]
339             # c-mapping-value ::=
340             # ':'
341              
342             rule '006', c_mapping_value => sub {
343 0     0   0 my ($self) = @_;
344 0         0 debug_rule("c_mapping_value") if DEBUG;
345 0         0 $self->chr(':');
346             };
347              
348              
349              
350             # [007]
351             # c-collect-entry ::=
352             # ','
353              
354             rule '007', c_collect_entry => sub {
355 0     0   0 my ($self) = @_;
356 0         0 debug_rule("c_collect_entry") if DEBUG;
357 0         0 $self->chr(',');
358             };
359              
360              
361              
362             # [008]
363             # c-sequence-start ::=
364             # '['
365              
366             rule '008', c_sequence_start => sub {
367 0     0   0 my ($self) = @_;
368 0         0 debug_rule("c_sequence_start") if DEBUG;
369 0         0 $self->chr('[');
370             };
371              
372              
373              
374             # [009]
375             # c-sequence-end ::=
376             # ']'
377              
378             rule '009', c_sequence_end => sub {
379 0     0   0 my ($self) = @_;
380 0         0 debug_rule("c_sequence_end") if DEBUG;
381 0         0 $self->chr(']');
382             };
383              
384              
385              
386             # [010]
387             # c-mapping-start ::=
388             # '{'
389              
390             rule '010', c_mapping_start => sub {
391 0     0   0 my ($self) = @_;
392 0         0 debug_rule("c_mapping_start") if DEBUG;
393 0         0 $self->chr('{');
394             };
395              
396              
397              
398             # [011]
399             # c-mapping-end ::=
400             # '}'
401              
402             rule '011', c_mapping_end => sub {
403 0     0   0 my ($self) = @_;
404 0         0 debug_rule("c_mapping_end") if DEBUG;
405 0         0 $self->chr('}');
406             };
407              
408              
409              
410             # [012]
411             # c-comment ::=
412             # '#'
413              
414             rule '012', c_comment => sub {
415 0     0   0 my ($self) = @_;
416 0         0 debug_rule("c_comment") if DEBUG;
417 0         0 $self->chr('#');
418             };
419              
420              
421              
422             # [013]
423             # c-anchor ::=
424             # '&'
425              
426             rule '013', c_anchor => sub {
427 0     0   0 my ($self) = @_;
428 0         0 debug_rule("c_anchor") if DEBUG;
429 0         0 $self->chr('&');
430             };
431              
432              
433              
434             # [014]
435             # c-alias ::=
436             # '*'
437              
438             rule '014', c_alias => sub {
439 0     0   0 my ($self) = @_;
440 0         0 debug_rule("c_alias") if DEBUG;
441 0         0 $self->chr('*');
442             };
443              
444              
445              
446             # [015]
447             # c-tag ::=
448             # '!'
449              
450             rule '015', c_tag => sub {
451 0     0   0 my ($self) = @_;
452 0         0 debug_rule("c_tag") if DEBUG;
453 0         0 $self->chr('!');
454             };
455              
456              
457              
458             # [016]
459             # c-literal ::=
460             # '|'
461              
462             rule '016', c_literal => sub {
463 0     0   0 my ($self) = @_;
464 0         0 debug_rule("c_literal") if DEBUG;
465 0         0 $self->chr('|');
466             };
467              
468              
469              
470             # [017]
471             # c-folded ::=
472             # '>'
473              
474             rule '017', c_folded => sub {
475 0     0   0 my ($self) = @_;
476 0         0 debug_rule("c_folded") if DEBUG;
477 0         0 $self->chr('>');
478             };
479              
480              
481              
482             # [018]
483             # c-single-quote ::=
484             # '''
485              
486             rule '018', c_single_quote => sub {
487 0     0   0 my ($self) = @_;
488 0         0 debug_rule("c_single_quote") if DEBUG;
489 0         0 $self->chr("'");
490             };
491              
492              
493              
494             # [019]
495             # c-double-quote ::=
496             # '"'
497              
498             rule '019', c_double_quote => sub {
499 0     0   0 my ($self) = @_;
500 0         0 debug_rule("c_double_quote") if DEBUG;
501 0         0 $self->chr('"');
502             };
503              
504              
505              
506             # [020]
507             # c-directive ::=
508             # '%'
509              
510             rule '020', c_directive => sub {
511 0     0   0 my ($self) = @_;
512 0         0 debug_rule("c_directive") if DEBUG;
513 0         0 $self->chr('%');
514             };
515              
516              
517              
518             # [021]
519             # c-reserved ::=
520             # '@' | '`'
521              
522             rule '021', c_reserved => sub {
523 0     0   0 my ($self) = @_;
524 0         0 debug_rule("c_reserved") if DEBUG;
525 0         0 $self->any(
526             $self->chr('@'),
527             $self->chr('`')
528             );
529             };
530              
531              
532              
533             # [022]
534             # c-indicator ::=
535             # '-' | '?' | ':' | ',' | '[' | ']' | '{' | '}'
536             # | '#' | '&' | '*' | '!' | '|' | '>' | ''' | '"'
537             # | '%' | '@' | '`'
538              
539             rule '022', c_indicator => sub {
540 14     14   40 my ($self) = @_;
541 14         31 debug_rule("c_indicator") if DEBUG;
542 14         38 $self->any(
543             $self->chr('-'),
544             $self->chr('?'),
545             $self->chr(':'),
546             $self->chr(','),
547             $self->chr('['),
548             $self->chr(']'),
549             $self->chr('{'),
550             $self->chr('}'),
551             $self->chr('#'),
552             $self->chr('&'),
553             $self->chr('*'),
554             $self->chr('!'),
555             $self->chr('|'),
556             $self->chr('>'),
557             $self->chr("'"),
558             $self->chr('"'),
559             $self->chr('%'),
560             $self->chr('@'),
561             $self->chr('`')
562             );
563             };
564              
565              
566              
567             # [023]
568             # c-flow-indicator ::=
569             # ',' | '[' | ']' | '{' | '}'
570              
571             rule '023', c_flow_indicator => sub {
572 8     8   18 my ($self) = @_;
573 8         11 debug_rule("c_flow_indicator") if DEBUG;
574 8         25 $self->any(
575             $self->chr(','),
576             $self->chr('['),
577             $self->chr(']'),
578             $self->chr('{'),
579             $self->chr('}')
580             );
581             };
582              
583              
584              
585             # [024]
586             # b-line-feed ::=
587             # x:A
588              
589             rule '024', b_line_feed => sub {
590 152     152   250 my ($self) = @_;
591 152         214 debug_rule("b_line_feed") if DEBUG;
592 152         302 $self->chr("\x{0A}");
593             };
594              
595              
596              
597             # [025]
598             # b-carriage-return ::=
599             # x:D
600              
601             rule '025', b_carriage_return => sub {
602 216     216   412 my ($self) = @_;
603 216         283 debug_rule("b_carriage_return") if DEBUG;
604 216         500 $self->chr("\x{0D}");
605             };
606              
607              
608              
609             # [026]
610             # b-char ::=
611             # b-line-feed | b-carriage-return
612              
613             rule '026', b_char => sub {
614 82     82   145 my ($self) = @_;
615 82         104 debug_rule("b_char") if DEBUG;
616 82         192 $self->any(
617             $self->func('b_line_feed'),
618             $self->func('b_carriage_return')
619             );
620             };
621              
622              
623              
624             # [027]
625             # nb-char ::=
626             # c-printable - b-char - c-byte-order-mark
627              
628             rule '027', nb_char => sub {
629 82     82   140 my ($self) = @_;
630 82         109 debug_rule("nb_char") if DEBUG;
631 82         174 $self->but(
632             $self->func('c_printable'),
633             $self->func('b_char'),
634             $self->func('c_byte_order_mark')
635             );
636             };
637              
638              
639              
640             # [028]
641             # b-break ::=
642             # ( b-carriage-return b-line-feed )
643             # | b-carriage-return
644             # | b-line-feed
645              
646             rule '028', b_break => sub {
647 70     70   124 my ($self) = @_;
648 70         92 debug_rule("b_break") if DEBUG;
649 70         131 $self->any(
650             $self->all(
651             $self->func('b_carriage_return'),
652             $self->func('b_line_feed')
653             ),
654             $self->func('b_carriage_return'),
655             $self->func('b_line_feed')
656             );
657             };
658              
659              
660              
661             # [029]
662             # b-as-line-feed ::=
663             # b-break
664              
665             rule '029', b_as_line_feed => sub {
666 16     16   35 my ($self) = @_;
667 16         21 debug_rule("b_as_line_feed") if DEBUG;
668 16         35 $self->func('b_break');
669             };
670              
671              
672              
673             # [030]
674             # b-non-content ::=
675             # b-break
676              
677             rule '030', b_non_content => sub {
678 46     46   78 my ($self) = @_;
679 46         56 debug_rule("b_non_content") if DEBUG;
680 46         91 $self->func('b_break');
681             };
682              
683              
684              
685             # [031]
686             # s-space ::=
687             # x:20
688              
689             rule '031', s_space => sub {
690 202     202   344 my ($self) = @_;
691 202         255 debug_rule("s_space") if DEBUG;
692 202         401 $self->chr("\x{20}");
693             };
694              
695              
696              
697             # [032]
698             # s-tab ::=
699             # x:9
700              
701             rule '032', s_tab => sub {
702 142     142   252 my ($self) = @_;
703 142         172 debug_rule("s_tab") if DEBUG;
704 142         291 $self->chr("\x{09}");
705             };
706              
707              
708              
709             # [033]
710             # s-white ::=
711             # s-space | s-tab
712              
713             rule '033', s_white => sub {
714 168     168   294 my ($self) = @_;
715 168         199 debug_rule("s_white") if DEBUG;
716 168         355 $self->any(
717             $self->func('s_space'),
718             $self->func('s_tab')
719             );
720             };
721              
722              
723              
724             # [034]
725             # ns-char ::=
726             # nb-char - s-white
727              
728             rule '034', ns_char => sub {
729 50     50   93 my ($self) = @_;
730 50         71 debug_rule("ns_char") if DEBUG;
731 50         97 $self->but(
732             $self->func('nb_char'),
733             $self->func('s_white')
734             );
735             };
736              
737              
738              
739             # [035]
740             # ns-dec-digit ::=
741             # [x:30-x:39]
742              
743             rule '035', ns_dec_digit => sub {
744 0     0   0 my ($self) = @_;
745 0         0 debug_rule("ns_dec_digit") if DEBUG;
746 0         0 $self->rng("\x{30}", "\x{39}");
747             };
748              
749              
750              
751             # [036]
752             # ns-hex-digit ::=
753             # ns-dec-digit
754             # | [x:41-x:46] | [x:61-x:66]
755              
756             rule '036', ns_hex_digit => sub {
757 0     0   0 my ($self) = @_;
758 0         0 debug_rule("ns_hex_digit") if DEBUG;
759 0         0 $self->any(
760             $self->func('ns_dec_digit'),
761             $self->rng("\x{41}", "\x{46}"),
762             $self->rng("\x{61}", "\x{66}")
763             );
764             };
765              
766              
767              
768             # [037]
769             # ns-ascii-letter ::=
770             # [x:41-x:5A] | [x:61-x:7A]
771              
772             rule '037', ns_ascii_letter => sub {
773 0     0   0 my ($self) = @_;
774 0         0 debug_rule("ns_ascii_letter") if DEBUG;
775 0         0 $self->any(
776             $self->rng("\x{41}", "\x{5A}"),
777             $self->rng("\x{61}", "\x{7A}")
778             );
779             };
780              
781              
782              
783             # [038]
784             # ns-word-char ::=
785             # ns-dec-digit | ns-ascii-letter | '-'
786              
787             rule '038', ns_word_char => sub {
788 0     0   0 my ($self) = @_;
789 0         0 debug_rule("ns_word_char") if DEBUG;
790 0         0 $self->any(
791             $self->func('ns_dec_digit'),
792             $self->func('ns_ascii_letter'),
793             $self->chr('-')
794             );
795             };
796              
797              
798              
799             # [039]
800             # ns-uri-char ::=
801             # '%' ns-hex-digit ns-hex-digit | ns-word-char | '#'
802             # | ';' | '/' | '?' | ':' | '@' | '&' | '=' | '+' | '$' | ','
803             # | '_' | '.' | '!' | '~' | '*' | ''' | '(' | ')' | '[' | ']'
804              
805             rule '039', ns_uri_char => sub {
806 0     0   0 my ($self) = @_;
807 0         0 debug_rule("ns_uri_char") if DEBUG;
808 0         0 $self->any(
809             $self->all(
810             $self->chr('%'),
811             $self->func('ns_hex_digit'),
812             $self->func('ns_hex_digit')
813             ),
814             $self->func('ns_word_char'),
815             $self->chr('#'),
816             $self->chr(';'),
817             $self->chr('/'),
818             $self->chr('?'),
819             $self->chr(':'),
820             $self->chr('@'),
821             $self->chr('&'),
822             $self->chr('='),
823             $self->chr('+'),
824             $self->chr('$'),
825             $self->chr(','),
826             $self->chr('_'),
827             $self->chr('.'),
828             $self->chr('!'),
829             $self->chr('~'),
830             $self->chr('*'),
831             $self->chr("'"),
832             $self->chr('('),
833             $self->chr(')'),
834             $self->chr('['),
835             $self->chr(']')
836             );
837             };
838              
839              
840              
841             # [040]
842             # ns-tag-char ::=
843             # ns-uri-char - '!' - c-flow-indicator
844              
845             rule '040', ns_tag_char => sub {
846 0     0   0 my ($self) = @_;
847 0         0 debug_rule("ns_tag_char") if DEBUG;
848 0         0 $self->but(
849             $self->func('ns_uri_char'),
850             $self->chr('!'),
851             $self->func('c_flow_indicator')
852             );
853             };
854              
855              
856              
857             # [041]
858             # c-escape ::=
859             # '\'
860              
861             rule '041', c_escape => sub {
862 0     0   0 my ($self) = @_;
863 0         0 debug_rule("c_escape") if DEBUG;
864 0         0 $self->chr("\\");
865             };
866              
867              
868              
869             # [042]
870             # ns-esc-null ::=
871             # '0'
872              
873             rule '042', ns_esc_null => sub {
874 0     0   0 my ($self) = @_;
875 0         0 debug_rule("ns_esc_null") if DEBUG;
876 0         0 $self->chr('0');
877             };
878              
879              
880              
881             # [043]
882             # ns-esc-bell ::=
883             # 'a'
884              
885             rule '043', ns_esc_bell => sub {
886 0     0   0 my ($self) = @_;
887 0         0 debug_rule("ns_esc_bell") if DEBUG;
888 0         0 $self->chr('a');
889             };
890              
891              
892              
893             # [044]
894             # ns-esc-backspace ::=
895             # 'b'
896              
897             rule '044', ns_esc_backspace => sub {
898 0     0   0 my ($self) = @_;
899 0         0 debug_rule("ns_esc_backspace") if DEBUG;
900 0         0 $self->chr('b');
901             };
902              
903              
904              
905             # [045]
906             # ns-esc-horizontal-tab ::=
907             # 't' | x:9
908              
909             rule '045', ns_esc_horizontal_tab => sub {
910 0     0   0 my ($self) = @_;
911 0         0 debug_rule("ns_esc_horizontal_tab") if DEBUG;
912 0         0 $self->any(
913             $self->chr('t'),
914             $self->chr("\x{09}")
915             );
916             };
917              
918              
919              
920             # [046]
921             # ns-esc-line-feed ::=
922             # 'n'
923              
924             rule '046', ns_esc_line_feed => sub {
925 0     0   0 my ($self) = @_;
926 0         0 debug_rule("ns_esc_line_feed") if DEBUG;
927 0         0 $self->chr('n');
928             };
929              
930              
931              
932             # [047]
933             # ns-esc-vertical-tab ::=
934             # 'v'
935              
936             rule '047', ns_esc_vertical_tab => sub {
937 0     0   0 my ($self) = @_;
938 0         0 debug_rule("ns_esc_vertical_tab") if DEBUG;
939 0         0 $self->chr('v');
940             };
941              
942              
943              
944             # [048]
945             # ns-esc-form-feed ::=
946             # 'f'
947              
948             rule '048', ns_esc_form_feed => sub {
949 0     0   0 my ($self) = @_;
950 0         0 debug_rule("ns_esc_form_feed") if DEBUG;
951 0         0 $self->chr('f');
952             };
953              
954              
955              
956             # [049]
957             # ns-esc-carriage-return ::=
958             # 'r'
959              
960             rule '049', ns_esc_carriage_return => sub {
961 0     0   0 my ($self) = @_;
962 0         0 debug_rule("ns_esc_carriage_return") if DEBUG;
963 0         0 $self->chr('r');
964             };
965              
966              
967              
968             # [050]
969             # ns-esc-escape ::=
970             # 'e'
971              
972             rule '050', ns_esc_escape => sub {
973 0     0   0 my ($self) = @_;
974 0         0 debug_rule("ns_esc_escape") if DEBUG;
975 0         0 $self->chr('e');
976             };
977              
978              
979              
980             # [051]
981             # ns-esc-space ::=
982             # x:20
983              
984             rule '051', ns_esc_space => sub {
985 0     0   0 my ($self) = @_;
986 0         0 debug_rule("ns_esc_space") if DEBUG;
987 0         0 $self->chr("\x{20}");
988             };
989              
990              
991              
992             # [052]
993             # ns-esc-double-quote ::=
994             # '"'
995              
996             rule '052', ns_esc_double_quote => sub {
997 0     0   0 my ($self) = @_;
998 0         0 debug_rule("ns_esc_double_quote") if DEBUG;
999 0         0 $self->chr('"');
1000             };
1001              
1002              
1003              
1004             # [053]
1005             # ns-esc-slash ::=
1006             # '/'
1007              
1008             rule '053', ns_esc_slash => sub {
1009 0     0   0 my ($self) = @_;
1010 0         0 debug_rule("ns_esc_slash") if DEBUG;
1011 0         0 $self->chr('/');
1012             };
1013              
1014              
1015              
1016             # [054]
1017             # ns-esc-backslash ::=
1018             # '\'
1019              
1020             rule '054', ns_esc_backslash => sub {
1021 0     0   0 my ($self) = @_;
1022 0         0 debug_rule("ns_esc_backslash") if DEBUG;
1023 0         0 $self->chr("\\");
1024             };
1025              
1026              
1027              
1028             # [055]
1029             # ns-esc-next-line ::=
1030             # 'N'
1031              
1032             rule '055', ns_esc_next_line => sub {
1033 0     0   0 my ($self) = @_;
1034 0         0 debug_rule("ns_esc_next_line") if DEBUG;
1035 0         0 $self->chr('N');
1036             };
1037              
1038              
1039              
1040             # [056]
1041             # ns-esc-non-breaking-space ::=
1042             # '_'
1043              
1044             rule '056', ns_esc_non_breaking_space => sub {
1045 0     0   0 my ($self) = @_;
1046 0         0 debug_rule("ns_esc_non_breaking_space") if DEBUG;
1047 0         0 $self->chr('_');
1048             };
1049              
1050              
1051              
1052             # [057]
1053             # ns-esc-line-separator ::=
1054             # 'L'
1055              
1056             rule '057', ns_esc_line_separator => sub {
1057 0     0   0 my ($self) = @_;
1058 0         0 debug_rule("ns_esc_line_separator") if DEBUG;
1059 0         0 $self->chr('L');
1060             };
1061              
1062              
1063              
1064             # [058]
1065             # ns-esc-paragraph-separator ::=
1066             # 'P'
1067              
1068             rule '058', ns_esc_paragraph_separator => sub {
1069 0     0   0 my ($self) = @_;
1070 0         0 debug_rule("ns_esc_paragraph_separator") if DEBUG;
1071 0         0 $self->chr('P');
1072             };
1073              
1074              
1075              
1076             # [059]
1077             # ns-esc-8-bit ::=
1078             # 'x'
1079             # ( ns-hex-digit{2} )
1080              
1081             rule '059', ns_esc_8_bit => sub {
1082 0     0   0 my ($self) = @_;
1083 0         0 debug_rule("ns_esc_8_bit") if DEBUG;
1084 0         0 $self->all(
1085             $self->chr('x'),
1086             $self->rep($2, $2, $self->func('ns_hex_digit'))
1087             );
1088             };
1089              
1090              
1091              
1092             # [060]
1093             # ns-esc-16-bit ::=
1094             # 'u'
1095             # ( ns-hex-digit{4} )
1096              
1097             rule '060', ns_esc_16_bit => sub {
1098 0     0   0 my ($self) = @_;
1099 0         0 debug_rule("ns_esc_16_bit") if DEBUG;
1100 0         0 $self->all(
1101             $self->chr('u'),
1102             $self->rep($4, $4, $self->func('ns_hex_digit'))
1103             );
1104             };
1105              
1106              
1107              
1108             # [061]
1109             # ns-esc-32-bit ::=
1110             # 'U'
1111             # ( ns-hex-digit{8} )
1112              
1113             rule '061', ns_esc_32_bit => sub {
1114 0     0   0 my ($self) = @_;
1115 0         0 debug_rule("ns_esc_32_bit") if DEBUG;
1116 0         0 $self->all(
1117             $self->chr('U'),
1118             $self->rep($8, $8, $self->func('ns_hex_digit'))
1119             );
1120             };
1121              
1122              
1123              
1124             # [062]
1125             # c-ns-esc-char ::=
1126             # '\'
1127             # ( ns-esc-null | ns-esc-bell | ns-esc-backspace
1128             # | ns-esc-horizontal-tab | ns-esc-line-feed
1129             # | ns-esc-vertical-tab | ns-esc-form-feed
1130             # | ns-esc-carriage-return | ns-esc-escape | ns-esc-space
1131             # | ns-esc-double-quote | ns-esc-slash | ns-esc-backslash
1132             # | ns-esc-next-line | ns-esc-non-breaking-space
1133             # | ns-esc-line-separator | ns-esc-paragraph-separator
1134             # | ns-esc-8-bit | ns-esc-16-bit | ns-esc-32-bit )
1135              
1136             rule '062', c_ns_esc_char => sub {
1137 0     0   0 my ($self) = @_;
1138 0         0 debug_rule("c_ns_esc_char") if DEBUG;
1139 0         0 $self->all(
1140             $self->chr("\\"),
1141             $self->any(
1142             $self->func('ns_esc_null'),
1143             $self->func('ns_esc_bell'),
1144             $self->func('ns_esc_backspace'),
1145             $self->func('ns_esc_horizontal_tab'),
1146             $self->func('ns_esc_line_feed'),
1147             $self->func('ns_esc_vertical_tab'),
1148             $self->func('ns_esc_form_feed'),
1149             $self->func('ns_esc_carriage_return'),
1150             $self->func('ns_esc_escape'),
1151             $self->func('ns_esc_space'),
1152             $self->func('ns_esc_double_quote'),
1153             $self->func('ns_esc_slash'),
1154             $self->func('ns_esc_backslash'),
1155             $self->func('ns_esc_next_line'),
1156             $self->func('ns_esc_non_breaking_space'),
1157             $self->func('ns_esc_line_separator'),
1158             $self->func('ns_esc_paragraph_separator'),
1159             $self->func('ns_esc_8_bit'),
1160             $self->func('ns_esc_16_bit'),
1161             $self->func('ns_esc_32_bit')
1162             )
1163             );
1164             };
1165              
1166              
1167              
1168             # [063]
1169             # s-indent(n) ::=
1170             # s-space{n}
1171              
1172             rule '063', s_indent => sub {
1173 28     28   56 my ($self, $n) = @_;
1174 28         37 debug_rule("s_indent",$n) if DEBUG;
1175 28         105 $self->rep($n, $n, $self->func('s_space'));
1176             };
1177              
1178              
1179              
1180             # [064]
1181             # s-indent(
1182             # s-space{m}
1183              
1184             rule '064', s_indent_lt => sub {
1185 4     4   12 my ($self, $n) = @_;
1186 4         6 debug_rule("s_indent_lt",$n) if DEBUG;
1187 4         12 $self->may(
1188             $self->all(
1189             $self->rep(0, undef, $self->func('s_space')),
1190             $self->lt($self->len($self->func('match')), $n)
1191             )
1192             );
1193             };
1194              
1195              
1196              
1197             # [065]
1198             # s-indent(<=n) ::=
1199             # s-space{m}
1200              
1201             rule '065', s_indent_le => sub {
1202 2     2   5 my ($self, $n) = @_;
1203 2         4 debug_rule("s_indent_le",$n) if DEBUG;
1204 2         6 $self->may(
1205             $self->all(
1206             $self->rep(0, undef, $self->func('s_space')),
1207             $self->le($self->len($self->func('match')), $n)
1208             )
1209             );
1210             };
1211              
1212              
1213              
1214             # [066]
1215             # s-separate-in-line ::=
1216             # s-white+ |
1217              
1218             rule '066', s_separate_in_line => sub {
1219 72     72   118 my ($self) = @_;
1220 72         107 debug_rule("s_separate_in_line") if DEBUG;
1221 72         160 $self->any(
1222             $self->rep(1, undef, $self->func('s_white')),
1223             $self->func('start_of_line')
1224             );
1225             };
1226              
1227              
1228              
1229             # [067]
1230             # s-line-prefix(n,c) ::=
1231             # ( c = block-out => s-block-line-prefix(n) )
1232             # ( c = block-in => s-block-line-prefix(n) )
1233             # ( c = flow-out => s-flow-line-prefix(n) )
1234             # ( c = flow-in => s-flow-line-prefix(n) )
1235              
1236             rule '067', s_line_prefix => sub {
1237 8     8   17 my ($self, $n, $c) = @_;
1238 8         12 debug_rule("s_line_prefix",$n,$c) if DEBUG;
1239 8         22 $self->case(
1240             $c,
1241             {
1242             'block-in' => [ $self->func('s_block_line_prefix'), $n ],
1243             'block-out' => [ $self->func('s_block_line_prefix'), $n ],
1244             'flow-in' => [ $self->func('s_flow_line_prefix'), $n ],
1245             'flow-out' => [ $self->func('s_flow_line_prefix'), $n ],
1246             }
1247             );
1248             };
1249              
1250              
1251              
1252             # [068]
1253             # s-block-line-prefix(n) ::=
1254             # s-indent(n)
1255              
1256             rule '068', s_block_line_prefix => sub {
1257 8     8   18 my ($self, $n) = @_;
1258 8         13 debug_rule("s_block_line_prefix",$n) if DEBUG;
1259 8         22 [ $self->func('s_indent'), $n ];
1260             };
1261              
1262              
1263              
1264             # [069]
1265             # s-flow-line-prefix(n) ::=
1266             # s-indent(n)
1267             # s-separate-in-line?
1268              
1269             rule '069', s_flow_line_prefix => sub {
1270 4     4   9 my ($self, $n) = @_;
1271 4         5 debug_rule("s_flow_line_prefix",$n) if DEBUG;
1272 4         11 $self->all(
1273             [ $self->func('s_indent'), $n ],
1274             $self->rep(0, 1, $self->func('s_separate_in_line'))
1275             );
1276             };
1277              
1278              
1279              
1280             # [070]
1281             # l-empty(n,c) ::=
1282             # ( s-line-prefix(n,c) | s-indent(
1283             # b-as-line-feed
1284              
1285             rule '070', l_empty => sub {
1286 8     8   19 my ($self, $n, $c) = @_;
1287 8         12 debug_rule("l_empty",$n,$c) if DEBUG;
1288 8         21 $self->all(
1289             $self->any(
1290             [ $self->func('s_line_prefix'), $n, $c ],
1291             [ $self->func('s_indent_lt'), $n ]
1292             ),
1293             $self->func('b_as_line_feed')
1294             );
1295             };
1296              
1297              
1298              
1299             # [071]
1300             # b-l-trimmed(n,c) ::=
1301             # b-non-content l-empty(n,c)+
1302              
1303             rule '071', b_l_trimmed => sub {
1304 4     4   17 my ($self, $n, $c) = @_;
1305 4         6 debug_rule("b_l_trimmed",$n,$c) if DEBUG;
1306 4         12 $self->all(
1307             $self->func('b_non_content'),
1308             $self->rep(1, undef, [ $self->func('l_empty'), $n, $c ])
1309             );
1310             };
1311              
1312              
1313              
1314             # [072]
1315             # b-as-space ::=
1316             # b-break
1317              
1318             rule '072', b_as_space => sub {
1319 4     4   11 my ($self) = @_;
1320 4         6 debug_rule("b_as_space") if DEBUG;
1321 4         16 $self->func('b_break');
1322             };
1323              
1324              
1325              
1326             # [073]
1327             # b-l-folded(n,c) ::=
1328             # b-l-trimmed(n,c) | b-as-space
1329              
1330             rule '073', b_l_folded => sub {
1331 4     4   15 my ($self, $n, $c) = @_;
1332 4         19 debug_rule("b_l_folded",$n,$c) if DEBUG;
1333 4         11 $self->any(
1334             [ $self->func('b_l_trimmed'), $n, $c ],
1335             $self->func('b_as_space')
1336             );
1337             };
1338              
1339              
1340              
1341             # [074]
1342             # s-flow-folded(n) ::=
1343             # s-separate-in-line?
1344             # b-l-folded(n,flow-in)
1345             # s-flow-line-prefix(n)
1346              
1347             rule '074', s_flow_folded => sub {
1348 4     4   15 my ($self, $n) = @_;
1349 4         6 debug_rule("s_flow_folded",$n) if DEBUG;
1350 4         11 $self->all(
1351             $self->rep(0, 1, $self->func('s_separate_in_line')),
1352             [ $self->func('b_l_folded'), $n, "flow-in" ],
1353             [ $self->func('s_flow_line_prefix'), $n ]
1354             );
1355             };
1356              
1357              
1358              
1359             # [075]
1360             # c-nb-comment-text ::=
1361             # '#' nb-char*
1362              
1363             rule '075', c_nb_comment_text => sub {
1364 26     26   53 my ($self) = @_;
1365 26         31 debug_rule("c_nb_comment_text") if DEBUG;
1366 26         56 $self->all(
1367             $self->chr('#'),
1368             $self->rep(0, undef, $self->func('nb_char'))
1369             );
1370             };
1371              
1372              
1373              
1374             # [076]
1375             # b-comment ::=
1376             # b-non-content |
1377              
1378             rule '076', b_comment => sub {
1379 40     40   79 my ($self) = @_;
1380 40         44 debug_rule("b_comment") if DEBUG;
1381 40         82 $self->any(
1382             $self->func('b_non_content'),
1383             $self->func('end_of_stream')
1384             );
1385             };
1386              
1387              
1388              
1389             # [077]
1390             # s-b-comment ::=
1391             # ( s-separate-in-line
1392             # c-nb-comment-text? )?
1393             # b-comment
1394              
1395             rule '077', s_b_comment => sub {
1396 28     28   60 my ($self) = @_;
1397 28         31 debug_rule("s_b_comment") if DEBUG;
1398 28         65 $self->all(
1399             $self->rep(0, 1,
1400             $self->all(
1401             $self->func('s_separate_in_line'),
1402             $self->rep(0, 1, $self->func('c_nb_comment_text'))
1403             )),
1404             $self->func('b_comment')
1405             );
1406             };
1407              
1408              
1409              
1410             # [078]
1411             # l-comment ::=
1412             # s-separate-in-line c-nb-comment-text?
1413             # b-comment
1414              
1415             rule '078', l_comment => sub {
1416 12     12   24 my ($self) = @_;
1417 12         18 debug_rule("l_comment") if DEBUG;
1418 12         28 $self->all(
1419             $self->func('s_separate_in_line'),
1420             $self->rep(0, 1, $self->func('c_nb_comment_text')),
1421             $self->func('b_comment')
1422             );
1423             };
1424              
1425              
1426              
1427             # [079]
1428             # s-l-comments ::=
1429             # ( s-b-comment | )
1430             # l-comment*
1431              
1432             rule '079', s_l_comments => sub {
1433 26     26   59 my ($self) = @_;
1434 26         33 debug_rule("s_l_comments") if DEBUG;
1435 26         67 $self->all(
1436             $self->any(
1437             $self->func('s_b_comment'),
1438             $self->func('start_of_line')
1439             ),
1440             $self->rep(0, undef, $self->func('l_comment'))
1441             );
1442             };
1443              
1444              
1445              
1446             # [080]
1447             # s-separate(n,c) ::=
1448             # ( c = block-out => s-separate-lines(n) )
1449             # ( c = block-in => s-separate-lines(n) )
1450             # ( c = flow-out => s-separate-lines(n) )
1451             # ( c = flow-in => s-separate-lines(n) )
1452             # ( c = block-key => s-separate-in-line )
1453             # ( c = flow-key => s-separate-in-line )
1454              
1455             rule '080', s_separate => sub {
1456 20     20   53 my ($self, $n, $c) = @_;
1457 20         33 debug_rule("s_separate",$n,$c) if DEBUG;
1458 20         56 $self->case(
1459             $c,
1460             {
1461             'block-in' => [ $self->func('s_separate_lines'), $n ],
1462             'block-key' => $self->func('s_separate_in_line'),
1463             'block-out' => [ $self->func('s_separate_lines'), $n ],
1464             'flow-in' => [ $self->func('s_separate_lines'), $n ],
1465             'flow-key' => $self->func('s_separate_in_line'),
1466             'flow-out' => [ $self->func('s_separate_lines'), $n ],
1467             }
1468             );
1469             };
1470              
1471              
1472              
1473             # [081]
1474             # s-separate-lines(n) ::=
1475             # ( s-l-comments
1476             # s-flow-line-prefix(n) )
1477             # | s-separate-in-line
1478              
1479             rule '081', s_separate_lines => sub {
1480 20     20   47 my ($self, $n) = @_;
1481 20         28 debug_rule("s_separate_lines",$n) if DEBUG;
1482 20         50 $self->any(
1483             $self->all(
1484             $self->func('s_l_comments'),
1485             [ $self->func('s_flow_line_prefix'), $n ]
1486             ),
1487             $self->func('s_separate_in_line')
1488             );
1489             };
1490              
1491              
1492              
1493             # [082]
1494             # l-directive ::=
1495             # '%'
1496             # ( ns-yaml-directive
1497             # | ns-tag-directive
1498             # | ns-reserved-directive )
1499             # s-l-comments
1500              
1501             rule '082', l_directive => sub {
1502 2     2   6 my ($self) = @_;
1503 2         4 debug_rule("l_directive") if DEBUG;
1504 2         6 $self->all(
1505             $self->chr('%'),
1506             $self->any(
1507             $self->func('ns_yaml_directive'),
1508             $self->func('ns_tag_directive'),
1509             $self->func('ns_reserved_directive')
1510             ),
1511             $self->func('s_l_comments')
1512             );
1513             };
1514              
1515              
1516              
1517             # [083]
1518             # ns-reserved-directive ::=
1519             # ns-directive-name
1520             # ( s-separate-in-line ns-directive-parameter )*
1521              
1522             rule '083', ns_reserved_directive => sub {
1523 0     0   0 my ($self) = @_;
1524 0         0 debug_rule("ns_reserved_directive") if DEBUG;
1525 0         0 $self->all(
1526             $self->func('ns_directive_name'),
1527             $self->rep(0, undef,
1528             $self->all(
1529             $self->func('s_separate_in_line'),
1530             $self->func('ns_directive_parameter')
1531             ))
1532             );
1533             };
1534              
1535              
1536              
1537             # [084]
1538             # ns-directive-name ::=
1539             # ns-char+
1540              
1541             rule '084', ns_directive_name => sub {
1542 0     0   0 my ($self) = @_;
1543 0         0 debug_rule("ns_directive_name") if DEBUG;
1544 0         0 $self->rep(1, undef, $self->func('ns_char'));
1545             };
1546              
1547              
1548              
1549             # [085]
1550             # ns-directive-parameter ::=
1551             # ns-char+
1552              
1553             rule '085', ns_directive_parameter => sub {
1554 0     0   0 my ($self) = @_;
1555 0         0 debug_rule("ns_directive_parameter") if DEBUG;
1556 0         0 $self->rep(1, undef, $self->func('ns_char'));
1557             };
1558              
1559              
1560              
1561             # [086]
1562             # ns-yaml-directive ::=
1563             # 'Y' 'A' 'M' 'L'
1564             # s-separate-in-line ns-yaml-version
1565              
1566             rule '086', ns_yaml_directive => sub {
1567 0     0   0 my ($self) = @_;
1568 0         0 debug_rule("ns_yaml_directive") if DEBUG;
1569 0         0 $self->all(
1570             $self->chr('Y'),
1571             $self->chr('A'),
1572             $self->chr('M'),
1573             $self->chr('L'),
1574             $self->func('s_separate_in_line'),
1575             $self->func('ns_yaml_version')
1576             );
1577             };
1578              
1579              
1580              
1581             # [087]
1582             # ns-yaml-version ::=
1583             # ns-dec-digit+ '.' ns-dec-digit+
1584              
1585             rule '087', ns_yaml_version => sub {
1586 0     0   0 my ($self) = @_;
1587 0         0 debug_rule("ns_yaml_version") if DEBUG;
1588 0         0 $self->all(
1589             $self->rep(1, undef, $self->func('ns_dec_digit')),
1590             $self->chr('.'),
1591             $self->rep2(1, undef, $self->func('ns_dec_digit'))
1592             );
1593             };
1594              
1595              
1596              
1597             # [088]
1598             # ns-tag-directive ::=
1599             # 'T' 'A' 'G'
1600             # s-separate-in-line c-tag-handle
1601             # s-separate-in-line ns-tag-prefix
1602              
1603             rule '088', ns_tag_directive => sub {
1604 0     0   0 my ($self) = @_;
1605 0         0 debug_rule("ns_tag_directive") if DEBUG;
1606 0         0 $self->all(
1607             $self->chr('T'),
1608             $self->chr('A'),
1609             $self->chr('G'),
1610             $self->func('s_separate_in_line'),
1611             $self->func('c_tag_handle'),
1612             $self->func('s_separate_in_line'),
1613             $self->func('ns_tag_prefix')
1614             );
1615             };
1616              
1617              
1618              
1619             # [089]
1620             # c-tag-handle ::=
1621             # c-named-tag-handle
1622             # | c-secondary-tag-handle
1623             # | c-primary-tag-handle
1624              
1625             rule '089', c_tag_handle => sub {
1626 26     26   52 my ($self) = @_;
1627 26         35 debug_rule("c_tag_handle") if DEBUG;
1628 26         58 $self->any(
1629             $self->func('c_named_tag_handle'),
1630             $self->func('c_secondary_tag_handle'),
1631             $self->func('c_primary_tag_handle')
1632             );
1633             };
1634              
1635              
1636              
1637             # [090]
1638             # c-primary-tag-handle ::=
1639             # '!'
1640              
1641             rule '090', c_primary_tag_handle => sub {
1642 26     26   50 my ($self) = @_;
1643 26         39 debug_rule("c_primary_tag_handle") if DEBUG;
1644 26         56 $self->chr('!');
1645             };
1646              
1647              
1648              
1649             # [091]
1650             # c-secondary-tag-handle ::=
1651             # '!' '!'
1652              
1653             rule '091', c_secondary_tag_handle => sub {
1654 26     26   53 my ($self) = @_;
1655 26         33 debug_rule("c_secondary_tag_handle") if DEBUG;
1656 26         59 $self->all(
1657             $self->chr('!'),
1658             $self->chr('!')
1659             );
1660             };
1661              
1662              
1663              
1664             # [092]
1665             # c-named-tag-handle ::=
1666             # '!' ns-word-char+ '!'
1667              
1668             rule '092', c_named_tag_handle => sub {
1669 26     26   50 my ($self) = @_;
1670 26         39 debug_rule("c_named_tag_handle") if DEBUG;
1671 26         57 $self->all(
1672             $self->chr('!'),
1673             $self->rep(1, undef, $self->func('ns_word_char')),
1674             $self->chr('!')
1675             );
1676             };
1677              
1678              
1679              
1680             # [093]
1681             # ns-tag-prefix ::=
1682             # c-ns-local-tag-prefix | ns-global-tag-prefix
1683              
1684             rule '093', ns_tag_prefix => sub {
1685 0     0   0 my ($self) = @_;
1686 0         0 debug_rule("ns_tag_prefix") if DEBUG;
1687 0         0 $self->any(
1688             $self->func('c_ns_local_tag_prefix'),
1689             $self->func('ns_global_tag_prefix')
1690             );
1691             };
1692              
1693              
1694              
1695             # [094]
1696             # c-ns-local-tag-prefix ::=
1697             # '!' ns-uri-char*
1698              
1699             rule '094', c_ns_local_tag_prefix => sub {
1700 0     0   0 my ($self) = @_;
1701 0         0 debug_rule("c_ns_local_tag_prefix") if DEBUG;
1702 0         0 $self->all(
1703             $self->chr('!'),
1704             $self->rep(0, undef, $self->func('ns_uri_char'))
1705             );
1706             };
1707              
1708              
1709              
1710             # [095]
1711             # ns-global-tag-prefix ::=
1712             # ns-tag-char ns-uri-char*
1713              
1714             rule '095', ns_global_tag_prefix => sub {
1715 0     0   0 my ($self) = @_;
1716 0         0 debug_rule("ns_global_tag_prefix") if DEBUG;
1717 0         0 $self->all(
1718             $self->func('ns_tag_char'),
1719             $self->rep(0, undef, $self->func('ns_uri_char'))
1720             );
1721             };
1722              
1723              
1724              
1725             # [096]
1726             # c-ns-properties(n,c) ::=
1727             # ( c-ns-tag-property
1728             # ( s-separate(n,c) c-ns-anchor-property )? )
1729             # | ( c-ns-anchor-property
1730             # ( s-separate(n,c) c-ns-tag-property )? )
1731              
1732             rule '096', c_ns_properties => sub {
1733 22     22   69 my ($self, $n, $c) = @_;
1734 22         60 debug_rule("c_ns_properties",$n,$c) if DEBUG;
1735 22         54 $self->any(
1736             $self->all(
1737             $self->func('c_ns_tag_property'),
1738             $self->rep(0, 1,
1739             $self->all(
1740             [ $self->func('s_separate'), $n, $c ],
1741             $self->func('c_ns_anchor_property')
1742             ))
1743             ),
1744             $self->all(
1745             $self->func('c_ns_anchor_property'),
1746             $self->rep(0, 1,
1747             $self->all(
1748             [ $self->func('s_separate'), $n, $c ],
1749             $self->func('c_ns_tag_property')
1750             ))
1751             )
1752             );
1753             };
1754              
1755              
1756              
1757             # [097]
1758             # c-ns-tag-property ::=
1759             # c-verbatim-tag
1760             # | c-ns-shorthand-tag
1761             # | c-non-specific-tag
1762              
1763             rule '097', c_ns_tag_property => sub {
1764 26     26   61 my ($self) = @_;
1765 26         38 debug_rule("c_ns_tag_property") if DEBUG;
1766 26         64 $self->any(
1767             $self->func('c_verbatim_tag'),
1768             $self->func('c_ns_shorthand_tag'),
1769             $self->func('c_non_specific_tag')
1770             );
1771             };
1772              
1773              
1774              
1775             # [098]
1776             # c-verbatim-tag ::=
1777             # '!' '<' ns-uri-char+ '>'
1778              
1779             rule '098', c_verbatim_tag => sub {
1780 26     26   63 my ($self) = @_;
1781 26         36 debug_rule("c_verbatim_tag") if DEBUG;
1782 26         64 $self->all(
1783             $self->chr('!'),
1784             $self->chr('<'),
1785             $self->rep(1, undef, $self->func('ns_uri_char')),
1786             $self->chr('>')
1787             );
1788             };
1789              
1790              
1791              
1792             # [099]
1793             # c-ns-shorthand-tag ::=
1794             # c-tag-handle ns-tag-char+
1795              
1796             rule '099', c_ns_shorthand_tag => sub {
1797 26     26   50 my ($self) = @_;
1798 26         31 debug_rule("c_ns_shorthand_tag") if DEBUG;
1799 26         62 $self->all(
1800             $self->func('c_tag_handle'),
1801             $self->rep(1, undef, $self->func('ns_tag_char'))
1802             );
1803             };
1804              
1805              
1806              
1807             # [100]
1808             # c-non-specific-tag ::=
1809             # '!'
1810              
1811             rule '100', c_non_specific_tag => sub {
1812 26     26   51 my ($self) = @_;
1813 26         33 debug_rule("c_non_specific_tag") if DEBUG;
1814 26         72 $self->chr('!');
1815             };
1816              
1817              
1818              
1819             # [101]
1820             # c-ns-anchor-property ::=
1821             # '&' ns-anchor-name
1822              
1823             rule '101', c_ns_anchor_property => sub {
1824 26     26   48 my ($self) = @_;
1825 26         38 debug_rule("c_ns_anchor_property") if DEBUG;
1826 26         62 $self->all(
1827             $self->chr('&'),
1828             $self->func('ns_anchor_name')
1829             );
1830             };
1831              
1832              
1833              
1834             # [102]
1835             # ns-anchor-char ::=
1836             # ns-char - c-flow-indicator
1837              
1838             rule '102', ns_anchor_char => sub {
1839 0     0   0 my ($self) = @_;
1840 0         0 debug_rule("ns_anchor_char") if DEBUG;
1841 0         0 $self->but(
1842             $self->func('ns_char'),
1843             $self->func('c_flow_indicator')
1844             );
1845             };
1846              
1847              
1848              
1849             # [103]
1850             # ns-anchor-name ::=
1851             # ns-anchor-char+
1852              
1853             rule '103', ns_anchor_name => sub {
1854 0     0   0 my ($self) = @_;
1855 0         0 debug_rule("ns_anchor_name") if DEBUG;
1856 0         0 $self->rep(1, undef, $self->func('ns_anchor_char'));
1857             };
1858              
1859              
1860              
1861             # [104]
1862             # c-ns-alias-node ::=
1863             # '*' ns-anchor-name
1864              
1865             rule '104', c_ns_alias_node => sub {
1866 16     16   44 my ($self) = @_;
1867 16         21 debug_rule("c_ns_alias_node") if DEBUG;
1868 16         51 $self->all(
1869             $self->chr('*'),
1870             $self->func('ns_anchor_name')
1871             );
1872             };
1873              
1874              
1875              
1876             # [105]
1877             # e-scalar ::=
1878             #
1879              
1880             rule '105', e_scalar => sub {
1881 6     6   16 my ($self) = @_;
1882 6         9 debug_rule("e_scalar") if DEBUG;
1883 6         14 $self->func('empty');
1884             };
1885              
1886              
1887              
1888             # [106]
1889             # e-node ::=
1890             # e-scalar
1891              
1892             rule '106', e_node => sub {
1893 6     6   20 my ($self) = @_;
1894 6         8 debug_rule("e_node") if DEBUG;
1895 6         17 $self->func('e_scalar');
1896             };
1897              
1898              
1899              
1900             # [107]
1901             # nb-double-char ::=
1902             # c-ns-esc-char | ( nb-json - '\' - '"' )
1903              
1904             rule '107', nb_double_char => sub {
1905 0     0   0 my ($self) = @_;
1906 0         0 debug_rule("nb_double_char") if DEBUG;
1907 0         0 $self->any(
1908             $self->func('c_ns_esc_char'),
1909             $self->but(
1910             $self->func('nb_json'),
1911             $self->chr("\\"),
1912             $self->chr('"')
1913             )
1914             );
1915             };
1916              
1917              
1918              
1919             # [108]
1920             # ns-double-char ::=
1921             # nb-double-char - s-white
1922              
1923             rule '108', ns_double_char => sub {
1924 0     0   0 my ($self) = @_;
1925 0         0 debug_rule("ns_double_char") if DEBUG;
1926 0         0 $self->but(
1927             $self->func('nb_double_char'),
1928             $self->func('s_white')
1929             );
1930             };
1931              
1932              
1933              
1934             # [109]
1935             # c-double-quoted(n,c) ::=
1936             # '"' nb-double-text(n,c)
1937             # '"'
1938              
1939             rule '109', c_double_quoted => sub {
1940 10     10   35 my ($self, $n, $c) = @_;
1941 10         17 debug_rule("c_double_quoted",$n,$c) if DEBUG;
1942 10         30 $self->all(
1943             $self->chr('"'),
1944             [ $self->func('nb_double_text'), $n, $c ],
1945             $self->chr('"')
1946             );
1947             };
1948              
1949              
1950              
1951             # [110]
1952             # nb-double-text(n,c) ::=
1953             # ( c = flow-out => nb-double-multi-line(n) )
1954             # ( c = flow-in => nb-double-multi-line(n) )
1955             # ( c = block-key => nb-double-one-line )
1956             # ( c = flow-key => nb-double-one-line )
1957              
1958             rule '110', nb_double_text => sub {
1959 0     0   0 my ($self, $n, $c) = @_;
1960 0         0 debug_rule("nb_double_text",$n,$c) if DEBUG;
1961 0         0 $self->case(
1962             $c,
1963             {
1964             'block-key' => $self->func('nb_double_one_line'),
1965             'flow-in' => [ $self->func('nb_double_multi_line'), $n ],
1966             'flow-key' => $self->func('nb_double_one_line'),
1967             'flow-out' => [ $self->func('nb_double_multi_line'), $n ],
1968             }
1969             );
1970             };
1971              
1972              
1973              
1974             # [111]
1975             # nb-double-one-line ::=
1976             # nb-double-char*
1977              
1978             rule '111', nb_double_one_line => sub {
1979 0     0   0 my ($self) = @_;
1980 0         0 debug_rule("nb_double_one_line") if DEBUG;
1981 0         0 $self->rep(0, undef, $self->func('nb_double_char'));
1982             };
1983              
1984              
1985              
1986             # [112]
1987             # s-double-escaped(n) ::=
1988             # s-white* '\'
1989             # b-non-content
1990             # l-empty(n,flow-in)* s-flow-line-prefix(n)
1991              
1992             rule '112', s_double_escaped => sub {
1993 0     0   0 my ($self, $n) = @_;
1994 0         0 debug_rule("s_double_escaped",$n) if DEBUG;
1995 0         0 $self->all(
1996             $self->rep(0, undef, $self->func('s_white')),
1997             $self->chr("\\"),
1998             $self->func('b_non_content'),
1999             $self->rep2(0, undef, [ $self->func('l_empty'), $n, "flow-in" ]),
2000             [ $self->func('s_flow_line_prefix'), $n ]
2001             );
2002             };
2003              
2004              
2005              
2006             # [113]
2007             # s-double-break(n) ::=
2008             # s-double-escaped(n) | s-flow-folded(n)
2009              
2010             rule '113', s_double_break => sub {
2011 0     0   0 my ($self, $n) = @_;
2012 0         0 debug_rule("s_double_break",$n) if DEBUG;
2013 0         0 $self->any(
2014             [ $self->func('s_double_escaped'), $n ],
2015             [ $self->func('s_flow_folded'), $n ]
2016             );
2017             };
2018              
2019              
2020              
2021             # [114]
2022             # nb-ns-double-in-line ::=
2023             # ( s-white* ns-double-char )*
2024              
2025             rule '114', nb_ns_double_in_line => sub {
2026 0     0   0 my ($self) = @_;
2027 0         0 debug_rule("nb_ns_double_in_line") if DEBUG;
2028 0         0 $self->rep(0, undef,
2029             $self->all(
2030             $self->rep(0, undef, $self->func('s_white')),
2031             $self->func('ns_double_char')
2032             ));
2033             };
2034              
2035              
2036              
2037             # [115]
2038             # s-double-next-line(n) ::=
2039             # s-double-break(n)
2040             # ( ns-double-char nb-ns-double-in-line
2041             # ( s-double-next-line(n) | s-white* ) )?
2042              
2043             rule '115', s_double_next_line => sub {
2044 0     0   0 my ($self, $n) = @_;
2045 0         0 debug_rule("s_double_next_line",$n) if DEBUG;
2046 0         0 $self->all(
2047             [ $self->func('s_double_break'), $n ],
2048             $self->rep(0, 1,
2049             $self->all(
2050             $self->func('ns_double_char'),
2051             $self->func('nb_ns_double_in_line'),
2052             $self->any(
2053             [ $self->func('s_double_next_line'), $n ],
2054             $self->rep(0, undef, $self->func('s_white'))
2055             )
2056             ))
2057             );
2058             };
2059              
2060              
2061              
2062             # [116]
2063             # nb-double-multi-line(n) ::=
2064             # nb-ns-double-in-line
2065             # ( s-double-next-line(n) | s-white* )
2066              
2067             rule '116', nb_double_multi_line => sub {
2068 0     0   0 my ($self, $n) = @_;
2069 0         0 debug_rule("nb_double_multi_line",$n) if DEBUG;
2070 0         0 $self->all(
2071             $self->func('nb_ns_double_in_line'),
2072             $self->any(
2073             [ $self->func('s_double_next_line'), $n ],
2074             $self->rep(0, undef, $self->func('s_white'))
2075             )
2076             );
2077             };
2078              
2079              
2080              
2081             # [117]
2082             # c-quoted-quote ::=
2083             # ''' '''
2084              
2085             rule '117', c_quoted_quote => sub {
2086 0     0   0 my ($self) = @_;
2087 0         0 debug_rule("c_quoted_quote") if DEBUG;
2088 0         0 $self->all(
2089             $self->chr("'"),
2090             $self->chr("'")
2091             );
2092             };
2093              
2094              
2095              
2096             # [118]
2097             # nb-single-char ::=
2098             # c-quoted-quote | ( nb-json - ''' )
2099              
2100             rule '118', nb_single_char => sub {
2101 0     0   0 my ($self) = @_;
2102 0         0 debug_rule("nb_single_char") if DEBUG;
2103 0         0 $self->any(
2104             $self->func('c_quoted_quote'),
2105             $self->but(
2106             $self->func('nb_json'),
2107             $self->chr("'")
2108             )
2109             );
2110             };
2111              
2112              
2113              
2114             # [119]
2115             # ns-single-char ::=
2116             # nb-single-char - s-white
2117              
2118             rule '119', ns_single_char => sub {
2119 0     0   0 my ($self) = @_;
2120 0         0 debug_rule("ns_single_char") if DEBUG;
2121 0         0 $self->but(
2122             $self->func('nb_single_char'),
2123             $self->func('s_white')
2124             );
2125             };
2126              
2127              
2128              
2129             # [120]
2130             # c-single-quoted(n,c) ::=
2131             # ''' nb-single-text(n,c)
2132             # '''
2133              
2134             rule '120', c_single_quoted => sub {
2135 10     10   27 my ($self, $n, $c) = @_;
2136 10         16 debug_rule("c_single_quoted",$n,$c) if DEBUG;
2137 10         28 $self->all(
2138             $self->chr("'"),
2139             [ $self->func('nb_single_text'), $n, $c ],
2140             $self->chr("'")
2141             );
2142             };
2143              
2144              
2145              
2146             # [121]
2147             # nb-single-text(n,c) ::=
2148             # ( c = flow-out => nb-single-multi-line(n) )
2149             # ( c = flow-in => nb-single-multi-line(n) )
2150             # ( c = block-key => nb-single-one-line )
2151             # ( c = flow-key => nb-single-one-line )
2152              
2153             rule '121', nb_single_text => sub {
2154 0     0   0 my ($self, $n, $c) = @_;
2155 0         0 debug_rule("nb_single_text",$n,$c) if DEBUG;
2156 0         0 $self->case(
2157             $c,
2158             {
2159             'block-key' => $self->func('nb_single_one_line'),
2160             'flow-in' => [ $self->func('nb_single_multi_line'), $n ],
2161             'flow-key' => $self->func('nb_single_one_line'),
2162             'flow-out' => [ $self->func('nb_single_multi_line'), $n ],
2163             }
2164             );
2165             };
2166              
2167              
2168              
2169             # [122]
2170             # nb-single-one-line ::=
2171             # nb-single-char*
2172              
2173             rule '122', nb_single_one_line => sub {
2174 0     0   0 my ($self) = @_;
2175 0         0 debug_rule("nb_single_one_line") if DEBUG;
2176 0         0 $self->rep(0, undef, $self->func('nb_single_char'));
2177             };
2178              
2179              
2180              
2181             # [123]
2182             # nb-ns-single-in-line ::=
2183             # ( s-white* ns-single-char )*
2184              
2185             rule '123', nb_ns_single_in_line => sub {
2186 0     0   0 my ($self) = @_;
2187 0         0 debug_rule("nb_ns_single_in_line") if DEBUG;
2188 0         0 $self->rep(0, undef,
2189             $self->all(
2190             $self->rep(0, undef, $self->func('s_white')),
2191             $self->func('ns_single_char')
2192             ));
2193             };
2194              
2195              
2196              
2197             # [124]
2198             # s-single-next-line(n) ::=
2199             # s-flow-folded(n)
2200             # ( ns-single-char nb-ns-single-in-line
2201             # ( s-single-next-line(n) | s-white* ) )?
2202              
2203             rule '124', s_single_next_line => sub {
2204 0     0   0 my ($self, $n) = @_;
2205 0         0 debug_rule("s_single_next_line",$n) if DEBUG;
2206 0         0 $self->all(
2207             [ $self->func('s_flow_folded'), $n ],
2208             $self->rep(0, 1,
2209             $self->all(
2210             $self->func('ns_single_char'),
2211             $self->func('nb_ns_single_in_line'),
2212             $self->any(
2213             [ $self->func('s_single_next_line'), $n ],
2214             $self->rep(0, undef, $self->func('s_white'))
2215             )
2216             ))
2217             );
2218             };
2219              
2220              
2221              
2222             # [125]
2223             # nb-single-multi-line(n) ::=
2224             # nb-ns-single-in-line
2225             # ( s-single-next-line(n) | s-white* )
2226              
2227             rule '125', nb_single_multi_line => sub {
2228 0     0   0 my ($self, $n) = @_;
2229 0         0 debug_rule("nb_single_multi_line",$n) if DEBUG;
2230 0         0 $self->all(
2231             $self->func('nb_ns_single_in_line'),
2232             $self->any(
2233             [ $self->func('s_single_next_line'), $n ],
2234             $self->rep(0, undef, $self->func('s_white'))
2235             )
2236             );
2237             };
2238              
2239              
2240              
2241             # [126]
2242             # ns-plain-first(c) ::=
2243             # ( ns-char - c-indicator )
2244             # | ( ( '?' | ':' | '-' )
2245             # )
2246              
2247             rule '126', ns_plain_first => sub {
2248 16     16   38 my ($self, $c) = @_;
2249 16         24 debug_rule("ns_plain_first",$c) if DEBUG;
2250 16         36 $self->any(
2251             $self->but(
2252             $self->func('ns_char'),
2253             $self->func('c_indicator')
2254             ),
2255             $self->all(
2256             $self->any(
2257             $self->chr('?'),
2258             $self->chr(':'),
2259             $self->chr('-')
2260             ),
2261             $self->chk('=', [ $self->func('ns_plain_safe'), $c ])
2262             )
2263             );
2264             };
2265              
2266              
2267              
2268             # [127]
2269             # ns-plain-safe(c) ::=
2270             # ( c = flow-out => ns-plain-safe-out )
2271             # ( c = flow-in => ns-plain-safe-in )
2272             # ( c = block-key => ns-plain-safe-out )
2273             # ( c = flow-key => ns-plain-safe-in )
2274              
2275             rule '127', ns_plain_safe => sub {
2276 24     24   55 my ($self, $c) = @_;
2277 24         31 debug_rule("ns_plain_safe",$c) if DEBUG;
2278 24         59 $self->case(
2279             $c,
2280             {
2281             'block-key' => $self->func('ns_plain_safe_out'),
2282             'flow-in' => $self->func('ns_plain_safe_in'),
2283             'flow-key' => $self->func('ns_plain_safe_in'),
2284             'flow-out' => $self->func('ns_plain_safe_out'),
2285             }
2286             );
2287             };
2288              
2289              
2290              
2291             # [128]
2292             # ns-plain-safe-out ::=
2293             # ns-char
2294              
2295             rule '128', ns_plain_safe_out => sub {
2296 16     16   34 my ($self) = @_;
2297 16         22 debug_rule("ns_plain_safe_out") if DEBUG;
2298 16         32 $self->func('ns_char');
2299             };
2300              
2301              
2302              
2303             # [129]
2304             # ns-plain-safe-in ::=
2305             # ns-char - c-flow-indicator
2306              
2307             rule '129', ns_plain_safe_in => sub {
2308 8     8   25 my ($self) = @_;
2309 8         12 debug_rule("ns_plain_safe_in") if DEBUG;
2310 8         23 $self->but(
2311             $self->func('ns_char'),
2312             $self->func('c_flow_indicator')
2313             );
2314             };
2315              
2316              
2317              
2318             # [130]
2319             # ns-plain-char(c) ::=
2320             # ( ns-plain-safe(c) - ':' - '#' )
2321             # | ( '#' )
2322             # | ( ':' )
2323              
2324             rule '130', ns_plain_char => sub {
2325 20     20   61 my ($self, $c) = @_;
2326 20         28 debug_rule("ns_plain_char",$c) if DEBUG;
2327 20         52 $self->any(
2328             $self->but(
2329             [ $self->func('ns_plain_safe'), $c ],
2330             $self->chr(':'),
2331             $self->chr('#')
2332             ),
2333             $self->all(
2334             $self->chk('<=', $self->func('ns_char')),
2335             $self->chr('#')
2336             ),
2337             $self->all(
2338             $self->chr(':'),
2339             $self->chk('=', [ $self->func('ns_plain_safe'), $c ])
2340             )
2341             );
2342             };
2343              
2344              
2345              
2346             # [131]
2347             # ns-plain(n,c) ::=
2348             # ( c = flow-out => ns-plain-multi-line(n,c) )
2349             # ( c = flow-in => ns-plain-multi-line(n,c) )
2350             # ( c = block-key => ns-plain-one-line(c) )
2351             # ( c = flow-key => ns-plain-one-line(c) )
2352              
2353             rule '131', ns_plain => sub {
2354 16     16   36 my ($self, $n, $c) = @_;
2355 16         31 debug_rule("ns_plain",$n,$c) if DEBUG;
2356 16         42 $self->case(
2357             $c,
2358             {
2359             'block-key' => [ $self->func('ns_plain_one_line'), $c ],
2360             'flow-in' => [ $self->func('ns_plain_multi_line'), $n, $c ],
2361             'flow-key' => [ $self->func('ns_plain_one_line'), $c ],
2362             'flow-out' => [ $self->func('ns_plain_multi_line'), $n, $c ],
2363             }
2364             );
2365             };
2366              
2367              
2368              
2369             # [132]
2370             # nb-ns-plain-in-line(c) ::=
2371             # ( s-white*
2372             # ns-plain-char(c) )*
2373              
2374             rule '132', nb_ns_plain_in_line => sub {
2375 12     12   27 my ($self, $c) = @_;
2376 12         22 debug_rule("nb_ns_plain_in_line",$c) if DEBUG;
2377 12         53 $self->rep(0, undef,
2378             $self->all(
2379             $self->rep(0, undef, $self->func('s_white')),
2380             [ $self->func('ns_plain_char'), $c ]
2381             ));
2382             };
2383              
2384              
2385              
2386             # [133]
2387             # ns-plain-one-line(c) ::=
2388             # ns-plain-first(c)
2389             # nb-ns-plain-in-line(c)
2390              
2391             rule '133', ns_plain_one_line => sub {
2392 16     16   40 my ($self, $c) = @_;
2393 16         21 debug_rule("ns_plain_one_line",$c) if DEBUG;
2394 16         44 $self->all(
2395             [ $self->func('ns_plain_first'), $c ],
2396             [ $self->func('nb_ns_plain_in_line'), $c ]
2397             );
2398             };
2399              
2400              
2401              
2402             # [134]
2403             # s-ns-plain-next-line(n,c) ::=
2404             # s-flow-folded(n)
2405             # ns-plain-char(c) nb-ns-plain-in-line(c)
2406              
2407             rule '134', s_ns_plain_next_line => sub {
2408 4     4   18 my ($self, $n, $c) = @_;
2409 4         6 debug_rule("s_ns_plain_next_line",$n,$c) if DEBUG;
2410 4         13 $self->all(
2411             [ $self->func('s_flow_folded'), $n ],
2412             [ $self->func('ns_plain_char'), $c ],
2413             [ $self->func('nb_ns_plain_in_line'), $c ]
2414             );
2415             };
2416              
2417              
2418              
2419             # [135]
2420             # ns-plain-multi-line(n,c) ::=
2421             # ns-plain-one-line(c)
2422             # s-ns-plain-next-line(n,c)*
2423              
2424             rule '135', ns_plain_multi_line => sub {
2425 6     6   18 my ($self, $n, $c) = @_;
2426 6         12 debug_rule("ns_plain_multi_line",$n,$c) if DEBUG;
2427 6         16 $self->all(
2428             [ $self->func('ns_plain_one_line'), $c ],
2429             $self->rep(0, undef, [ $self->func('s_ns_plain_next_line'), $n, $c ])
2430             );
2431             };
2432              
2433              
2434              
2435             # [136]
2436             # in-flow(c) ::=
2437             # ( c = flow-out => flow-in )
2438             # ( c = flow-in => flow-in )
2439             # ( c = block-key => flow-key )
2440             # ( c = flow-key => flow-key )
2441              
2442             rule '136', in_flow => sub {
2443 2     2   7 my ($self, $c) = @_;
2444 2         4 debug_rule("in_flow",$c) if DEBUG;
2445 2         16 $self->flip(
2446             $c,
2447             {
2448             'block-key' => "flow-key",
2449             'flow-in' => "flow-in",
2450             'flow-key' => "flow-key",
2451             'flow-out' => "flow-in",
2452             }
2453             );
2454             };
2455              
2456              
2457              
2458             # [137]
2459             # c-flow-sequence(n,c) ::=
2460             # '[' s-separate(n,c)?
2461             # ns-s-flow-seq-entries(n,in-flow(c))? ']'
2462              
2463             rule '137', c_flow_sequence => sub {
2464 12     12   33 my ($self, $n, $c) = @_;
2465 12         17 debug_rule("c_flow_sequence",$n,$c) if DEBUG;
2466 12         34 $self->all(
2467             $self->chr('['),
2468             $self->rep(0, 1, [ $self->func('s_separate'), $n, $c ]),
2469             $self->rep2(0, 1, [ $self->func('ns_s_flow_seq_entries'), $n, [ $self->func('in_flow'), $c ] ]),
2470             $self->chr(']')
2471             );
2472             };
2473              
2474              
2475              
2476             # [138]
2477             # ns-s-flow-seq-entries(n,c) ::=
2478             # ns-flow-seq-entry(n,c)
2479             # s-separate(n,c)?
2480             # ( ',' s-separate(n,c)?
2481             # ns-s-flow-seq-entries(n,c)? )?
2482              
2483             rule '138', ns_s_flow_seq_entries => sub {
2484 4     4   23 my ($self, $n, $c) = @_;
2485 4         7 debug_rule("ns_s_flow_seq_entries",$n,$c) if DEBUG;
2486 4         12 $self->all(
2487             [ $self->func('ns_flow_seq_entry'), $n, $c ],
2488             $self->rep(0, 1, [ $self->func('s_separate'), $n, $c ]),
2489             $self->rep2(0, 1,
2490             $self->all(
2491             $self->chr(','),
2492             $self->rep(0, 1, [ $self->func('s_separate'), $n, $c ]),
2493             $self->rep2(0, 1, [ $self->func('ns_s_flow_seq_entries'), $n, $c ])
2494             ))
2495             );
2496             };
2497              
2498              
2499              
2500             # [139]
2501             # ns-flow-seq-entry(n,c) ::=
2502             # ns-flow-pair(n,c) | ns-flow-node(n,c)
2503              
2504             rule '139', ns_flow_seq_entry => sub {
2505 4     4   10 my ($self, $n, $c) = @_;
2506 4         7 debug_rule("ns_flow_seq_entry",$n,$c) if DEBUG;
2507 4         10 $self->any(
2508             [ $self->func('ns_flow_pair'), $n, $c ],
2509             [ $self->func('ns_flow_node'), $n, $c ]
2510             );
2511             };
2512              
2513              
2514              
2515             # [140]
2516             # c-flow-mapping(n,c) ::=
2517             # '{' s-separate(n,c)?
2518             # ns-s-flow-map-entries(n,in-flow(c))? '}'
2519              
2520             rule '140', c_flow_mapping => sub {
2521 10     10   26 my ($self, $n, $c) = @_;
2522 10         16 debug_rule("c_flow_mapping",$n,$c) if DEBUG;
2523 10         25 $self->all(
2524             $self->chr('{'),
2525             $self->rep(0, 1, [ $self->func('s_separate'), $n, $c ]),
2526             $self->rep2(0, 1, [ $self->func('ns_s_flow_map_entries'), $n, [ $self->func('in_flow'), $c ] ]),
2527             $self->chr('}')
2528             );
2529             };
2530              
2531              
2532              
2533             # [141]
2534             # ns-s-flow-map-entries(n,c) ::=
2535             # ns-flow-map-entry(n,c)
2536             # s-separate(n,c)?
2537             # ( ',' s-separate(n,c)?
2538             # ns-s-flow-map-entries(n,c)? )?
2539              
2540             rule '141', ns_s_flow_map_entries => sub {
2541 0     0   0 my ($self, $n, $c) = @_;
2542 0         0 debug_rule("ns_s_flow_map_entries",$n,$c) if DEBUG;
2543 0         0 $self->all(
2544             [ $self->func('ns_flow_map_entry'), $n, $c ],
2545             $self->rep(0, 1, [ $self->func('s_separate'), $n, $c ]),
2546             $self->rep2(0, 1,
2547             $self->all(
2548             $self->chr(','),
2549             $self->rep(0, 1, [ $self->func('s_separate'), $n, $c ]),
2550             $self->rep2(0, 1, [ $self->func('ns_s_flow_map_entries'), $n, $c ])
2551             ))
2552             );
2553             };
2554              
2555              
2556              
2557             # [142]
2558             # ns-flow-map-entry(n,c) ::=
2559             # ( '?' s-separate(n,c)
2560             # ns-flow-map-explicit-entry(n,c) )
2561             # | ns-flow-map-implicit-entry(n,c)
2562              
2563             rule '142', ns_flow_map_entry => sub {
2564 0     0   0 my ($self, $n, $c) = @_;
2565 0         0 debug_rule("ns_flow_map_entry",$n,$c) if DEBUG;
2566 0         0 $self->any(
2567             $self->all(
2568             $self->chr('?'),
2569             $self->chk(
2570             '=',
2571             $self->any(
2572             $self->func('end_of_stream'),
2573             $self->func('s_white'),
2574             $self->func('b_break')
2575             )
2576             ),
2577             [ $self->func('s_separate'), $n, $c ],
2578             [ $self->func('ns_flow_map_explicit_entry'), $n, $c ]
2579             ),
2580             [ $self->func('ns_flow_map_implicit_entry'), $n, $c ]
2581             );
2582             };
2583              
2584              
2585              
2586             # [143]
2587             # ns-flow-map-explicit-entry(n,c) ::=
2588             # ns-flow-map-implicit-entry(n,c)
2589             # | ( e-node
2590             # e-node )
2591              
2592             rule '143', ns_flow_map_explicit_entry => sub {
2593 0     0   0 my ($self, $n, $c) = @_;
2594 0         0 debug_rule("ns_flow_map_explicit_entry",$n,$c) if DEBUG;
2595 0         0 $self->any(
2596             [ $self->func('ns_flow_map_implicit_entry'), $n, $c ],
2597             $self->all(
2598             $self->func('e_node'),
2599             $self->func('e_node')
2600             )
2601             );
2602             };
2603              
2604              
2605              
2606             # [144]
2607             # ns-flow-map-implicit-entry(n,c) ::=
2608             # ns-flow-map-yaml-key-entry(n,c)
2609             # | c-ns-flow-map-empty-key-entry(n,c)
2610             # | c-ns-flow-map-json-key-entry(n,c)
2611              
2612             rule '144', ns_flow_map_implicit_entry => sub {
2613 0     0   0 my ($self, $n, $c) = @_;
2614 0         0 debug_rule("ns_flow_map_implicit_entry",$n,$c) if DEBUG;
2615 0         0 $self->any(
2616             [ $self->func('ns_flow_map_yaml_key_entry'), $n, $c ],
2617             [ $self->func('c_ns_flow_map_empty_key_entry'), $n, $c ],
2618             [ $self->func('c_ns_flow_map_json_key_entry'), $n, $c ]
2619             );
2620             };
2621              
2622              
2623              
2624             # [145]
2625             # ns-flow-map-yaml-key-entry(n,c) ::=
2626             # ns-flow-yaml-node(n,c)
2627             # ( ( s-separate(n,c)?
2628             # c-ns-flow-map-separate-value(n,c) )
2629             # | e-node )
2630              
2631             rule '145', ns_flow_map_yaml_key_entry => sub {
2632 0     0   0 my ($self, $n, $c) = @_;
2633 0         0 debug_rule("ns_flow_map_yaml_key_entry",$n,$c) if DEBUG;
2634 0         0 $self->all(
2635             [ $self->func('ns_flow_yaml_node'), $n, $c ],
2636             $self->any(
2637             $self->all(
2638             $self->rep(0, 1, [ $self->func('s_separate'), $n, $c ]),
2639             [ $self->func('c_ns_flow_map_separate_value'), $n, $c ]
2640             ),
2641             $self->func('e_node')
2642             )
2643             );
2644             };
2645              
2646              
2647              
2648             # [146]
2649             # c-ns-flow-map-empty-key-entry(n,c) ::=
2650             # e-node
2651             # c-ns-flow-map-separate-value(n,c)
2652              
2653             rule '146', c_ns_flow_map_empty_key_entry => sub {
2654 4     4   10 my ($self, $n, $c) = @_;
2655 4         7 debug_rule("c_ns_flow_map_empty_key_entry",$n,$c) if DEBUG;
2656 4         12 $self->all(
2657             $self->func('e_node'),
2658             [ $self->func('c_ns_flow_map_separate_value'), $n, $c ]
2659             );
2660             };
2661              
2662              
2663              
2664             # [147]
2665             # c-ns-flow-map-separate-value(n,c) ::=
2666             # ':'
2667             # ( ( s-separate(n,c) ns-flow-node(n,c) )
2668             # | e-node )
2669              
2670             rule '147', c_ns_flow_map_separate_value => sub {
2671 8     8   19 my ($self, $n, $c) = @_;
2672 8         13 debug_rule("c_ns_flow_map_separate_value",$n,$c) if DEBUG;
2673 8         21 $self->all(
2674             $self->chr(':'),
2675             $self->chk('!', [ $self->func('ns_plain_safe'), $c ]),
2676             $self->any(
2677             $self->all(
2678             [ $self->func('s_separate'), $n, $c ],
2679             [ $self->func('ns_flow_node'), $n, $c ]
2680             ),
2681             $self->func('e_node')
2682             )
2683             );
2684             };
2685              
2686              
2687              
2688             # [148]
2689             # c-ns-flow-map-json-key-entry(n,c) ::=
2690             # c-flow-json-node(n,c)
2691             # ( ( s-separate(n,c)?
2692             # c-ns-flow-map-adjacent-value(n,c) )
2693             # | e-node )
2694              
2695             rule '148', c_ns_flow_map_json_key_entry => sub {
2696 0     0   0 my ($self, $n, $c) = @_;
2697 0         0 debug_rule("c_ns_flow_map_json_key_entry",$n,$c) if DEBUG;
2698 0         0 $self->all(
2699             [ $self->func('c_flow_json_node'), $n, $c ],
2700             $self->any(
2701             $self->all(
2702             $self->rep(0, 1, [ $self->func('s_separate'), $n, $c ]),
2703             [ $self->func('c_ns_flow_map_adjacent_value'), $n, $c ]
2704             ),
2705             $self->func('e_node')
2706             )
2707             );
2708             };
2709              
2710              
2711              
2712             # [149]
2713             # c-ns-flow-map-adjacent-value(n,c) ::=
2714             # ':' ( (
2715             # s-separate(n,c)?
2716             # ns-flow-node(n,c) )
2717             # | e-node )
2718              
2719             rule '149', c_ns_flow_map_adjacent_value => sub {
2720 0     0   0 my ($self, $n, $c) = @_;
2721 0         0 debug_rule("c_ns_flow_map_adjacent_value",$n,$c) if DEBUG;
2722 0         0 $self->all(
2723             $self->chr(':'),
2724             $self->any(
2725             $self->all(
2726             $self->rep(0, 1, [ $self->func('s_separate'), $n, $c ]),
2727             [ $self->func('ns_flow_node'), $n, $c ]
2728             ),
2729             $self->func('e_node')
2730             )
2731             );
2732             };
2733              
2734              
2735              
2736             # [150]
2737             # ns-flow-pair(n,c) ::=
2738             # ( '?' s-separate(n,c)
2739             # ns-flow-map-explicit-entry(n,c) )
2740             # | ns-flow-pair-entry(n,c)
2741              
2742             rule '150', ns_flow_pair => sub {
2743 4     4   12 my ($self, $n, $c) = @_;
2744 4         8 debug_rule("ns_flow_pair",$n,$c) if DEBUG;
2745 4         15 $self->any(
2746             $self->all(
2747             $self->chr('?'),
2748             $self->chk(
2749             '=',
2750             $self->any(
2751             $self->func('end_of_stream'),
2752             $self->func('s_white'),
2753             $self->func('b_break')
2754             )
2755             ),
2756             [ $self->func('s_separate'), $n, $c ],
2757             [ $self->func('ns_flow_map_explicit_entry'), $n, $c ]
2758             ),
2759             [ $self->func('ns_flow_pair_entry'), $n, $c ]
2760             );
2761             };
2762              
2763              
2764              
2765             # [151]
2766             # ns-flow-pair-entry(n,c) ::=
2767             # ns-flow-pair-yaml-key-entry(n,c)
2768             # | c-ns-flow-map-empty-key-entry(n,c)
2769             # | c-ns-flow-pair-json-key-entry(n,c)
2770              
2771             rule '151', ns_flow_pair_entry => sub {
2772 4     4   13 my ($self, $n, $c) = @_;
2773 4         5 debug_rule("ns_flow_pair_entry",$n,$c) if DEBUG;
2774 4         12 $self->any(
2775             [ $self->func('ns_flow_pair_yaml_key_entry'), $n, $c ],
2776             [ $self->func('c_ns_flow_map_empty_key_entry'), $n, $c ],
2777             [ $self->func('c_ns_flow_pair_json_key_entry'), $n, $c ]
2778             );
2779             };
2780              
2781              
2782              
2783             # [152]
2784             # ns-flow-pair-yaml-key-entry(n,c) ::=
2785             # ns-s-implicit-yaml-key(flow-key)
2786             # c-ns-flow-map-separate-value(n,c)
2787              
2788             rule '152', ns_flow_pair_yaml_key_entry => sub {
2789 4     4   13 my ($self, $n, $c) = @_;
2790 4         6 debug_rule("ns_flow_pair_yaml_key_entry",$n,$c) if DEBUG;
2791 4         100 $self->all(
2792             [ $self->func('ns_s_implicit_yaml_key'), "flow-key" ],
2793             [ $self->func('c_ns_flow_map_separate_value'), $n, $c ]
2794             );
2795             };
2796              
2797              
2798              
2799             # [153]
2800             # c-ns-flow-pair-json-key-entry(n,c) ::=
2801             # c-s-implicit-json-key(flow-key)
2802             # c-ns-flow-map-adjacent-value(n,c)
2803              
2804             rule '153', c_ns_flow_pair_json_key_entry => sub {
2805 4     4   11 my ($self, $n, $c) = @_;
2806 4         6 debug_rule("c_ns_flow_pair_json_key_entry",$n,$c) if DEBUG;
2807 4         13 $self->all(
2808             [ $self->func('c_s_implicit_json_key'), "flow-key" ],
2809             [ $self->func('c_ns_flow_map_adjacent_value'), $n, $c ]
2810             );
2811             };
2812              
2813              
2814              
2815             # [154]
2816             # ns-s-implicit-yaml-key(c) ::=
2817             # ns-flow-yaml-node(n/a,c)
2818             # s-separate-in-line?
2819             #
2820              
2821             rule '154', ns_s_implicit_yaml_key => sub {
2822 10     10   29 my ($self, $c) = @_;
2823 10         14 debug_rule("ns_s_implicit_yaml_key",$c) if DEBUG;
2824 10         27 $self->all(
2825             $self->max(1024),
2826             [ $self->func('ns_flow_yaml_node'), undef, $c ],
2827             $self->rep(0, 1, $self->func('s_separate_in_line'))
2828             );
2829             };
2830              
2831              
2832              
2833             # [155]
2834             # c-s-implicit-json-key(c) ::=
2835             # c-flow-json-node(n/a,c)
2836             # s-separate-in-line?
2837             #
2838              
2839             rule '155', c_s_implicit_json_key => sub {
2840 10     10   29 my ($self, $c) = @_;
2841 10         10 debug_rule("c_s_implicit_json_key",$c) if DEBUG;
2842 10         35 $self->all(
2843             $self->max(1024),
2844             [ $self->func('c_flow_json_node'), undef, $c ],
2845             $self->rep(0, 1, $self->func('s_separate_in_line'))
2846             );
2847             };
2848              
2849              
2850              
2851             # [156]
2852             # ns-flow-yaml-content(n,c) ::=
2853             # ns-plain(n,c)
2854              
2855             rule '156', ns_flow_yaml_content => sub {
2856 16     16   37 my ($self, $n, $c) = @_;
2857 16         25 debug_rule("ns_flow_yaml_content",$n,$c) if DEBUG;
2858 16         39 [ $self->func('ns_plain'), $n, $c ];
2859             };
2860              
2861              
2862              
2863             # [157]
2864             # c-flow-json-content(n,c) ::=
2865             # c-flow-sequence(n,c) | c-flow-mapping(n,c)
2866             # | c-single-quoted(n,c) | c-double-quoted(n,c)
2867              
2868             rule '157', c_flow_json_content => sub {
2869 12     12   51 my ($self, $n, $c) = @_;
2870 12         18 debug_rule("c_flow_json_content",$n,$c) if DEBUG;
2871 12         44 $self->any(
2872             [ $self->func('c_flow_sequence'), $n, $c ],
2873             [ $self->func('c_flow_mapping'), $n, $c ],
2874             [ $self->func('c_single_quoted'), $n, $c ],
2875             [ $self->func('c_double_quoted'), $n, $c ]
2876             );
2877             };
2878              
2879              
2880              
2881             # [158]
2882             # ns-flow-content(n,c) ::=
2883             # ns-flow-yaml-content(n,c) | c-flow-json-content(n,c)
2884              
2885             rule '158', ns_flow_content => sub {
2886 6     6   19 my ($self, $n, $c) = @_;
2887 6         12 debug_rule("ns_flow_content",$n,$c) if DEBUG;
2888 6         17 $self->any(
2889             [ $self->func('ns_flow_yaml_content'), $n, $c ],
2890             [ $self->func('c_flow_json_content'), $n, $c ]
2891             );
2892             };
2893              
2894              
2895              
2896             # [159]
2897             # ns-flow-yaml-node(n,c) ::=
2898             # c-ns-alias-node
2899             # | ns-flow-yaml-content(n,c)
2900             # | ( c-ns-properties(n,c)
2901             # ( ( s-separate(n,c)
2902             # ns-flow-yaml-content(n,c) )
2903             # | e-scalar ) )
2904              
2905             rule '159', ns_flow_yaml_node => sub {
2906 10     10   32 my ($self, $n, $c) = @_;
2907 10         16 debug_rule("ns_flow_yaml_node",$n,$c) if DEBUG;
2908 10         30 $self->any(
2909             $self->func('c_ns_alias_node'),
2910             [ $self->func('ns_flow_yaml_content'), $n, $c ],
2911             $self->all(
2912             [ $self->func('c_ns_properties'), $n, $c ],
2913             $self->any(
2914             $self->all(
2915             [ $self->func('s_separate'), $n, $c ],
2916             [ $self->func('ns_flow_content'), $n, $c ]
2917             ),
2918             $self->func('e_scalar')
2919             )
2920             )
2921             );
2922             };
2923              
2924              
2925              
2926             # [160]
2927             # c-flow-json-node(n,c) ::=
2928             # ( c-ns-properties(n,c)
2929             # s-separate(n,c) )?
2930             # c-flow-json-content(n,c)
2931              
2932             rule '160', c_flow_json_node => sub {
2933 10     10   30 my ($self, $n, $c) = @_;
2934 10         13 debug_rule("c_flow_json_node",$n,$c) if DEBUG;
2935 10         37 $self->all(
2936             $self->rep(0, 1,
2937             $self->all(
2938             [ $self->func('c_ns_properties'), $n, $c ],
2939             [ $self->func('s_separate'), $n, $c ]
2940             )),
2941             [ $self->func('c_flow_json_content'), $n, $c ]
2942             );
2943             };
2944              
2945              
2946              
2947             # [161]
2948             # ns-flow-node(n,c) ::=
2949             # c-ns-alias-node
2950             # | ns-flow-content(n,c)
2951             # | ( c-ns-properties(n,c)
2952             # ( ( s-separate(n,c)
2953             # ns-flow-content(n,c) )
2954             # | e-scalar ) )
2955              
2956             rule '161', ns_flow_node => sub {
2957 6     6   29 my ($self, $n, $c) = @_;
2958 6         9 debug_rule("ns_flow_node",$n,$c) if DEBUG;
2959 6         21 $self->any(
2960             $self->func('c_ns_alias_node'),
2961             [ $self->func('ns_flow_content'), $n, $c ],
2962             $self->all(
2963             [ $self->func('c_ns_properties'), $n, $c ],
2964             $self->any(
2965             $self->all(
2966             [ $self->func('s_separate'), $n, $c ],
2967             [ $self->func('ns_flow_content'), $n, $c ]
2968             ),
2969             $self->func('e_scalar')
2970             )
2971             )
2972             );
2973             };
2974              
2975              
2976              
2977             # [162]
2978             # c-b-block-header(m,t) ::=
2979             # ( ( c-indentation-indicator(m)
2980             # c-chomping-indicator(t) )
2981             # | ( c-chomping-indicator(t)
2982             # c-indentation-indicator(m) ) )
2983             # s-b-comment
2984              
2985             rule '162', c_b_block_header => sub {
2986 2     2   8 my ($self, $n) = @_;
2987 2         4 debug_rule("c_b_block_header",$n) if DEBUG;
2988 2         8 $self->all(
2989             $self->any(
2990             $self->all(
2991             [ $self->func('c_indentation_indicator'), $n ],
2992             $self->func('c_chomping_indicator'),
2993             $self->chk(
2994             '=',
2995             $self->any(
2996             $self->func('end_of_stream'),
2997             $self->func('s_white'),
2998             $self->func('b_break')
2999             )
3000             )
3001             ),
3002             $self->all(
3003             $self->func('c_chomping_indicator'),
3004             [ $self->func('c_indentation_indicator'), $n ],
3005             $self->chk(
3006             '=',
3007             $self->any(
3008             $self->func('end_of_stream'),
3009             $self->func('s_white'),
3010             $self->func('b_break')
3011             )
3012             )
3013             )
3014             ),
3015             $self->func('s_b_comment')
3016             );
3017             };
3018              
3019              
3020              
3021             # [163]
3022             # c-indentation-indicator(m) ::=
3023             # ( ns-dec-digit => m = ns-dec-digit - x:30 )
3024             # ( => m = auto-detect() )
3025              
3026             rule '163', c_indentation_indicator => sub {
3027 2     2   7 my ($self, $n) = @_;
3028 2         3 debug_rule("c_indentation_indicator",$n) if DEBUG;
3029 2         40 $self->any(
3030             $self->if($self->rng("\x{31}", "\x{39}"), $self->set('m', $self->ord($self->func('match')))),
3031             $self->if($self->func('empty'), $self->set('m', [ $self->func('auto_detect'), $n ]))
3032             );
3033             };
3034              
3035              
3036              
3037             # [164]
3038             # c-chomping-indicator(t) ::=
3039             # ( '-' => t = strip )
3040             # ( '+' => t = keep )
3041             # ( => t = clip )
3042              
3043             rule '164', c_chomping_indicator => sub {
3044 2     2   8 my ($self) = @_;
3045 2         4 debug_rule("c_chomping_indicator") if DEBUG;
3046 2         10 $self->any(
3047             $self->if($self->chr('-'), $self->set('t', "strip")),
3048             $self->if($self->chr('+'), $self->set('t', "keep")),
3049             $self->if($self->func('empty'), $self->set('t', "clip"))
3050             );
3051             };
3052              
3053              
3054              
3055             # [165]
3056             # b-chomped-last(t) ::=
3057             # ( t = strip => b-non-content | )
3058             # ( t = clip => b-as-line-feed | )
3059             # ( t = keep => b-as-line-feed | )
3060              
3061             rule '165', b_chomped_last => sub {
3062 2     2   9 my ($self, $t) = @_;
3063 2         4 debug_rule("b_chomped_last",$t) if DEBUG;
3064 2         18 $self->case(
3065             $t,
3066             {
3067             'clip' => $self->any( $self->func('b_as_line_feed'), $self->func('end_of_stream') ),
3068             'keep' => $self->any( $self->func('b_as_line_feed'), $self->func('end_of_stream') ),
3069             'strip' => $self->any( $self->func('b_non_content'), $self->func('end_of_stream') ),
3070             }
3071             );
3072             };
3073              
3074              
3075              
3076             # [166]
3077             # l-chomped-empty(n,t) ::=
3078             # ( t = strip => l-strip-empty(n) )
3079             # ( t = clip => l-strip-empty(n) )
3080             # ( t = keep => l-keep-empty(n) )
3081              
3082             rule '166', l_chomped_empty => sub {
3083 2     2   6 my ($self, $n, $t) = @_;
3084 2         4 debug_rule("l_chomped_empty",$n,$t) if DEBUG;
3085 2         9 $self->case(
3086             $t,
3087             {
3088             'clip' => [ $self->func('l_strip_empty'), $n ],
3089             'keep' => [ $self->func('l_keep_empty'), $n ],
3090             'strip' => [ $self->func('l_strip_empty'), $n ],
3091             }
3092             );
3093             };
3094              
3095              
3096              
3097             # [167]
3098             # l-strip-empty(n) ::=
3099             # ( s-indent(<=n) b-non-content )*
3100             # l-trail-comments(n)?
3101              
3102             rule '167', l_strip_empty => sub {
3103 2     2   6 my ($self, $n) = @_;
3104 2         6 debug_rule("l_strip_empty",$n) if DEBUG;
3105 2         9 $self->all(
3106             $self->rep(0, undef,
3107             $self->all(
3108             [ $self->func('s_indent_le'), $n ],
3109             $self->func('b_non_content')
3110             )),
3111             $self->rep2(0, 1, [ $self->func('l_trail_comments'), $n ])
3112             );
3113             };
3114              
3115              
3116              
3117             # [168]
3118             # l-keep-empty(n) ::=
3119             # l-empty(n,block-in)*
3120             # l-trail-comments(n)?
3121              
3122             rule '168', l_keep_empty => sub {
3123 0     0   0 my ($self, $n) = @_;
3124 0         0 debug_rule("l_keep_empty",$n) if DEBUG;
3125 0         0 $self->all(
3126             $self->rep(0, undef, [ $self->func('l_empty'), $n, "block-in" ]),
3127             $self->rep2(0, 1, [ $self->func('l_trail_comments'), $n ])
3128             );
3129             };
3130              
3131              
3132              
3133             # [169]
3134             # l-trail-comments(n) ::=
3135             # s-indent(
3136             # c-nb-comment-text b-comment
3137             # l-comment*
3138              
3139             rule '169', l_trail_comments => sub {
3140 2     2   6 my ($self, $n) = @_;
3141 2         4 debug_rule("l_trail_comments",$n) if DEBUG;
3142 2         8 $self->all(
3143             [ $self->func('s_indent_lt'), $n ],
3144             $self->func('c_nb_comment_text'),
3145             $self->func('b_comment'),
3146             $self->rep(0, undef, $self->func('l_comment'))
3147             );
3148             };
3149              
3150              
3151              
3152             # [170]
3153             # c-l+literal(n) ::=
3154             # '|' c-b-block-header(m,t)
3155             # l-literal-content(n+m,t)
3156              
3157             rule '170', c_l_literal => sub {
3158 6     6   16 my ($self, $n) = @_;
3159 6         10 debug_rule("c_l_literal",$n) if DEBUG;
3160 6         21 $self->all(
3161             $self->chr('|'),
3162             [ $self->func('c_b_block_header'), $n ],
3163             [ $self->func('l_literal_content'), $self->add($n, $self->m()), $self->t() ]
3164             );
3165             };
3166              
3167              
3168              
3169             # [171]
3170             # l-nb-literal-text(n) ::=
3171             # l-empty(n,block-in)*
3172             # s-indent(n) nb-char+
3173              
3174             rule '171', l_nb_literal_text => sub {
3175 8     8   17 my ($self, $n) = @_;
3176 8         14 debug_rule("l_nb_literal_text",$n) if DEBUG;
3177 8         25 $self->all(
3178             $self->rep(0, undef, [ $self->func('l_empty'), $n, "block-in" ]),
3179             [ $self->func('s_indent'), $n ],
3180             $self->rep2(1, undef, $self->func('nb_char'))
3181             );
3182             };
3183              
3184              
3185              
3186             # [172]
3187             # b-nb-literal-next(n) ::=
3188             # b-as-line-feed
3189             # l-nb-literal-text(n)
3190              
3191             rule '172', b_nb_literal_next => sub {
3192 6     6   15 my ($self, $n) = @_;
3193 6         8 debug_rule("b_nb_literal_next",$n) if DEBUG;
3194 6         17 $self->all(
3195             $self->func('b_as_line_feed'),
3196             [ $self->func('l_nb_literal_text'), $n ]
3197             );
3198             };
3199              
3200              
3201              
3202             # [173]
3203             # l-literal-content(n,t) ::=
3204             # ( l-nb-literal-text(n)
3205             # b-nb-literal-next(n)*
3206             # b-chomped-last(t) )?
3207             # l-chomped-empty(n,t)
3208              
3209             rule '173', l_literal_content => sub {
3210 2     2   7 my ($self, $n, $t) = @_;
3211 2         6 debug_rule("l_literal_content",$n,$t) if DEBUG;
3212 2         12 $self->all(
3213             $self->rep(0, 1,
3214             $self->all(
3215             [ $self->func('l_nb_literal_text'), $n ],
3216             $self->rep(0, undef, [ $self->func('b_nb_literal_next'), $n ]),
3217             [ $self->func('b_chomped_last'), $t ]
3218             )),
3219             [ $self->func('l_chomped_empty'), $n, $t ]
3220             );
3221             };
3222              
3223              
3224              
3225             # [174]
3226             # c-l+folded(n) ::=
3227             # '>' c-b-block-header(m,t)
3228             # l-folded-content(n+m,t)
3229              
3230             rule '174', c_l_folded => sub {
3231 4     4   10 my ($self, $n) = @_;
3232 4         6 debug_rule("c_l_folded",$n) if DEBUG;
3233 4         10 $self->all(
3234             $self->chr('>'),
3235             [ $self->func('c_b_block_header'), $n ],
3236             [ $self->func('l_folded_content'), $self->add($n, $self->m()), $self->t() ]
3237             );
3238             };
3239              
3240              
3241              
3242             # [175]
3243             # s-nb-folded-text(n) ::=
3244             # s-indent(n) ns-char
3245             # nb-char*
3246              
3247             rule '175', s_nb_folded_text => sub {
3248 0     0   0 my ($self, $n) = @_;
3249 0         0 debug_rule("s_nb_folded_text",$n) if DEBUG;
3250 0         0 $self->all(
3251             [ $self->func('s_indent'), $n ],
3252             $self->func('ns_char'),
3253             $self->rep(0, undef, $self->func('nb_char'))
3254             );
3255             };
3256              
3257              
3258              
3259             # [176]
3260             # l-nb-folded-lines(n) ::=
3261             # s-nb-folded-text(n)
3262             # ( b-l-folded(n,block-in) s-nb-folded-text(n) )*
3263              
3264             rule '176', l_nb_folded_lines => sub {
3265 0     0   0 my ($self, $n) = @_;
3266 0         0 debug_rule("l_nb_folded_lines",$n) if DEBUG;
3267 0         0 $self->all(
3268             [ $self->func('s_nb_folded_text'), $n ],
3269             $self->rep(0, undef,
3270             $self->all(
3271             [ $self->func('b_l_folded'), $n, "block-in" ],
3272             [ $self->func('s_nb_folded_text'), $n ]
3273             ))
3274             );
3275             };
3276              
3277              
3278              
3279             # [177]
3280             # s-nb-spaced-text(n) ::=
3281             # s-indent(n) s-white
3282             # nb-char*
3283              
3284             rule '177', s_nb_spaced_text => sub {
3285 0     0   0 my ($self, $n) = @_;
3286 0         0 debug_rule("s_nb_spaced_text",$n) if DEBUG;
3287 0         0 $self->all(
3288             [ $self->func('s_indent'), $n ],
3289             $self->func('s_white'),
3290             $self->rep(0, undef, $self->func('nb_char'))
3291             );
3292             };
3293              
3294              
3295              
3296             # [178]
3297             # b-l-spaced(n) ::=
3298             # b-as-line-feed
3299             # l-empty(n,block-in)*
3300              
3301             rule '178', b_l_spaced => sub {
3302 0     0   0 my ($self, $n) = @_;
3303 0         0 debug_rule("b_l_spaced",$n) if DEBUG;
3304 0         0 $self->all(
3305             $self->func('b_as_line_feed'),
3306             $self->rep(0, undef, [ $self->func('l_empty'), $n, "block-in" ])
3307             );
3308             };
3309              
3310              
3311              
3312             # [179]
3313             # l-nb-spaced-lines(n) ::=
3314             # s-nb-spaced-text(n)
3315             # ( b-l-spaced(n) s-nb-spaced-text(n) )*
3316              
3317             rule '179', l_nb_spaced_lines => sub {
3318 0     0   0 my ($self, $n) = @_;
3319 0         0 debug_rule("l_nb_spaced_lines",$n) if DEBUG;
3320 0         0 $self->all(
3321             [ $self->func('s_nb_spaced_text'), $n ],
3322             $self->rep(0, undef,
3323             $self->all(
3324             [ $self->func('b_l_spaced'), $n ],
3325             [ $self->func('s_nb_spaced_text'), $n ]
3326             ))
3327             );
3328             };
3329              
3330              
3331              
3332             # [180]
3333             # l-nb-same-lines(n) ::=
3334             # l-empty(n,block-in)*
3335             # ( l-nb-folded-lines(n) | l-nb-spaced-lines(n) )
3336              
3337             rule '180', l_nb_same_lines => sub {
3338 0     0   0 my ($self, $n) = @_;
3339 0         0 debug_rule("l_nb_same_lines",$n) if DEBUG;
3340 0         0 $self->all(
3341             $self->rep(0, undef, [ $self->func('l_empty'), $n, "block-in" ]),
3342             $self->any(
3343             [ $self->func('l_nb_folded_lines'), $n ],
3344             [ $self->func('l_nb_spaced_lines'), $n ]
3345             )
3346             );
3347             };
3348              
3349              
3350              
3351             # [181]
3352             # l-nb-diff-lines(n) ::=
3353             # l-nb-same-lines(n)
3354             # ( b-as-line-feed l-nb-same-lines(n) )*
3355              
3356             rule '181', l_nb_diff_lines => sub {
3357 0     0   0 my ($self, $n) = @_;
3358 0         0 debug_rule("l_nb_diff_lines",$n) if DEBUG;
3359 0         0 $self->all(
3360             [ $self->func('l_nb_same_lines'), $n ],
3361             $self->rep(0, undef,
3362             $self->all(
3363             $self->func('b_as_line_feed'),
3364             [ $self->func('l_nb_same_lines'), $n ]
3365             ))
3366             );
3367             };
3368              
3369              
3370              
3371             # [182]
3372             # l-folded-content(n,t) ::=
3373             # ( l-nb-diff-lines(n)
3374             # b-chomped-last(t) )?
3375             # l-chomped-empty(n,t)
3376              
3377             rule '182', l_folded_content => sub {
3378 0     0   0 my ($self, $n, $t) = @_;
3379 0         0 debug_rule("l_folded_content",$n,$t) if DEBUG;
3380 0         0 $self->all(
3381             $self->rep(0, 1,
3382             $self->all(
3383             [ $self->func('l_nb_diff_lines'), $n ],
3384             [ $self->func('b_chomped_last'), $t ]
3385             )),
3386             [ $self->func('l_chomped_empty'), $n, $t ]
3387             );
3388             };
3389              
3390              
3391              
3392             # [183]
3393             # l+block-sequence(n) ::=
3394             # ( s-indent(n+m)
3395             # c-l-block-seq-entry(n+m) )+
3396             # _0>
3397              
3398             rule '183', l_block_sequence => sub {
3399 2     2   6 my ($self, $n) = @_;
3400 2 50       7 my $m = $self->call([$self->func('auto_detect_indent'), $n], 'number') or return false;
3401 2         7 debug_rule("l_block_sequence",$n) if DEBUG;
3402 2         8 $self->all(
3403             $self->rep(1, undef,
3404             $self->all(
3405             [ $self->func('s_indent'), $self->add($n, $m) ],
3406             [ $self->func('c_l_block_seq_entry'), $self->add($n, $m) ]
3407             ))
3408             );
3409             };
3410              
3411              
3412              
3413             # [184]
3414             # c-l-block-seq-entry(n) ::=
3415             # '-'
3416             # s-l+block-indented(n,block-in)
3417              
3418             rule '184', c_l_block_seq_entry => sub {
3419 2     2   6 my ($self, $n) = @_;
3420 2         2 debug_rule("c_l_block_seq_entry",$n) if DEBUG;
3421 2         7 $self->all(
3422             $self->chr('-'),
3423             $self->chk('!', $self->func('ns_char')),
3424             [ $self->func('s_l_block_indented'), $n, "block-in" ]
3425             );
3426             };
3427              
3428              
3429              
3430             # [185]
3431             # s-l+block-indented(n,c) ::=
3432             # ( s-indent(m)
3433             # ( ns-l-compact-sequence(n+1+m)
3434             # | ns-l-compact-mapping(n+1+m) ) )
3435             # | s-l+block-node(n,c)
3436             # | ( e-node s-l-comments )
3437              
3438             rule '185', s_l_block_indented => sub {
3439 0     0   0 my ($self, $n, $c) = @_;
3440 0         0 my $m = $self->call([$self->func('auto_detect_indent'), $n], 'number');
3441 0         0 debug_rule("s_l_block_indented",$n,$c) if DEBUG;
3442 0         0 $self->any(
3443             $self->all(
3444             [ $self->func('s_indent'), $m ],
3445             $self->any(
3446             [ $self->func('ns_l_compact_sequence'), $self->add($n, $self->add(1, $m)) ],
3447             [ $self->func('ns_l_compact_mapping'), $self->add($n, $self->add(1, $m)) ]
3448             )
3449             ),
3450             [ $self->func('s_l_block_node'), $n, $c ],
3451             $self->all(
3452             $self->func('e_node'),
3453             $self->func('s_l_comments')
3454             )
3455             );
3456             };
3457              
3458              
3459              
3460             # [186]
3461             # ns-l-compact-sequence(n) ::=
3462             # c-l-block-seq-entry(n)
3463             # ( s-indent(n) c-l-block-seq-entry(n) )*
3464              
3465             rule '186', ns_l_compact_sequence => sub {
3466 0     0   0 my ($self, $n) = @_;
3467 0         0 debug_rule("ns_l_compact_sequence",$n) if DEBUG;
3468 0         0 $self->all(
3469             [ $self->func('c_l_block_seq_entry'), $n ],
3470             $self->rep(0, undef,
3471             $self->all(
3472             [ $self->func('s_indent'), $n ],
3473             [ $self->func('c_l_block_seq_entry'), $n ]
3474             ))
3475             );
3476             };
3477              
3478              
3479              
3480             # [187]
3481             # l+block-mapping(n) ::=
3482             # ( s-indent(n+m)
3483             # ns-l-block-map-entry(n+m) )+
3484             # _0>
3485              
3486             rule '187', l_block_mapping => sub {
3487 2     2   6 my ($self, $n) = @_;
3488 2 50       7 my $m = $self->call([$self->func('auto_detect_indent'), $n], 'number') or return false;
3489 2         8 debug_rule("l_block_mapping",$n) if DEBUG;
3490 2         9 $self->all(
3491             $self->rep(1, undef,
3492             $self->all(
3493             [ $self->func('s_indent'), $self->add($n, $m) ],
3494             [ $self->func('ns_l_block_map_entry'), $self->add($n, $m) ]
3495             ))
3496             );
3497             };
3498              
3499              
3500              
3501             # [188]
3502             # ns-l-block-map-entry(n) ::=
3503             # c-l-block-map-explicit-entry(n)
3504             # | ns-l-block-map-implicit-entry(n)
3505              
3506             rule '188', ns_l_block_map_entry => sub {
3507 6     6   18 my ($self, $n) = @_;
3508 6         8 debug_rule("ns_l_block_map_entry",$n) if DEBUG;
3509 6         18 $self->any(
3510             [ $self->func('c_l_block_map_explicit_entry'), $n ],
3511             [ $self->func('ns_l_block_map_implicit_entry'), $n ]
3512             );
3513             };
3514              
3515              
3516              
3517             # [189]
3518             # c-l-block-map-explicit-entry(n) ::=
3519             # c-l-block-map-explicit-key(n)
3520             # ( l-block-map-explicit-value(n)
3521             # | e-node )
3522              
3523             rule '189', c_l_block_map_explicit_entry => sub {
3524 6     6   25 my ($self, $n) = @_;
3525 6         12 debug_rule("c_l_block_map_explicit_entry",$n) if DEBUG;
3526 6         18 $self->all(
3527             [ $self->func('c_l_block_map_explicit_key'), $n ],
3528             $self->any(
3529             [ $self->func('l_block_map_explicit_value'), $n ],
3530             $self->func('e_node')
3531             )
3532             );
3533             };
3534              
3535              
3536              
3537             # [190]
3538             # c-l-block-map-explicit-key(n) ::=
3539             # '?'
3540             # s-l+block-indented(n,block-out)
3541              
3542             rule '190', c_l_block_map_explicit_key => sub {
3543 6     6   14 my ($self, $n) = @_;
3544 6         11 debug_rule("c_l_block_map_explicit_key",$n) if DEBUG;
3545 6         17 $self->all(
3546             $self->chr('?'),
3547             $self->chk(
3548             '=',
3549             $self->any(
3550             $self->func('end_of_stream'),
3551             $self->func('s_white'),
3552             $self->func('b_break')
3553             )
3554             ),
3555             [ $self->func('s_l_block_indented'), $n, "block-out" ]
3556             );
3557             };
3558              
3559              
3560              
3561             # [191]
3562             # l-block-map-explicit-value(n) ::=
3563             # s-indent(n)
3564             # ':' s-l+block-indented(n,block-out)
3565              
3566             rule '191', l_block_map_explicit_value => sub {
3567 0     0   0 my ($self, $n) = @_;
3568 0         0 debug_rule("l_block_map_explicit_value",$n) if DEBUG;
3569 0         0 $self->all(
3570             [ $self->func('s_indent'), $n ],
3571             $self->chr(':'),
3572             [ $self->func('s_l_block_indented'), $n, "block-out" ]
3573             );
3574             };
3575              
3576              
3577              
3578             # [192]
3579             # ns-l-block-map-implicit-entry(n) ::=
3580             # (
3581             # ns-s-block-map-implicit-key
3582             # | e-node )
3583             # c-l-block-map-implicit-value(n)
3584              
3585             rule '192', ns_l_block_map_implicit_entry => sub {
3586 6     6   16 my ($self, $n) = @_;
3587 6         13 debug_rule("ns_l_block_map_implicit_entry",$n) if DEBUG;
3588 6         30 $self->all(
3589             $self->any(
3590             $self->func('ns_s_block_map_implicit_key'),
3591             $self->func('e_node')
3592             ),
3593             [ $self->func('c_l_block_map_implicit_value'), $n ]
3594             );
3595             };
3596              
3597              
3598              
3599             # [193]
3600             # ns-s-block-map-implicit-key ::=
3601             # c-s-implicit-json-key(block-key)
3602             # | ns-s-implicit-yaml-key(block-key)
3603              
3604             rule '193', ns_s_block_map_implicit_key => sub {
3605 6     6   14 my ($self) = @_;
3606 6         10 debug_rule("ns_s_block_map_implicit_key") if DEBUG;
3607 6         16 $self->any(
3608             [ $self->func('c_s_implicit_json_key'), "block-key" ],
3609             [ $self->func('ns_s_implicit_yaml_key'), "block-key" ]
3610             );
3611             };
3612              
3613              
3614              
3615             # [194]
3616             # c-l-block-map-implicit-value(n) ::=
3617             # ':' (
3618             # s-l+block-node(n,block-out)
3619             # | ( e-node s-l-comments ) )
3620              
3621             rule '194', c_l_block_map_implicit_value => sub {
3622 6     6   17 my ($self, $n) = @_;
3623 6         11 debug_rule("c_l_block_map_implicit_value",$n) if DEBUG;
3624 6         19 $self->all(
3625             $self->chr(':'),
3626             $self->any(
3627             [ $self->func('s_l_block_node'), $n, "block-out" ],
3628             $self->all(
3629             $self->func('e_node'),
3630             $self->func('s_l_comments')
3631             )
3632             )
3633             );
3634             };
3635              
3636              
3637              
3638             # [195]
3639             # ns-l-compact-mapping(n) ::=
3640             # ns-l-block-map-entry(n)
3641             # ( s-indent(n) ns-l-block-map-entry(n) )*
3642              
3643             rule '195', ns_l_compact_mapping => sub {
3644 0     0   0 my ($self, $n) = @_;
3645 0         0 debug_rule("ns_l_compact_mapping",$n) if DEBUG;
3646 0         0 $self->all(
3647             [ $self->func('ns_l_block_map_entry'), $n ],
3648             $self->rep(0, undef,
3649             $self->all(
3650             [ $self->func('s_indent'), $n ],
3651             [ $self->func('ns_l_block_map_entry'), $n ]
3652             ))
3653             );
3654             };
3655              
3656              
3657              
3658             # [196]
3659             # s-l+block-node(n,c) ::=
3660             # s-l+block-in-block(n,c) | s-l+flow-in-block(n)
3661              
3662             rule '196', s_l_block_node => sub {
3663 6     6   18 my ($self, $n, $c) = @_;
3664 6         12 debug_rule("s_l_block_node",$n,$c) if DEBUG;
3665 6         15 $self->any(
3666             [ $self->func('s_l_block_in_block'), $n, $c ],
3667             [ $self->func('s_l_flow_in_block'), $n ]
3668             );
3669             };
3670              
3671              
3672              
3673             # [197]
3674             # s-l+flow-in-block(n) ::=
3675             # s-separate(n+1,flow-out)
3676             # ns-flow-node(n+1,flow-out) s-l-comments
3677              
3678             rule '197', s_l_flow_in_block => sub {
3679 2     2   8 my ($self, $n) = @_;
3680 2         4 debug_rule("s_l_flow_in_block",$n) if DEBUG;
3681 2         7 $self->all(
3682             [ $self->func('s_separate'), $self->add($n, 1), "flow-out" ],
3683             [ $self->func('ns_flow_node'), $self->add($n, 1), "flow-out" ],
3684             $self->func('s_l_comments')
3685             );
3686             };
3687              
3688              
3689              
3690             # [198]
3691             # s-l+block-in-block(n,c) ::=
3692             # s-l+block-scalar(n,c) | s-l+block-collection(n,c)
3693              
3694             rule '198', s_l_block_in_block => sub {
3695 6     6   17 my ($self, $n, $c) = @_;
3696 6         10 debug_rule("s_l_block_in_block",$n,$c) if DEBUG;
3697 6         17 $self->any(
3698             [ $self->func('s_l_block_scalar'), $n, $c ],
3699             [ $self->func('s_l_block_collection'), $n, $c ]
3700             );
3701             };
3702              
3703              
3704              
3705             # [199]
3706             # s-l+block-scalar(n,c) ::=
3707             # s-separate(n+1,c)
3708             # ( c-ns-properties(n+1,c) s-separate(n+1,c) )?
3709             # ( c-l+literal(n) | c-l+folded(n) )
3710              
3711             rule '199', s_l_block_scalar => sub {
3712 6     6   19 my ($self, $n, $c) = @_;
3713 6         8 debug_rule("s_l_block_scalar",$n,$c) if DEBUG;
3714 6         17 $self->all(
3715             [ $self->func('s_separate'), $self->add($n, 1), $c ],
3716             $self->rep(0, 1,
3717             $self->all(
3718             [ $self->func('c_ns_properties'), $self->add($n, 1), $c ],
3719             [ $self->func('s_separate'), $self->add($n, 1), $c ]
3720             )),
3721             $self->any(
3722             [ $self->func('c_l_literal'), $n ],
3723             [ $self->func('c_l_folded'), $n ]
3724             )
3725             );
3726             };
3727              
3728              
3729              
3730             # [200]
3731             # s-l+block-collection(n,c) ::=
3732             # ( s-separate(n+1,c)
3733             # c-ns-properties(n+1,c) )?
3734             # s-l-comments
3735             # ( l+block-sequence(seq-spaces(n,c))
3736             # | l+block-mapping(n) )
3737              
3738             rule '200', s_l_block_collection => sub {
3739 4     4   12 my ($self, $n, $c) = @_;
3740 4         6 debug_rule("s_l_block_collection",$n,$c) if DEBUG;
3741 4         12 $self->all(
3742             $self->rep(0, 1,
3743             $self->all(
3744             [ $self->func('s_separate'), $self->add($n, 1), $c ],
3745             $self->any(
3746             $self->all(
3747             [ $self->func('c_ns_properties'), $self->add($n, 1), $c ],
3748             $self->func('s_l_comments')
3749             ),
3750             $self->all(
3751             $self->func('c_ns_tag_property'),
3752             $self->func('s_l_comments')
3753             ),
3754             $self->all(
3755             $self->func('c_ns_anchor_property'),
3756             $self->func('s_l_comments')
3757             )
3758             )
3759             )),
3760             $self->func('s_l_comments'),
3761             $self->any(
3762             [ $self->func('l_block_sequence'), [ $self->func('seq_spaces'), $n, $c ] ],
3763             [ $self->func('l_block_mapping'), $n ]
3764             )
3765             );
3766             };
3767              
3768              
3769              
3770             # [201]
3771             # seq-spaces(n,c) ::=
3772             # ( c = block-out => n-1 )
3773             # ( c = block-in => n )
3774              
3775             rule '201', seq_spaces => sub {
3776 2     2   7 my ($self, $n, $c) = @_;
3777 2         4 debug_rule("seq_spaces",$n,$c) if DEBUG;
3778 2         9 $self->flip(
3779             $c,
3780             {
3781             'block-in' => $n,
3782             'block-out' => $self->sub($n, 1),
3783             }
3784             );
3785             };
3786              
3787              
3788              
3789             # [202]
3790             # l-document-prefix ::=
3791             # c-byte-order-mark? l-comment*
3792              
3793             rule '202', l_document_prefix => sub {
3794 4     4   11 my ($self) = @_;
3795 4         7 debug_rule("l_document_prefix") if DEBUG;
3796 4         14 $self->all(
3797             $self->rep(0, 1, $self->func('c_byte_order_mark')),
3798             $self->rep2(0, undef, $self->func('l_comment'))
3799             );
3800             };
3801              
3802              
3803              
3804             # [203]
3805             # c-directives-end ::=
3806             # '-' '-' '-'
3807              
3808             rule '203', c_directives_end => sub {
3809 4     4   11 my ($self) = @_;
3810 4         6 debug_rule("c_directives_end") if DEBUG;
3811 4         11 $self->all(
3812             $self->chr('-'),
3813             $self->chr('-'),
3814             $self->chr('-'),
3815             $self->chk(
3816             '=',
3817             $self->any(
3818             $self->func('end_of_stream'),
3819             $self->func('s_white'),
3820             $self->func('b_break')
3821             )
3822             )
3823             );
3824             };
3825              
3826              
3827              
3828             # [204]
3829             # c-document-end ::=
3830             # '.' '.' '.'
3831              
3832             rule '204', c_document_end => sub {
3833 2     2   5 my ($self) = @_;
3834 2         4 debug_rule("c_document_end") if DEBUG;
3835 2         8 $self->all(
3836             $self->chr('.'),
3837             $self->chr('.'),
3838             $self->chr('.')
3839             );
3840             };
3841              
3842              
3843              
3844             # [205]
3845             # l-document-suffix ::=
3846             # c-document-end s-l-comments
3847              
3848             rule '205', l_document_suffix => sub {
3849 2     2   4 my ($self) = @_;
3850 2         4 debug_rule("l_document_suffix") if DEBUG;
3851 2         7 $self->all(
3852             $self->func('c_document_end'),
3853             $self->func('s_l_comments')
3854             );
3855             };
3856              
3857              
3858              
3859             # [206]
3860             # c-forbidden ::=
3861             #
3862             # ( c-directives-end | c-document-end )
3863             # ( b-char | s-white | )
3864              
3865             rule '206', c_forbidden => sub {
3866 0     0   0 my ($self) = @_;
3867 0         0 debug_rule("c_forbidden") if DEBUG;
3868 0         0 $self->all(
3869             $self->func('start_of_line'),
3870             $self->any(
3871             $self->func('c_directives_end'),
3872             $self->func('c_document_end')
3873             ),
3874             $self->any(
3875             $self->func('b_char'),
3876             $self->func('s_white'),
3877             $self->func('end_of_stream')
3878             )
3879             );
3880             };
3881              
3882              
3883              
3884             # [207]
3885             # l-bare-document ::=
3886             # s-l+block-node(-1,block-in)
3887             #
3888              
3889             rule '207', l_bare_document => sub {
3890 2     2   6 my ($self) = @_;
3891 2         2 debug_rule("l_bare_document") if DEBUG;
3892 2         8 $self->all(
3893             $self->exclude($self->func('c_forbidden')),
3894             [ $self->func('s_l_block_node'), -1, "block-in" ]
3895             );
3896             };
3897              
3898              
3899              
3900             # [208]
3901             # l-explicit-document ::=
3902             # c-directives-end
3903             # ( l-bare-document
3904             # | ( e-node s-l-comments ) )
3905              
3906             rule '208', l_explicit_document => sub {
3907 4     4   9 my ($self) = @_;
3908 4         5 debug_rule("l_explicit_document") if DEBUG;
3909 4         20 $self->all(
3910             $self->func('c_directives_end'),
3911             $self->any(
3912             $self->func('l_bare_document'),
3913             $self->all(
3914             $self->func('e_node'),
3915             $self->func('s_l_comments')
3916             )
3917             )
3918             );
3919             };
3920              
3921              
3922              
3923             # [209]
3924             # l-directive-document ::=
3925             # l-directive+
3926             # l-explicit-document
3927              
3928             rule '209', l_directive_document => sub {
3929 2     2   4 my ($self) = @_;
3930 2         4 debug_rule("l_directive_document") if DEBUG;
3931 2         17 $self->all(
3932             $self->rep(1, undef, $self->func('l_directive')),
3933             $self->func('l_explicit_document')
3934             );
3935             };
3936              
3937              
3938              
3939             # [210]
3940             # l-any-document ::=
3941             # l-directive-document
3942             # | l-explicit-document
3943             # | l-bare-document
3944              
3945             rule '210', l_any_document => sub {
3946 2     2   6 my ($self) = @_;
3947 2         3 debug_rule("l_any_document") if DEBUG;
3948 2         6 $self->any(
3949             $self->func('l_directive_document'),
3950             $self->func('l_explicit_document'),
3951             $self->func('l_bare_document')
3952             );
3953             };
3954              
3955              
3956              
3957             # [211]
3958             # l-yaml-stream ::=
3959             # l-document-prefix* l-any-document?
3960             # ( ( l-document-suffix+ l-document-prefix*
3961             # l-any-document? )
3962             # | ( l-document-prefix* l-explicit-document? ) )*
3963              
3964             rule '211', l_yaml_stream => sub {
3965 2     2   5 my ($self) = @_;
3966 2         3 debug_rule("l_yaml_stream") if DEBUG;
3967 2         6 $self->all(
3968             $self->func('l_document_prefix'),
3969             $self->rep(0, 1, $self->func('l_any_document')),
3970             $self->rep2(0, undef,
3971             $self->any(
3972             $self->all(
3973             $self->func('l_document_suffix'),
3974             $self->rep(0, undef, $self->func('l_document_prefix')),
3975             $self->rep2(0, 1, $self->func('l_any_document'))
3976             ),
3977             $self->all(
3978             $self->func('l_document_prefix'),
3979             $self->rep(0, 1, $self->func('l_explicit_document'))
3980             )
3981             ))
3982             );
3983             };
3984              
3985              
3986              
3987             1;
3988              
3989              
3990             ###
3991             # This is a parser class. It has a parse() method and parsing primitives for
3992             # the grammar. It calls methods in the receiver class, when a rule matches:
3993             ###
3994              
3995 2     2   62 use v5.12;
  2         11  
3996              
3997             package PerlYamlReferenceParserParser;
3998              
3999 2     2   14 use Encode;
  2         4  
  2         251  
4000 2     2   17 use PerlYamlReferenceParserPrelude;
  2         12  
  2         285  
4001 2     2   15 use PerlYamlReferenceParserGrammar;
  2         5  
  2         67  
4002              
4003 2     2   19 use base 'PerlYamlReferenceParserGrammar';
  2         4  
  2         304  
4004              
4005 2     2   16 use constant TRACE => $ENV{TRACE};
  2         5  
  2         12111  
4006              
4007 0     0 0 0 sub receiver { $_[0]->{receiver} }
4008              
4009             sub new {
4010 2     2 0 5 my ($class, $receiver) = @_;
4011              
4012 2         9 my $self = bless {
4013             receiver => $receiver,
4014             pos => 0,
4015             end => 0,
4016             state => [],
4017             trace_num => 0,
4018             trace_line => 0,
4019             trace_on => true,
4020             trace_off => 0,
4021             trace_info => ['', '', ''],
4022             }, $class;
4023              
4024 2         24 $receiver->{parser} = $self;
4025              
4026 2         6 return $self;
4027             }
4028              
4029             sub parse {
4030 2     2 0 4 my ($self, $input) = @_;
4031              
4032 2 50 33     21 $input .= "\n" unless
4033             length($input) == 0 or
4034             $input =~ /\n\z/;
4035              
4036 2 50       17 $input = decode_utf8($input)
4037             unless Encode::is_utf8($input);
4038 2         88 $self->{input} = $input;
4039              
4040 2         7 $self->{end} = length $self->{input};
4041              
4042 2         2 $self->{trace_on} = not $self->trace_start if TRACE;
4043              
4044 2         4 my $ok;
4045 2         5 eval {
4046 2         6 $ok = $self->call($self->func('TOP'));
4047 2         11 $self->trace_flush;
4048             };
4049 2 50       20 if ($@) {
4050 0         0 $self->trace_flush;
4051 0         0 die $@;
4052             }
4053              
4054 2 50       7 die "Parser failed" if not $ok;
4055             die "Parser finished before end of input"
4056 2 50       21 if $self->{pos} < $self->{end};
4057              
4058 2         6 return true;
4059             }
4060              
4061             sub state_curr {
4062 16522     16522 0 23814 my ($self) = @_;
4063 16522 100       40709 $self->{state}[-1] || {
4064             name => undef,
4065             doc => false,
4066             lvl => 0,
4067             beg => 0,
4068             end => 0,
4069             m => undef,
4070             t => undef,
4071             };
4072             }
4073              
4074             sub state_prev {
4075 4     4 0 9 my ($self) = @_;
4076 4         10 $self->{state}[-2]
4077             }
4078              
4079             sub state_push {
4080 6484     6484 0 10574 my ($self, $name) = @_;
4081              
4082 6484         11058 my $curr = $self->state_curr;
4083              
4084 6484         28150 push @{$self->{state}}, {
4085             name => $name,
4086             doc => $curr->{doc},
4087             lvl => $curr->{lvl} + 1,
4088             beg => $self->{pos},
4089             end => undef,
4090             m => $curr->{m},
4091             t => $curr->{t},
4092 6484         9005 };
4093             }
4094              
4095             sub state_pop {
4096 6484     6484 0 9444 my ($self) = @_;
4097 6484         8193 my $child = pop @{$self->{state}};
  6484         10370  
4098 6484         10511 my $curr = $self->state_curr;
4099 6484 50       11676 return unless defined $curr;
4100 6484         11008 $curr->{beg} = $child->{beg};
4101 6484         15535 $curr->{end} = $self->{pos};
4102             }
4103              
4104             sub call {
4105 6486     6486 0 11294 my ($self, $func, $type) = @_;
4106 6486   100     22079 $type //= 'boolean';
4107              
4108 6486         9966 my $args = [];
4109 6486 100       10641 ($func, @$args) = @$func if isArray $func;
4110              
4111 6486 100 66     12362 return $func if isNumber $func or isString $func;
4112              
4113 6484 50       11099 FAIL "Bad call type '${\ typeof $func}' for '$func'"
  0         0  
4114             unless isFunction $func;
4115              
4116 6484   33     14078 my $trace = $func->{trace} //= $func->{name};
4117              
4118 6484         14435 $self->state_push($trace);
4119              
4120 6484         10862 $self->{trace_num}++;
4121 6484         7688 $self->trace('?', $trace, $args) if TRACE;
4122              
4123 6484 100       12824 if ($func->{name} eq 'l_bare_document') {
4124 2         17 $self->state_curr->{doc} = true;
4125             }
4126              
4127             @$args = map {
4128 6484         11448 isArray($_) ? $self->call($_, 'any') :
4129 774 100       1304 isFunction($_) ? $_->{func}->() :
    100          
4130             $_;
4131             } @$args;
4132              
4133 6484         8847 my $pos = $self->{pos};
4134 6484         14403 $self->receive($func, 'try', $pos);
4135              
4136 6484         14084 my $value = $func->{func}->($self, @$args);
4137 6484   100     18837 while (isFunction($value) or isArray($value)) {
4138 2446         6038 $value = $self->call($value);
4139             }
4140              
4141 6484 50 66     15586 FAIL "Calling '$trace' returned '${\ typeof($value)}' instead of '$type'"
  0         0  
4142             if $type ne 'any' and typeof($value) ne $type;
4143              
4144 6484         9783 $self->{trace_num}++;
4145 6484 100       10822 if ($type ne 'boolean') {
4146 24         33 $self->trace('>', $value) if TRACE;
4147             }
4148             else {
4149 6460 100       13435 if ($value) {
4150 1906         11635 $self->trace('+', $trace) if TRACE;
4151 1906         3563 $self->receive($func, 'got', $pos);
4152             }
4153             else {
4154 4554         27177 $self->trace('x', $trace) if TRACE;
4155 4554         8413 $self->receive($func, 'not', $pos);
4156             }
4157             }
4158              
4159 6484         14659 $self->state_pop;
4160 6484         33038 return $value;
4161             }
4162              
4163             sub receive {
4164 12944     12944 0 22518 my ($self, $func, $type, $pos) = @_;
4165              
4166 12944   66     29505 $func->{receivers} //= $self->make_receivers;
4167 12944         20421 my $receiver = $func->{receivers}{$type};
4168 12944 100       26401 return unless $receiver;
4169              
4170             $receiver->($self->{receiver}, {
4171 186         537 text => substr($self->{input}, $pos, $self->{pos}-$pos),
4172             state => $self->state_curr,
4173             start => $pos,
4174             });
4175             }
4176              
4177             sub make_receivers {
4178 6376     6376 0 9826 my ($self) = @_;
4179 6376         7849 my $i = @{$self->{state}};
  6376         9020  
4180 6376         9744 my $names = [];
4181 6376         8240 my $n;
4182 6376   100     28798 while ($i > 0 and not(($n = $self->{state}[--$i]{name}) =~ /_/)) {
4183 5764 100       13469 if ($n =~ /^chr\((.)\)$/) {
4184 788         1660 $n = hex_char $1;
4185             }
4186             else {
4187 4976         11943 $n =~ s/\(.*//;
4188             }
4189 5764         27357 unshift @$names, $n;
4190             }
4191 6376         15220 my $name = join '__', $n, @$names;
4192              
4193             return {
4194             try => $self->{receiver}->can("try__$name"),
4195             got => $self->{receiver}->can("got__$name"),
4196 6376         63629 not => $self->{receiver}->can("not__$name"),
4197             };
4198             }
4199              
4200             # Match all subrule methods:
4201             sub all {
4202 864     864 0 1996 my ($self, @funcs) = @_;
4203             name all => sub {
4204 754     754   1137 my $pos = $self->{pos};
4205 754         1429 for my $func (@funcs) {
4206 1074 50       3801 FAIL '*** Missing function in @all group:', \@funcs
4207             unless defined $func;
4208              
4209 1074 100       2288 if (not $self->call($func)) {
4210 612         4024 $self->{pos} = $pos;
4211 612         1124 return false;
4212             }
4213             }
4214              
4215 142         1077 return true;
4216 864         3062 };
4217             }
4218              
4219             # Match any subrule method. Rules are tried in order and stops on first match:
4220             sub any {
4221 886     886 0 2117 my ($self, @funcs) = @_;
4222             name any => sub {
4223 818     818   1730 for my $func (@funcs) {
4224 2042 100       11375 if ($self->call($func)) {
4225 322         2293 return true;
4226             }
4227             }
4228              
4229 496         3859 return false;
4230 886         3419 };
4231             }
4232              
4233             sub may {
4234 6     6 0 18 my ($self, $func) = @_;
4235             name may => sub {
4236 6     6   15 $self->call($func);
4237 6         21 };
4238             }
4239              
4240             # Repeat a rule a certain number of times:
4241             sub rep {
4242 492     492 0 965 my ($self, $min, $max, $func) = @_;
4243             name rep => sub {
4244 274 50 66 274   779 return false if defined $max and $max < 0;
4245 274         418 my $count = 0;
4246 274         385 my $pos = $self->{pos};
4247 274         343 my $pos_start = $pos;
4248 274   100     726 while (not(defined $max) or $count < $max) {
4249 312 100       631 last unless $self->call($func);
4250 84 100       638 last if $self->{pos} == $pos;
4251 80         115 $count++;
4252 80         251 $pos = $self->{pos};
4253             }
4254 274 50 66     2251 if ($count >= $min and (not(defined $max) or $count <= $max)) {
      66        
4255 216         459 return true;
4256             }
4257 58         92 $self->{pos} = $pos_start;
4258 58         106 return false;
4259 492   100     2310 }, "rep($min,${\ ($max // 'null')})";
  492         2050  
4260             }
4261             sub rep2 {
4262 48     48 0 94 my ($self, $min, $max, $func) = @_;
4263             name rep2 => sub {
4264 22 50 66 22   84 return false if defined $max and $max < 0;
4265 22         42 my $count = 0;
4266 22         41 my $pos = $self->{pos};
4267 22         30 my $pos_start = $pos;
4268 22   100     73 while (not(defined $max) or $count < $max) {
4269 48 100       111 last unless $self->call($func);
4270 36 100       287 last if $self->{pos} == $pos;
4271 32         51 $count++;
4272 32         87 $pos = $self->{pos};
4273             }
4274 22 50 66     198 if ($count >= $min and (not(defined $max) or $count <= $max)) {
      66        
4275 22         49 return true;
4276             }
4277 0         0 $self->{pos} = $pos_start;
4278 0         0 return false;
4279 48   100     182 }, "rep2($min,${\ ($max // 'null')})";
  48         174  
4280             }
4281              
4282             # Call a rule depending on state value:
4283             sub case {
4284 72     72 0 155 my ($self, $var, $map) = @_;
4285             name case => sub {
4286 72     72   133 my $rule = $map->{$var};
4287 72 50       131 defined $rule or
4288             FAIL "Can't find '$var' in:", $map;
4289 72         150 $self->call($rule);
4290 72         323 }, "case($var,${\ stringify $map})";
  72         147  
4291             }
4292              
4293             # Call a rule depending on state value:
4294             sub flip {
4295 4     4 0 12 my ($self, $var, $map) = @_;
4296 4         10 my $value = $map->{$var};
4297 4 50       13 defined $value or
4298             FAIL "Can't find '$var' in:", $map;
4299 4 50       15 return $value if not ref $value;
4300 0         0 return $self->call($value, 'number');
4301             }
4302             name flip => \&flip;
4303              
4304             sub the_end {
4305 1894     1894 0 2997 my ($self) = @_;
4306             return (
4307             $self->{pos} >= $self->{end} or (
4308             $self->state_curr->{doc} and
4309             $self->start_of_line and
4310 1894   66     5983 substr($self->{input}, $self->{pos}) =~
4311             /^(?:---|\.\.\.)(?=\s|\z)/
4312             )
4313             );
4314             }
4315              
4316             # Match a single char:
4317             sub chr {
4318 2004     2004 0 3723 my ($self, $char) = @_;
4319             name chr => sub {
4320 1640 100   1640   3354 return false if $self->the_end;
4321 1554 50 100     28308 if (
      66        
      33        
4322             $self->{pos} >= $self->{end} or (
4323             $self->state_curr->{doc} and
4324             $self->start_of_line and
4325             substr($self->{input}, $self->{pos}) =~
4326             /^(?:---|\.\.\.)(?=\s|\z)/
4327             )
4328             ) {
4329 0         0 return false;
4330             }
4331 1554 100       21628 if (substr($self->{input}, $self->{pos}, 1) eq $char) {
4332 120         182 $self->{pos}++;
4333 120         252 return true;
4334             }
4335 1434         2596 return false;
4336 2004         7087 }, "chr(${\ stringify($char)})";
  2004         4254  
4337             }
4338              
4339             # Match a char in a range:
4340             sub rng {
4341 330     330 0 664 my ($self, $low, $high) = @_;
4342             name rng => sub {
4343 78 50   78   151 return false if $self->the_end;
4344 78 100 66     1677 if (
4345             $low le substr($self->{input}, $self->{pos}, 1) and
4346             substr($self->{input}, $self->{pos}, 1) le $high
4347             ) {
4348 76         117 $self->{pos}++;
4349 76         154 return true;
4350             }
4351 2         6 return false;
4352 330         1196 }, "rng(${\ stringify($low)},${\ stringify($high)})";
  330         598  
  330         573  
4353             }
4354              
4355             # Must match first rule but none of others:
4356             sub but {
4357 176     176 0 420 my ($self, @funcs) = @_;
4358             name but => sub {
4359 176 100   176   340 return false if $self->the_end;
4360 174         2954 my $pos1 = $self->{pos};
4361 174 100       395 return false unless $self->call($funcs[0]);
4362 166         1142 my $pos2 = $self->{pos};
4363 166         258 $self->{pos} = $pos1;
4364 166         443 for my $func (@funcs[1..$#funcs]) {
4365 250 100       989 if ($self->call($func)) {
4366 24         167 $self->{pos} = $pos1;
4367 24         49 return false;
4368             }
4369             }
4370 142         1060 $self->{pos} = $pos2;
4371 142         292 return true;
4372             }
4373 176         848 }
4374              
4375             sub chk {
4376 84     84 0 171 my ($self, $type, $expr) = @_;
4377             name chk => sub {
4378 20     20   34 my $pos = $self->{pos};
4379 20 100       48 $self->{pos}-- if $type eq '<=';
4380 20         44 my $ok = $self->call($expr);
4381 20         30 $self->{pos} = $pos;
4382 20 50       52 return $type eq '!' ? not($ok) : $ok;
4383 84         336 }, "chk($type, ${\ stringify $expr})";
  84         163  
4384             }
4385              
4386             sub set {
4387 10     10 0 20 my ($self, $var, $expr) = @_;
4388             name set => sub {
4389 4     4   11 my $value = $self->call($expr, 'any');
4390 4 50       19 return false if $value == -1;
4391 4 50       10 $value = $self->auto_detect if $value eq 'auto-detect';
4392 4         9 my $state = $self->state_prev;
4393 4         12 $state->{$var} = $value;
4394 4 50       13 if ($state->{name} ne 'all') {
4395 4         5 my $size = @{$self->{state}};
  4         10  
4396 4         14 for (my $i = 3; $i < $size; $i++) {
4397 44 50       79 FAIL "failed to traverse state stack in 'set'"
4398             if $i > $size - 2;
4399 44         60 $state = $self->{state}[0 - $i];
4400 44         63 $state->{$var} = $value;
4401 44 100       109 last if $state->{name} eq 's_l_block_scalar';
4402             }
4403             }
4404 4         11 return true;
4405 10         45 }, "set('$var', ${\ stringify $expr})";
  10         22  
4406             }
4407              
4408             sub max {
4409 20     20 0 40 my ($self, $max) = @_;
4410             name max => sub {
4411 20     20   59 return true;
4412 20         78 };
4413             }
4414              
4415             sub exclude {
4416 2     2 0 4 my ($self, $rule) = @_;
4417             name exclude => sub {
4418 2     2   5 return true;
4419 2         10 };
4420             }
4421              
4422             sub add {
4423 48     48 0 87 my ($self, $x, $y) = @_;
4424             name add => sub {
4425 42 100   42   75 $y = $self->call($y, 'number') if isFunction $y;
4426 42 50       82 FAIL "y is '${\ stringify $y}', not number in 'add'"
  0         0  
4427             unless isNumber $y;
4428 42         147 return $x + $y;
4429 48         200 }, "add($x,${\ stringify $y})";
  48         100  
4430             }
4431              
4432             sub sub {
4433 2     2 0 5 my ($self, $x, $y) = @_;
4434             name sub => sub {
4435 0     0   0 return $x - $y;
4436 2         16 }, "sub($x,$y)";
4437             }
4438              
4439             # This method does not need to return a function since it is never
4440             # called in the grammar.
4441             sub match {
4442 6     6 0 10 my ($self) = @_;
4443 6         25 my $state = $self->{state};
4444 6         12 my $i = @$state - 1;
4445 6   66     28 while ($i > 0 && not defined $state->[$i]{end}) {
4446 18 50       34 FAIL "Can't find match" if $i == 1;
4447 18         52 $i--;
4448             }
4449              
4450 6         28 my ($beg, $end) = @{$self->{state}[$i]}{qw};
  6         18  
4451 6         22 return substr($self->{input}, $beg, ($end - $beg));
4452             }
4453             name match => \&match;
4454              
4455             sub len {
4456 6     6 0 26 my ($self, $str) = @_;
4457             name len => sub {
4458 6 50   6   12 $str = $self->call($str, 'string') unless isString($str);
4459 6         20 return length $str;
4460 6         25 };
4461             }
4462              
4463             sub ord {
4464 2     2 0 7 my ($self, $str) = @_;
4465             name ord => sub {
4466             # Should be `$self->call($str, 'string')`, but... Perl
4467 0 0   0   0 $str = $self->call($str, 'number') unless isString($str);
4468 0         0 return ord($str) - 48;
4469 2         10 };
4470             }
4471              
4472             sub if {
4473 10     10 0 21 my ($self, $test, $do_if_true) = @_;
4474             name if => sub {
4475 10 50   10   22 $test = $self->call($test, 'boolean') unless isBoolean $test;
4476 10 100       74 if ($test) {
4477 4         34 $self->call($do_if_true);
4478 4         10 return true;
4479             }
4480 6         49 return false;
4481 10         41 };
4482             }
4483              
4484             sub lt {
4485 4     4 0 10 my ($self, $x, $y) = @_;
4486             name lt => sub {
4487 4 50   4   11 $x = $self->call($x, 'number') unless isNumber($x);
4488 4 50       18 $y = $self->call($y, 'number') unless isNumber($y);
4489 4 50       21 return $x < $y ? true : false;
4490 4         15 }, "lt(${\ stringify $x},${\ stringify $y})";
  4         10  
  4         9  
4491             }
4492              
4493             sub le {
4494 2     2 0 7 my ($self, $x, $y) = @_;
4495             name le => sub {
4496 2 50   2   7 $x = $self->call($x, 'number') unless isNumber($x);
4497 2 50       11 $y = $self->call($y, 'number') unless isNumber($y);
4498 2 50       24 return $x <= $y ? true : false;
4499 2         9 }, "le(${\ stringify $x},${\ stringify $y})";
  2         8  
  2         6  
4500             }
4501              
4502             sub m {
4503 10     10 0 32 my ($self) = @_;
4504             name m => sub {
4505 2     2   9 $self->state_curr->{m};
4506 10         40 };
4507             }
4508              
4509             sub t {
4510 10     10 0 22 my ($self) = @_;
4511             name t => sub {
4512 2     2   7 $self->state_curr->{t};
4513 10         35 };
4514             }
4515              
4516             #------------------------------------------------------------------------------
4517             # Special grammar rules
4518             #------------------------------------------------------------------------------
4519             sub start_of_line {
4520 3364     3364 0 25117 my ($self) = @_;
4521             (
4522             $self->{pos} == 0 ||
4523             $self->{pos} >= $self->{end} ||
4524 3364 100 100     18480 substr($self->{input}, $self->{pos} - 1, 1) eq "\n"
4525             ) ? true : false;
4526             }
4527             name 'start_of_line', \&start_of_line;
4528              
4529             sub end_of_stream {
4530 34     34 0 65 my ($self) = @_;
4531 34 100       114 ($self->{pos} >= $self->{end}) ? true : false;
4532             }
4533             name 'end_of_stream', \&end_of_stream;
4534              
4535 10     10 0 35 sub empty { true }
4536             name 'empty', \∅
4537              
4538             sub auto_detect_indent {
4539 4     4 0 10 my ($self, $n) = @_;
4540 4         7 my $pos = $self->{pos};
4541 4   33     25 my $in_seq = ($pos > 0 && substr($self->{input}, $pos - 1, 1) =~ /^[\-\?\:]$/);
4542 4 50       26 substr($self->{input}, $pos) =~ /^
4543             (
4544             (?:
4545             \ *
4546             (?:\#.*)?
4547             \n
4548             )*
4549             )
4550             (\ *)
4551             /x or FAIL "auto_detect_indent";
4552 4         12 my $pre = $1;
4553 4         9 my $m = length($2);
4554 4 50 33     12 if ($in_seq and not length $pre) {
4555 0 0       0 $m++ if $n == -1;
4556             }
4557             else {
4558 4         6 $m -= $n;
4559             }
4560 4 50       10 $m = 0 if $m < 0;
4561 4         8 return $m;
4562             }
4563             name 'auto_detect_indent', \&auto_detect_indent;
4564              
4565             sub auto_detect {
4566 2     2 0 16 my ($self, $n) = @_;
4567 2         19 substr($self->{input}, $self->{pos}) =~ /
4568             ^.*\n
4569             (
4570             (?:\ *\n)*
4571             )
4572             (\ *)
4573             (.?)
4574             /x;
4575 2         7 my $pre = $1;
4576 2         4 my $m;
4577 2 50 33     16 if (defined $3 and length($3)) {
4578 2         10 $m = length($2) - $n;
4579             }
4580             else {
4581 0         0 $m = 0;
4582 0         0 while ($pre =~ /\ {$m}/){
4583 0         0 $m++;
4584             }
4585 0         0 $m = $m - $n - 1;
4586             }
4587             # XXX change 'die' to 'error' for reporting parse errors
4588 2 50 33     52 die "Spaces found after indent in auto-detect (5LLU)"
4589             if $m > 0 and $pre =~ /^.{$m}\ /m;
4590 2 50       10 return($m == 0 ? 1 : $m);
4591             }
4592             name 'auto_detect', \&auto_detect;
4593              
4594             #------------------------------------------------------------------------------
4595             # Trace debugging
4596             #------------------------------------------------------------------------------
4597             sub trace_start {
4598 0     0 0 0 '' || "$ENV{TRACE_START}";
4599             }
4600              
4601             sub trace_quiet {
4602 0 0   0 0 0 return [] if $ENV{DEBUG};
4603              
4604 0         0 my @small = (
4605             'b_as_line_feed',
4606             's_indent',
4607             'nb_char',
4608             );
4609              
4610 0         0 my @noisy = (
4611             'c_directives_end',
4612             'c_l_folded',
4613             'c_l_literal',
4614             'c_ns_alias_node',
4615             'c_ns_anchor_property',
4616             'c_ns_tag_property',
4617             'l_directive_document',
4618             'l_document_prefix',
4619             'ns_flow_content',
4620             'ns_plain',
4621             's_l_comments',
4622             's_separate',
4623             );
4624              
4625             return [
4626 0   0     0 split(',', ($ENV{TRACE_QUIET} || '')),
4627             @noisy,
4628             ];
4629             }
4630              
4631             sub trace {
4632 0     0 0 0 my ($self, $type, $call, $args) = @_;
4633 0   0     0 $args //= [];
4634              
4635 0 0       0 $call = "'$call'" if $call =~ /^($| |.* $)/;
4636 0 0 0     0 return unless $self->{trace_on} or $call eq $self->trace_start;
4637              
4638 0         0 my $level = $self->state_curr->{lvl};
4639 0         0 my $indent = ' ' x $level;
4640 0 0       0 if ($level > 0) {
4641 0         0 my $l = length "$level";
4642 0         0 $indent = "$level" . substr($indent, $l);
4643             }
4644              
4645 0         0 my $input = substr($self->{input}, $self->{pos});
4646 0 0       0 $input = substr($input, 0, 30) . '…'
4647             if length($input) > 30;
4648 0         0 $input =~ s/\t/\\t/g;
4649 0         0 $input =~ s/\r/\\r/g;
4650 0         0 $input =~ s/\n/\\n/g;
4651              
4652             my $line = sprintf(
4653             "%s%s %-40s %4d '%s'\n",
4654             $indent,
4655             $type,
4656             $self->trace_format_call($call, $args),
4657             $self->{pos},
4658 0         0 $input,
4659             );
4660              
4661 0 0       0 if ($ENV{DEBUG}) {
4662             warn sprintf "%6d %s",
4663 0         0 $self->{trace_num}, $line;
4664 0         0 return;
4665             }
4666              
4667 0         0 my $trace_info = undef;
4668 0         0 $level = "${level}_$call";
4669 0 0 0     0 if ($type eq '?' and not $self->{trace_off}) {
4670 0         0 $trace_info = [$type, $level, $line, $self->{trace_num}];
4671             }
4672 0 0       0 if (grep $_ eq $call, @{$self->trace_quiet}) {
  0         0  
4673 0 0       0 $self->{trace_off} += $type eq '?' ? 1 : -1;
4674             }
4675 0 0 0     0 if ($type ne '?' and not $self->{trace_off}) {
4676 0         0 $trace_info = [$type, $level, $line, $self->{trace_num}];
4677             }
4678              
4679 0 0       0 if (defined $trace_info) {
4680             my ($prev_type, $prev_level, $prev_line, $trace_num) =
4681 0         0 @{$self->{trace_info}};
  0         0  
4682 0 0 0     0 if ($prev_type eq '?' and $prev_level eq $level) {
4683 0         0 $trace_info->[1] = '';
4684 0 0       0 if ($line =~ /^\d*\ *\+/) {
4685 0         0 $prev_line =~ s/\?/=/;
4686             }
4687             else {
4688 0         0 $prev_line =~ s/\?/!/;
4689             }
4690             }
4691 0 0       0 if ($prev_level) {
4692             warn sprintf "%5d %6d %s",
4693 0         0 ++$self->{trace_line}, $trace_num, $prev_line;
4694             }
4695              
4696 0         0 $self->{trace_info} = $trace_info;
4697             }
4698              
4699 0 0       0 if ($call eq $self->trace_start) {
4700 0         0 $self->{trace_on} = not $self->{trace_on};
4701             }
4702             }
4703              
4704             sub trace_format_call {
4705 0     0 0 0 my ($self, $call, $args) = @_;
4706 0 0       0 return $call unless @$args;
4707 0         0 my $list = join ',', map stringify($_), @$args;
4708 0         0 return "$call($list)";
4709             }
4710              
4711             sub trace_flush {
4712 2     2 0 4 my ($self) = @_;
4713 2         4 my ($type, $level, $line, $count) = @{$self->{trace_info}};
  2         8  
4714 2 50       9 if (my $line = $self->{trace_info}[2]) {
4715             warn sprintf "%5d %6d %s",
4716 0         0 ++$self->{trace_line}, $count, $line;
4717             }
4718             }
4719              
4720             1;
4721              
4722             # vim: sw=2:
4723              
4724              
4725 2     2   51 use v5.12;
  2         8  
4726             package PerlYamlReferenceParserReceiver;
4727 2     2   16 use PerlYamlReferenceParserPrelude;
  2         3  
  2         8853  
4728              
4729             sub stream_start_event {
4730 2     2   11 { event => 'stream_start' };
4731             }
4732             sub stream_end_event {
4733 2     2   8 { event => 'stream_end' };
4734             }
4735             sub document_start_event {
4736 4   33 4   17 { event => 'document_start', explicit => (shift || false), version => undef };
4737             }
4738             sub document_end_event {
4739 2   33 2   13 { event => 'document_end', explicit => (shift || false) };
4740             }
4741             sub mapping_start_event {
4742 6   66 6   37 { event => 'mapping_start', flow => (shift || false) };
4743             }
4744             sub mapping_end_event {
4745 2     2   10 { event => 'mapping_end' };
4746             }
4747             sub sequence_start_event {
4748 4   66 4   23 { event => 'sequence_start', flow => (shift || false) };
4749             }
4750             sub sequence_end_event {
4751 2     2   9 { event => 'sequence_end' };
4752             }
4753             sub scalar_event {
4754 20     20   42 my ($style, $value) = @_;
4755 20         198 { event => 'scalar', style => $style, value => $value };
4756             }
4757             sub alias_event {
4758 0     0   0 { event => 'alias', name => (shift) };
4759             }
4760             sub cache {
4761 6     6   20 { text => (shift) };
4762             }
4763              
4764             sub new {
4765 2     2   20080 my ($class, %self) = @_;
4766 2         19 bless {
4767             %self,
4768             event => [],
4769             cache => [],
4770             }, $class;
4771             }
4772              
4773             sub send {
4774 26     26   44 my ($self, $event) = @_;
4775 26 100       43 if (my $callback = $self->{callback}) {
4776 13         20 $callback->($event);
4777             }
4778             else {
4779 13         21 push @{$self->{event}}, $event;
  13         34  
4780             }
4781             }
4782              
4783             sub add {
4784 44     44   114 my ($self, $event) = @_;
4785 44 100       103 if (defined $event->{event}) {
4786 38 50       86 if (my $anchor = $self->{anchor}) {
4787 0         0 $event->{anchor} = delete $self->{anchor};
4788             }
4789 38 50       87 if (my $tag = $self->{tag}) {
4790 0         0 $event->{tag} = delete $self->{tag};
4791             }
4792             }
4793 44         125 $self->push($event);
4794 44         97 return $event;
4795             }
4796              
4797             sub push {
4798 74     74   113 my ($self, $event) = @_;
4799 74 100       98 if (@{$self->{cache}}) {
  74         144  
4800 52         71 push @{$self->{cache}[-1]}, $event;
  52         139  
4801             }
4802             else {
4803 22 100       98 if ($event->{event} =~ /(mapping_start|sequence_start|scalar)/) {
4804 14         32 $self->check_document_start;
4805             }
4806 22         60 $self->send($event);
4807             }
4808             }
4809              
4810             sub cache_up {
4811 34     34   139 my ($self, $event) = @_;
4812 34         45 CORE::push @{$self->{cache}}, [];
  34         75  
4813 34 100       104 $self->add($event) if $event;
4814             }
4815              
4816             sub cache_down {
4817 6     6   15 my ($self, $event) = @_;
4818 6 50       12 my $events = pop @{$self->{cache}} or FAIL 'cache_down';
  6         23  
4819 6         24 $self->push($_) for @$events;
4820 6 100       23 $self->add($event) if $event;
4821             }
4822              
4823             sub cache_drop {
4824 28     28   60 my ($self) = @_;
4825 28 50       38 my $events = pop @{$self->{cache}} or FAIL 'cache_drop';
  28         89  
4826 28         76 return $events;
4827             }
4828              
4829             sub cache_get {
4830 0     0   0 my ($self, $type) = @_;
4831             return
4832             $self->{cache}[-1] &&
4833             $self->{cache}[-1][0] &&
4834             $self->{cache}[-1][0]{event} eq $type &&
4835 0   0     0 $self->{cache}[-1][0];
4836             }
4837              
4838             sub check_document_start {
4839 14     14   21 my ($self) = @_;
4840 14 100       33 return unless $self->{document_start};
4841 2         12 $self->send($self->{document_start});
4842 2         5 delete $self->{document_start};
4843 2         11 $self->{document_end} = document_end_event;
4844             }
4845              
4846             sub check_document_end {
4847 4     4   8 my ($self) = @_;
4848 4 100       12 return unless $self->{document_end};
4849 2         8 $self->send($self->{document_end});
4850 2         5 delete $self->{document_end};
4851 2         6 $self->{tag_map} = {};
4852 2         6 $self->{document_start} = document_start_event;
4853             }
4854              
4855             #------------------------------------------------------------------------------
4856             sub try__l_yaml_stream {
4857 2     2   5 my ($self) = @_;
4858 2         4 $self->add(stream_start_event);
4859 2         5 $self->{tag_map} = {};
4860 2         5 $self->{document_start} = document_start_event;
4861 2         55 delete $self->{document_end};
4862             }
4863             sub got__l_yaml_stream {
4864 2     2   7 my ($self) = @_;
4865 2         8 $self->check_document_end;
4866 2         24 $self->add(stream_end_event);
4867             }
4868              
4869             sub got__ns_yaml_version {
4870 0     0   0 my ($self, $o) = @_;
4871             die "Multiple %YAML directives not allowed"
4872 0 0       0 if defined $self->{document_start}{version};
4873 0         0 $self->{document_start}{version} = $o->{text};
4874             }
4875              
4876             sub got__c_tag_handle {
4877 0     0   0 my ($self, $o) = @_;
4878 0         0 $self->{tag_handle} = $o->{text};
4879             }
4880             sub got__ns_tag_prefix {
4881 0     0   0 my ($self, $o) = @_;
4882 0         0 $self->{tag_map}{$self->{tag_handle}} = $o->{text};
4883             }
4884              
4885             sub got__c_directives_end {
4886 2     2   5 my ($self) = @_;
4887 2         10 $self->check_document_end;
4888 2         5 $self->{document_start}{explicit} = true;
4889             }
4890             sub got__c_document_end {
4891 0     0   0 my ($self) = @_;
4892             $self->{document_end}{explicit} = true
4893 0 0       0 if defined $self->{document_end};
4894 0         0 $self->check_document_end;
4895             }
4896              
4897 0     0   0 sub got__c_flow_mapping__all__x7b { $_[0]->add(mapping_start_event(true)) }
4898 0     0   0 sub got__c_flow_mapping__all__x7d { $_[0]->add(mapping_end_event) }
4899              
4900 2     2   8 sub got__c_flow_sequence__all__x5b { $_[0]->add(sequence_start_event(true)) }
4901 2     2   10 sub got__c_flow_sequence__all__x5d { $_[0]->add(sequence_end_event) }
4902              
4903 2     2   8 sub try__l_block_mapping { $_[0]->cache_up(mapping_start_event) }
4904 2     2   10 sub got__l_block_mapping { $_[0]->cache_down(mapping_end_event) }
4905 0     0   0 sub not__l_block_mapping { $_[0]->cache_drop }
4906              
4907 2     2   15 sub try__l_block_sequence { $_[0]->cache_up(sequence_start_event) }
4908 0     0   0 sub got__l_block_sequence { $_[0]->cache_down(sequence_end_event) }
4909             sub not__l_block_sequence {
4910 2     2   5 my ($self) = @_;
4911 2         7 my $event = $_[0]->cache_drop->[0];
4912 2         6 $self->{anchor} = $event->{anchor};
4913 2         8 $self->{tag} = $event->{tag};
4914             }
4915              
4916 0     0   0 sub try__ns_l_compact_mapping { $_[0]->cache_up(mapping_start_event) }
4917 0     0   0 sub got__ns_l_compact_mapping { $_[0]->cache_down(mapping_end_event) }
4918 0     0   0 sub not__ns_l_compact_mapping { $_[0]->cache_drop }
4919              
4920 0     0   0 sub try__ns_l_compact_sequence { $_[0]->cache_up(sequence_start_event) }
4921 0     0   0 sub got__ns_l_compact_sequence { $_[0]->cache_down(sequence_end_event) }
4922 0     0   0 sub not__ns_l_compact_sequence { $_[0]->cache_drop }
4923              
4924 4     4   17 sub try__ns_flow_pair { $_[0]->cache_up(mapping_start_event(true)) }
4925 0     0   0 sub got__ns_flow_pair { $_[0]->cache_down(mapping_end_event) }
4926 4     4   22 sub not__ns_flow_pair { $_[0]->cache_drop }
4927              
4928 6     6   23 sub try__ns_l_block_map_implicit_entry { $_[0]->cache_up }
4929 4     4   27 sub got__ns_l_block_map_implicit_entry { $_[0]->cache_down }
4930 2     2   8 sub not__ns_l_block_map_implicit_entry { $_[0]->cache_drop }
4931              
4932 6     6   21 sub try__c_l_block_map_explicit_entry { $_[0]->cache_up }
4933 0     0   0 sub got__c_l_block_map_explicit_entry { $_[0]->cache_down }
4934 6     6   23 sub not__c_l_block_map_explicit_entry { $_[0]->cache_drop }
4935              
4936 4     4   13 sub try__c_ns_flow_map_empty_key_entry { $_[0]->cache_up }
4937 0     0   0 sub got__c_ns_flow_map_empty_key_entry { $_[0]->cache_down }
4938 4     4   29 sub not__c_ns_flow_map_empty_key_entry { $_[0]->cache_drop }
4939              
4940             sub got__ns_plain {
4941 12     12   27 my ($self, $o) = @_;
4942 12         28 my $text = $o->{text};
4943 12         30 $text =~ s/(?:[\ \t]*\r?\n[\ \t]*)/\n/g;
4944 12 0       23 $text =~ s/(\n)(\n*)/length($2) ? $2 : ' '/ge;
  0         0  
4945 12         28 $self->add(scalar_event(plain => $text));
4946             }
4947              
4948             sub got__c_single_quoted {
4949 0     0   0 my ($self, $o) = @_;
4950 0         0 my $text = substr($o->{text}, 1, -1);
4951 0         0 $text =~ s/(?:[\ \t]*\r?\n[\ \t]*)/\n/g;
4952 0 0       0 $text =~ s/(\n)(\n*)/length($2) ? $2 : ' '/ge;
  0         0  
4953 0         0 $text =~ s/''/'/g;
4954 0         0 $self->add(scalar_event(single => $text));
4955             }
4956              
4957             sub got__c_double_quoted {
4958 0     0   0 my ($self, $o) = @_;
4959 0         0 my $text = substr($o->{text}, 1, -1);
4960 0         0 $text =~ s/(?:(?
4961 0         0 $text =~ s/\\\n[\ \t]*//g;
4962 0 0       0 $text =~ s/(\n)(\n*)/length($2) ? $2 : ' '/ge;
  0         0  
4963 0         0 $text =~ s/\\(["\/])/$1/g;
4964 0         0 $text =~ s/\\ / /g;
4965 0         0 $text =~ s/\\b/\b/g;
4966 0         0 $text =~ s/\\\t/\t/g;
4967 0         0 $text =~ s/\\t/\t/g;
4968 0         0 $text =~ s/\\n/\n/g;
4969 0         0 $text =~ s/\\r/\r/g;
4970 0         0 $text =~ s/\\x([0-9a-fA-F]{2})/chr(hex($1))/eg;
  0         0  
4971 0         0 $text =~ s/\\u([0-9a-fA-F]{4})/chr(hex($1))/eg;
  0         0  
4972 0         0 $text =~ s/\\U([0-9a-fA-F]{8})/chr(hex($1))/eg;
  0         0  
4973 0         0 $text =~ s/\\\\/\\/g;
4974 0         0 $self->add(scalar_event(double => $text));
4975             }
4976              
4977             sub got__l_empty {
4978 0     0   0 my ($self) = @_;
4979 0 0       0 $self->add(cache '') if $self->{in_scalar};
4980             }
4981             sub got__l_nb_literal_text__all__rep2 {
4982 6     6   17 my ($self, $o) = @_;
4983 6         22 $self->add(cache $o->{text});
4984             }
4985             sub try__c_l_literal {
4986 6     6   17 my ($self) = @_;
4987 6         18 $self->{in_scalar} = true;
4988 6         37 $self->cache_up;
4989             }
4990             sub got__c_l_literal {
4991 2     2   7 my ($self) = @_;
4992 2         8 delete $self->{in_scalar};
4993 2         9 my $lines = $self->cache_drop;
4994 2 50 33     14 pop @$lines if @$lines and $lines->[-1]{text} eq '';
4995 2         18 my $text = join '', map "$_->{text}\n", @$lines;
4996 2         9 my $t = $self->{parser}->state_curr->{t};
4997 2 50       10 if ($t eq 'clip') {
    0          
    0          
4998 2         17 $text =~ s/\n+\z/\n/;
4999             }
5000             elsif ($t eq 'strip') {
5001 0         0 $text =~ s/\n+\z//;
5002             }
5003             elsif ($text !~ /\S/) {
5004 0         0 $text =~ s/\n(\n+)\z/$1/;
5005             }
5006 2         11 $self->add(scalar_event(literal => $text));
5007             }
5008             sub not__c_l_literal {
5009 4     4   8 my ($self) = @_;
5010 4         10 delete $self->{in_scalar};
5011 4         18 $_[0]->cache_drop;
5012             }
5013              
5014             sub got__ns_char {
5015 46     46   96 my ($self, $o) = @_;
5016 46 50       146 $self->{first} = $o->{text} if $self->{in_scalar};
5017             }
5018             sub got__s_white {
5019 26     26   54 my ($self, $o) = @_;
5020 26 50       109 $self->{first} = $o->{text} if $self->{in_scalar};
5021             }
5022             sub got__s_nb_folded_text__all__rep {
5023 0     0   0 my ($self, $o) = @_;
5024 0         0 $self->add(cache "$self->{first}$o->{text}");
5025             }
5026             sub got__s_nb_spaced_text__all__rep {
5027 0     0   0 my ($self, $o) = @_;
5028 0         0 $self->add(cache "$self->{first}$o->{text}");
5029             }
5030             sub try__c_l_folded {
5031 4     4   11 my ($self) = @_;
5032 4         11 $self->{in_scalar} = true;
5033 4         21 $self->{first} = '';
5034 4         11 $self->cache_up;
5035             }
5036             sub got__c_l_folded {
5037 0     0   0 my ($self) = @_;
5038 0         0 delete $self->{in_scalar};
5039              
5040 0         0 my @lines = map $_->{text}, @{$self->cache_drop};
  0         0  
5041 0         0 my $text = join "\n", @lines;
5042 0         0 $text =~ s/^(\S.*)\n(?=\S)/$1 /gm;
5043 0         0 $text =~ s/^(\S.*)\n(\n+)/$1$2/gm;
5044 0         0 $text =~ s/^([\ \t]+\S.*)\n(\n+)(?=\S)/$1$2/gm;
5045 0         0 $text .= "\n";
5046              
5047 0         0 my $t = $self->{parser}->state_curr->{t};
5048 0 0       0 if ($t eq 'clip') {
    0          
5049 0         0 $text =~ s/\n+\z/\n/;
5050 0 0       0 $text = '' if $text eq "\n";
5051             }
5052             elsif ($t eq 'strip') {
5053 0         0 $text =~ s/\n+\z//;
5054             }
5055 0         0 $self->add(scalar_event(folded => $text));
5056             }
5057             sub not__c_l_folded {
5058 4     4   12 my ($self) = @_;
5059 4         10 delete $self->{in_scalar};
5060 4         11 $_[0]->cache_drop;
5061             }
5062              
5063 6     6   22 sub got__e_scalar { $_[0]->add(scalar_event(plain => '')) }
5064              
5065             sub not__s_l_block_collection__all__rep__all__any__all {
5066 12     12   23 my ($self) = @_;
5067 12         24 delete $self->{anchor};
5068 12         24 delete $self->{tag};
5069             }
5070              
5071             sub got__c_ns_anchor_property {
5072 0     0   0 my ($self, $o) = @_;
5073 0         0 $self->{anchor} = substr($o->{text}, 1);
5074             }
5075              
5076             sub got__c_ns_tag_property {
5077 0     0   0 my ($self, $o) = @_;
5078 0         0 my $tag = $o->{text};
5079 0         0 my $prefix;
5080 0 0       0 if ($tag =~ /^!<(.*)>$/) {
    0          
    0          
    0          
5081 0         0 $self->{tag} = $1;
5082             }
5083             elsif ($tag =~ /^!!(.*)/) {
5084 0 0       0 if (defined($prefix = $self->{tag_map}{'!!'})) {
5085 0         0 $self->{tag} = $prefix . substr($tag, 2);
5086             }
5087             else {
5088 0         0 $self->{tag} = "tag:yaml.org,2002:$1";
5089             }
5090             }
5091             elsif ($tag =~ /^(!.*?!)/) {
5092 0         0 $prefix = $self->{tag_map}{$1};
5093 0 0       0 if (defined $prefix) {
5094 0         0 $self->{tag} = $prefix . substr($tag, length($1));
5095             }
5096             else {
5097 0         0 die "No %TAG entry for '$prefix'";
5098             }
5099             }
5100             elsif (defined($prefix = $self->{tag_map}{'!'})) {
5101 0         0 $self->{tag} = $prefix . substr($tag, 1);
5102             }
5103             else {
5104 0         0 $self->{tag} = $tag;
5105             }
5106 0         0 $self->{tag} =~ s/%([0-9a-fA-F]{2})/chr(hex($1))/eg;
  0         0  
5107             }
5108              
5109             sub got__c_ns_alias_node {
5110 0     0   0 my ($self, $o) = @_;
5111 0         0 my $name = $o->{text};
5112 0         0 $name =~ s/^\*//;
5113 0         0 $self->add(alias_event($name));
5114             }
5115              
5116             1;
5117              
5118             # vim: sw=2:
5119              
5120              
5121 2     2   49 use v5.12;
  2         8  
5122             package PerlYamlReferenceParserTestReceiver;
5123 2     2   15 use base 'PerlYamlReferenceParserReceiver';
  2         5  
  2         1112  
5124              
5125 2     2   19 use PerlYamlReferenceParserPrelude;
  2         5  
  2         1607  
5126              
5127             my $event_map = {
5128             stream_start => '+STR',
5129             stream_end => '-STR',
5130             document_start => '+DOC',
5131             document_end => '-DOC',
5132             mapping_start => '+MAP',
5133             mapping_end => '-MAP',
5134             sequence_start => '+SEQ',
5135             sequence_end => '-SEQ',
5136             scalar => '=VAL',
5137             alias => '=ALI',
5138             };
5139              
5140             my $style_map = {
5141             plain => ':',
5142             single => "'",
5143             double => '"',
5144             literal => '|',
5145             folded => '>',
5146             };
5147              
5148             sub output {
5149 1     1   2 my ($self) = @_;
5150             join '', map {
5151 13         30 my $type = $event_map->{$_->{event}};
5152 13         19 my @event = ($type);
5153 13 50 66     26 push @event, '---' if $type eq '+DOC' and $_->{explicit};
5154 13 50 66     37 push @event, '...' if $type eq '-DOC' and $_->{explicit};
5155 13 50 66     38 push @event, '{}' if $type eq '+MAP' and $_->{flow};
5156 13 50 66     32 push @event, '[]' if $type eq '+SEQ' and $_->{flow};
5157 13 50       33 push @event, "&$_->{anchor}" if $_->{anchor};
5158 13 50       24 push @event, "<$_->{tag}>" if $_->{tag};
5159 13 50       20 push @event, "*$_->{name}" if $_->{name};
5160 13 100       25 if (exists $_->{value}) {
5161 5         10 my $style = $style_map->{$_->{style}};
5162 5         10 my $value = $_->{value};
5163 5         8 $value =~ s/\\/\\\\/g;
5164 5         7 $value =~ s/\x08/\\b/g;
5165 5         8 $value =~ s/\t/\\t/g;
5166 5         10 $value =~ s/\n/\\n/g;
5167 5         7 $value =~ s/\r/\\r/g;
5168 5         10 push @event, "$style$value";
5169             }
5170 13         39 join(' ', @event) . "\n";
5171 1         3 } @{$self->{event}};
  1         5  
5172             }
5173              
5174             1;
5175              
5176             # vim: sw=2:
5177