File Coverage

blib/lib/YAML/Parser.pm
Criterion Covered Total %
statement 944 1423 66.3
branch 152 288 52.7
condition 74 129 57.3
subroutine 277 417 66.4
pod 0 70 0.0
total 1447 2327 62.1


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   69784 use v5.12;
  2         14  
6             package YAML::Parser;
7              
8             our $VERSION = '0.0.4';
9              
10 2     2   972 use XXX;
  2         3021  
  2         8  
11              
12             sub new {
13 2     2 0 88 my ($class, %self) = @_;
14              
15 2         10 my $self = bless {
16             %self,
17             }, $class;
18              
19 2 100       14 if (not defined $self->{receiver}) {
20 1         3 $self->{events} = [];
21             $self->{receiver} = PerlYamlReferenceParserReceiver->new(
22             callback => sub {
23 13     13   24 my ($event) = @_;
24 13         15 push @{$self->{events}}, $event;
  13         39  
25             },
26 1         10 );
27             }
28              
29 2         8 return $self;
30             }
31              
32             sub parse {
33 2     2 0 16 my ($self, $yaml_string) = @_;
34             $self->{parser} = PerlYamlReferenceParserParser->new(
35             $self->{receiver},
36 2         16 );
37 2         9 $self->{parser}->parse($yaml_string);
38 2         20 return $self;
39             }
40              
41             sub receiver {
42 1     1 0 4 my ($self) = @_;
43 1         6 return $self->{parser}{receiver};
44             }
45              
46             sub events {
47 1     1 0 2 my ($self) = @_;
48 1         2 return @{$self->{events}};
  1         7  
49             }
50              
51             BEGIN {
52 2     2   711 $INC{'PerlYamlReferenceParserParser.pm'} = __FILE__;
53 2         5 $INC{'PerlYamlReferenceParserGrammar.pm'} = __FILE__;
54 2         65 $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   60 use v5.12;
  2         8  
64              
65             package PerlYamlReferenceParserFunc;
66             use overload
67 104     104   249 eq => sub { 0 },
68 2     2   1192 bool => sub { 1 };
  2     0   992  
  2         19  
  0         0  
69             sub new {
70 9184     9184   16283 my ($class, $func, $name, $trace, $num) = @_;
71 9184   66     52720 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   1184 use boolean;
  2         2208  
  2         8  
84 2     2   133 use Carp;
  2         4  
  2         97  
85 2     2   2268 use Encode;
  2         21771  
  2         144  
86 2     2   14 use Exporter 'import';
  2         3  
  2         51  
87 2     2   1577 use JSON::PP;
  2         31884  
  2         144  
88 2     2   1733 use Time::HiRes qw< gettimeofday tv_interval >;
  2         2838  
  2         9  
89 2     2   1313 use YAML::PP::Perl;
  2         149344  
  2         107  
90 2     2   17 use XXX;
  2         5  
  2         13  
91              
92 2     2   163 use constant DEBUG => $ENV{DEBUG};
  2         5  
  2         275  
93              
94 2     2   9 our @EXPORT;
95 30     30 0 67 sub export { push @EXPORT, @_ }
96              
97 2         19 export qw< true false >;
98              
99 2         25 export 'rule';
100             sub rule {
101 424     424 0 778 my ($num, $name, $func) = @_;
102 424         919 my ($pkg) = caller;
103             {
104 2     2   14 no strict 'refs';
  2         6  
  2         2819  
  424         613  
105 424         510 *{"${pkg}::$name"} = $func;
  424         1915  
106             }
107 424         818 $func = name($name, $func);
108 424         786 $func->{num} = $num;
109 424         836 return $func;
110             }
111              
112 2         9 export 'name';
113             sub name {
114 5526     5526 0 11639 my ($name, $func, $trace) = (@_, '');
115 5526         7139 my $f = $func;
116 5526         6548 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         10905 return PerlYamlReferenceParserFunc->new($f, $name, $trace);
125             }
126              
127 2         6 export qw;
128 6478     6478 0 13494 sub isNull { not defined $_[0] }
129 6488     6488 0 22314 sub isBoolean { ref($_[0]) eq 'boolean' }
130 6558 100   6558 0 19930 sub isNumber { not(ref $_[0]) and $_[0] =~ /^-?\d+$/ }
131 9178   100 9178 0 33803 sub isString { not(ref $_[0]) and $_[0] !~ /^-?\d+$/ }
132 19128     19128 0 50297 sub isFunction { ref($_[0]) eq 'PerlYamlReferenceParserFunc' }
133 16494     16494 0 42702 sub isArray { ref($_[0]) eq 'ARRAY' }
134 2798     2798 0 5426 sub isObject { ref($_[0]) eq 'HASH' }
135              
136 2         6 export 'typeof';
137             sub typeof {
138 6478     6478 0 10371 my ($value) = @_;
139 6478 50       9533 return 'null' if isNull $value;
140 6478 100       10667 return 'boolean' if isBoolean $value;
141 18 100       39 return 'number' if isNumber $value;
142 6 50       14 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         19 my $json = JSON::PP->new->canonical->allow_unknown->allow_nonref->convert_blessed;
150             sub json_stringify {
151 2752     2752 0 3686 my $string;
152 2752         3923 eval {
153 2752         7517 $string = $json->encode($_[0]);
154             };
155 2752 50       180531 confess $@ if $@;
156 2752         5356 return $string;
157             }
158              
159 2         287 export 'stringify';
160             sub stringify;
161             sub stringify {
162 2982     2982 0 4930 my ($o) = @_;
163 2982 100       6416 if ($o eq "\x{feff}") {
164 80         303 return "\\uFEFF";
165             }
166 2902 100       4631 if (isFunction $o) {
167 104         417 return "\@$o->{trace}";
168             }
169 2798 100       4888 if (isObject $o) {
170 72         531 return json_stringify [ sort keys %$o ];
171             }
172 2726 100       4430 if (isArray $o) {
173 46         70 return "[${\ join ',', map stringify($_), @$o}]";
  46         148  
174             }
175 2680 100       4595 if (isString $o) {
176 2630         5114 $_ = json_stringify $o;
177 2630         12337 s/^"(.*)"$/$1/;
178 2630         10888 return $_;
179             }
180 50         115 return json_stringify $o;
181             }
182              
183 2         6 export 'hex_char';
184             sub hex_char {
185 788     788 0 2024 my ($chr) = @_;
186 788         3348 return sprintf "x%x", ord $chr;
187             }
188              
189 2         4 export 'func';
190             sub func {
191 3658     3658 0 6121 my ($self, $name) = @_;
192 3658 50       10677 my $func = $self->can($name) or
193             die "Can't find parser function '$name'";
194 3658         6900 PerlYamlReferenceParserFunc->new($func, $name);
195             }
196              
197 2         5 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         5 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         15 *yyy = \&yyy;
219 2         4 *zzz = \&zzz;
220              
221 2         6 export 'dump';
222             sub dump {
223 0     0 0 0 YAML::PP::Perl->new->dump(@_);
224             }
225              
226 2         24 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         53 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   26 use v5.12;
  2         7  
253             package PerlYamlReferenceParserGrammar;
254 2     2   16 use PerlYamlReferenceParserPrelude;
  2         3  
  2         274  
255              
256 2     2   15 use constant DEBUG => $ENV{DEBUG};
  2         4  
  2         29591  
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   164 my ($self) = @_;
272 82         110 debug_rule("c_printable") if DEBUG;
273 82         177 $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   155 my ($self) = @_;
308 80         125 debug_rule("c_byte_order_mark") if DEBUG;
309 80         188 $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   36 my ($self) = @_;
541 14         26 debug_rule("c_indicator") if DEBUG;
542 14         39 $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         10 debug_rule("c_flow_indicator") if DEBUG;
574 8         26 $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   269 my ($self) = @_;
591 152         197 debug_rule("b_line_feed") if DEBUG;
592 152         288 $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   376 my ($self) = @_;
603 216         257 debug_rule("b_carriage_return") if DEBUG;
604 216         446 $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   161 my ($self) = @_;
615 82         108 debug_rule("b_char") if DEBUG;
616 82         212 $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   142 my ($self) = @_;
630 82         104 debug_rule("nb_char") if DEBUG;
631 82         205 $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   141 my ($self) = @_;
648 70         93 debug_rule("b_break") if DEBUG;
649 70         165 $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   32 my ($self) = @_;
667 16         23 debug_rule("b_as_line_feed") if DEBUG;
668 16         41 $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   107 my ($self) = @_;
679 46         65 debug_rule("b_non_content") if DEBUG;
680 46         111 $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   334 my ($self) = @_;
691 202         269 debug_rule("s_space") if DEBUG;
692 202         399 $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   268 my ($self) = @_;
703 142         173 debug_rule("s_tab") if DEBUG;
704 142         325 $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   272 my ($self) = @_;
715 168         213 debug_rule("s_white") if DEBUG;
716 168         378 $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         68 debug_rule("ns_char") if DEBUG;
731 50         129 $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   55 my ($self, $n) = @_;
1174 28         42 debug_rule("s_indent",$n) if DEBUG;
1175 28         127 $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   10 my ($self, $n) = @_;
1186 4         8 debug_rule("s_indent_lt",$n) if DEBUG;
1187 4         14 $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   7 my ($self, $n) = @_;
1203 2         3 debug_rule("s_indent_le",$n) if DEBUG;
1204 2         10 $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   138 my ($self) = @_;
1220 72         89 debug_rule("s_separate_in_line") if DEBUG;
1221 72         184 $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   21 my ($self, $n, $c) = @_;
1238 8         14 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         11 debug_rule("s_block_line_prefix",$n) if DEBUG;
1259 8         26 [ $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   11 my ($self, $n) = @_;
1271 4         5 debug_rule("s_flow_line_prefix",$n) if DEBUG;
1272 4         13 $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   21 my ($self, $n, $c) = @_;
1287 8         13 debug_rule("l_empty",$n,$c) if DEBUG;
1288 8         23 $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   15 my ($self, $n, $c) = @_;
1305 4         7 debug_rule("b_l_trimmed",$n,$c) if DEBUG;
1306 4         17 $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   12 my ($self) = @_;
1320 4         7 debug_rule("b_as_space") if DEBUG;
1321 4         14 $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   16 my ($self, $n, $c) = @_;
1332 4         6 debug_rule("b_l_folded",$n,$c) if DEBUG;
1333 4         17 $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   13 my ($self, $n) = @_;
1349 4         9 debug_rule("s_flow_folded",$n) if DEBUG;
1350 4         15 $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   66 my ($self) = @_;
1365 26         43 debug_rule("c_nb_comment_text") if DEBUG;
1366 26         69 $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   87 my ($self) = @_;
1380 40         62 debug_rule("b_comment") if DEBUG;
1381 40         97 $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   65 my ($self) = @_;
1397 28         36 debug_rule("s_b_comment") if DEBUG;
1398 28         79 $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   31 my ($self) = @_;
1417 12         18 debug_rule("l_comment") if DEBUG;
1418 12         44 $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   64 my ($self) = @_;
1434 26         35 debug_rule("s_l_comments") if DEBUG;
1435 26         59 $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   58 my ($self, $n, $c) = @_;
1457 20         28 debug_rule("s_separate",$n,$c) if DEBUG;
1458 20         63 $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   44 my ($self, $n) = @_;
1481 20         26 debug_rule("s_separate_lines",$n) if DEBUG;
1482 20         60 $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   5 my ($self) = @_;
1503 2         4 debug_rule("l_directive") if DEBUG;
1504 2         7 $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   65 my ($self) = @_;
1627 26         37 debug_rule("c_tag_handle") if DEBUG;
1628 26         106 $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   74 my ($self) = @_;
1643 26         41 debug_rule("c_primary_tag_handle") if DEBUG;
1644 26         70 $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   70 my ($self) = @_;
1655 26         43 debug_rule("c_secondary_tag_handle") if DEBUG;
1656 26         74 $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   70 my ($self) = @_;
1670 26         35 debug_rule("c_named_tag_handle") if DEBUG;
1671 26         78 $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   70 my ($self, $n, $c) = @_;
1734 22         35 debug_rule("c_ns_properties",$n,$c) if DEBUG;
1735 22         62 $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   59 my ($self) = @_;
1765 26         41 debug_rule("c_ns_tag_property") if DEBUG;
1766 26         80 $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         44 debug_rule("c_verbatim_tag") if DEBUG;
1782 26         69 $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   55 my ($self) = @_;
1798 26         47 debug_rule("c_ns_shorthand_tag") if DEBUG;
1799 26         73 $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   67 my ($self) = @_;
1813 26         40 debug_rule("c_non_specific_tag") if DEBUG;
1814 26         55 $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   69 my ($self) = @_;
1825 26         40 debug_rule("c_ns_anchor_property") if DEBUG;
1826 26         68 $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   40 my ($self) = @_;
1867 16         26 debug_rule("c_ns_alias_node") if DEBUG;
1868 16         49 $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         8 debug_rule("e_scalar") if DEBUG;
1883 6         18 $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   14 my ($self) = @_;
1894 6         11 debug_rule("e_node") if DEBUG;
1895 6         23 $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         15 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   36 my ($self, $n, $c) = @_;
2136 10         14 debug_rule("c_single_quoted",$n,$c) if DEBUG;
2137 10         37 $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   51 my ($self, $c) = @_;
2249 16         29 debug_rule("ns_plain_first",$c) if DEBUG;
2250 16         53 $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   59 my ($self, $c) = @_;
2277 24         33 debug_rule("ns_plain_safe",$c) if DEBUG;
2278 24         67 $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   43 my ($self) = @_;
2297 16         32 debug_rule("ns_plain_safe_out") if DEBUG;
2298 16         38 $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   117 my ($self) = @_;
2309 8         14 debug_rule("ns_plain_safe_in") if DEBUG;
2310 8         28 $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   48 my ($self, $c) = @_;
2326 20         43 debug_rule("ns_plain_char",$c) if DEBUG;
2327 20         58 $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   48 my ($self, $n, $c) = @_;
2355 16         31 debug_rule("ns_plain",$n,$c) if DEBUG;
2356 16         50 $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   43 my ($self, $c) = @_;
2376 12         17 debug_rule("nb_ns_plain_in_line",$c) if DEBUG;
2377 12         49 $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   52 my ($self, $c) = @_;
2393 16         26 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   15 my ($self, $n, $c) = @_;
2409 4         7 debug_rule("s_ns_plain_next_line",$n,$c) if DEBUG;
2410 4         17 $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   19 my ($self, $n, $c) = @_;
2426 6         12 debug_rule("ns_plain_multi_line",$n,$c) if DEBUG;
2427 6         20 $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         5 debug_rule("in_flow",$c) if DEBUG;
2445 2         13 $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   36 my ($self, $n, $c) = @_;
2465 12         26 debug_rule("c_flow_sequence",$n,$c) if DEBUG;
2466 12         38 $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   13 my ($self, $n, $c) = @_;
2485 4         8 debug_rule("ns_s_flow_seq_entries",$n,$c) if DEBUG;
2486 4         13 $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   13 my ($self, $n, $c) = @_;
2506 4         8 debug_rule("ns_flow_seq_entry",$n,$c) if DEBUG;
2507 4         14 $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   50 my ($self, $n, $c) = @_;
2522 10         22 debug_rule("c_flow_mapping",$n,$c) if DEBUG;
2523 10         29 $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   13 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   25 my ($self, $n, $c) = @_;
2672 8         12 debug_rule("c_ns_flow_map_separate_value",$n,$c) if DEBUG;
2673 8         24 $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   13 my ($self, $n, $c) = @_;
2744 4         8 debug_rule("ns_flow_pair",$n,$c) if DEBUG;
2745 4         18 $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   16 my ($self, $n, $c) = @_;
2773 4         6 debug_rule("ns_flow_pair_entry",$n,$c) if DEBUG;
2774 4         11 $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         7 debug_rule("ns_flow_pair_yaml_key_entry",$n,$c) if DEBUG;
2791 4         13 $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   28 my ($self, $n, $c) = @_;
2806 4         10 debug_rule("c_ns_flow_pair_json_key_entry",$n,$c) if DEBUG;
2807 4         14 $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   31 my ($self, $c) = @_;
2823 10         22 debug_rule("ns_s_implicit_yaml_key",$c) if DEBUG;
2824 10         33 $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   35 my ($self, $c) = @_;
2841 10         12 debug_rule("c_s_implicit_json_key",$c) if DEBUG;
2842 10         41 $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   43 my ($self, $n, $c) = @_;
2857 16         26 debug_rule("ns_flow_yaml_content",$n,$c) if DEBUG;
2858 16         40 [ $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   36 my ($self, $n, $c) = @_;
2870 12         26 debug_rule("c_flow_json_content",$n,$c) if DEBUG;
2871 12         41 $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   17 my ($self, $n, $c) = @_;
2887 6         14 debug_rule("ns_flow_content",$n,$c) if DEBUG;
2888 6         20 $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         15 debug_rule("ns_flow_yaml_node",$n,$c) if DEBUG;
2908 10         32 $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         26 debug_rule("c_flow_json_node",$n,$c) if DEBUG;
2935 10         34 $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   22 my ($self, $n, $c) = @_;
2958 6         15 debug_rule("ns_flow_node",$n,$c) if DEBUG;
2959 6         23 $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   9 my ($self, $n) = @_;
2987 2         5 debug_rule("c_b_block_header",$n) if DEBUG;
2988 2         7 $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         6 debug_rule("c_indentation_indicator",$n) if DEBUG;
3029 2         9 $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   7 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   7 my ($self, $t) = @_;
3063 2         5 debug_rule("b_chomped_last",$t) if DEBUG;
3064 2         9 $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   8 my ($self, $n, $t) = @_;
3084 2         4 debug_rule("l_chomped_empty",$n,$t) if DEBUG;
3085 2         6 $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   7 my ($self, $n) = @_;
3104 2         5 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         5 debug_rule("l_trail_comments",$n) if DEBUG;
3142 2         6 $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         8 debug_rule("c_l_literal",$n) if DEBUG;
3160 6         23 $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   18 my ($self, $n) = @_;
3176 8         12 debug_rule("l_nb_literal_text",$n) if DEBUG;
3177 8         24 $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   13 my ($self, $n) = @_;
3193 6         11 debug_rule("b_nb_literal_next",$n) if DEBUG;
3194 6         19 $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         3 debug_rule("l_literal_content",$n,$t) if DEBUG;
3212 2         40 $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   9 my ($self, $n) = @_;
3232 4         8 debug_rule("c_l_folded",$n) if DEBUG;
3233 4         13 $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   8 my ($self, $n) = @_;
3400 2 50       10 my $m = $self->call([$self->func('auto_detect_indent'), $n], 'number') or return false;
3401 2         6 debug_rule("l_block_sequence",$n) if DEBUG;
3402 2         10 $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   5 my ($self, $n) = @_;
3420 2         4 debug_rule("c_l_block_seq_entry",$n) if DEBUG;
3421 2         8 $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       8 my $m = $self->call([$self->func('auto_detect_indent'), $n], 'number') or return false;
3489 2         7 debug_rule("l_block_mapping",$n) if DEBUG;
3490 2         10 $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   19 my ($self, $n) = @_;
3508 6         19 debug_rule("ns_l_block_map_entry",$n) if DEBUG;
3509 6         64 $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   16 my ($self, $n) = @_;
3525 6         12 debug_rule("c_l_block_map_explicit_entry",$n) if DEBUG;
3526 6         19 $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   20 my ($self, $n) = @_;
3544 6         15 debug_rule("c_l_block_map_explicit_key",$n) if DEBUG;
3545 6         21 $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   19 my ($self, $n) = @_;
3587 6         11 debug_rule("ns_l_block_map_implicit_entry",$n) if DEBUG;
3588 6         22 $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         11 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   144 my ($self, $n) = @_;
3623 6         12 debug_rule("c_l_block_map_implicit_value",$n) if DEBUG;
3624 6         21 $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   20 my ($self, $n, $c) = @_;
3664 6         9 debug_rule("s_l_block_node",$n,$c) if DEBUG;
3665 6         19 $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         8 $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   20 my ($self, $n, $c) = @_;
3696 6         11 debug_rule("s_l_block_in_block",$n,$c) if DEBUG;
3697 6         28 $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   20 my ($self, $n, $c) = @_;
3713 6         9 debug_rule("s_l_block_scalar",$n,$c) if DEBUG;
3714 6         18 $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   13 my ($self, $n, $c) = @_;
3740 4         7 debug_rule("s_l_block_collection",$n,$c) if DEBUG;
3741 4         15 $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         11 $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   9 my ($self) = @_;
3795 4         8 debug_rule("l_document_prefix") if DEBUG;
3796 4         13 $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   12 my ($self) = @_;
3810 4         8 debug_rule("c_directives_end") if DEBUG;
3811 4         14 $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   36 my ($self) = @_;
3834 2         5 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   7 my ($self) = @_;
3850 2         5 debug_rule("l_document_suffix") if DEBUG;
3851 2         8 $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   4 my ($self) = @_;
3891 2         4 debug_rule("l_bare_document") if DEBUG;
3892 2         7 $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         7 debug_rule("l_explicit_document") if DEBUG;
3909 4         13 $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   5 my ($self) = @_;
3930 2         3 debug_rule("l_directive_document") if DEBUG;
3931 2         9 $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         7 $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   6 my ($self) = @_;
3966 2         3 debug_rule("l_yaml_stream") if DEBUG;
3967 2         7 $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   32 use v5.12;
  2         9  
3996              
3997             package PerlYamlReferenceParserParser;
3998              
3999 2     2   13 use Encode;
  2         4  
  2         202  
4000 2     2   14 use PerlYamlReferenceParserPrelude;
  2         13  
  2         290  
4001 2     2   16 use PerlYamlReferenceParserGrammar;
  2         4  
  2         80  
4002              
4003 2     2   12 use base 'PerlYamlReferenceParserGrammar';
  2         5  
  2         240  
4004              
4005 2     2   14 use constant TRACE => $ENV{TRACE};
  2         5  
  2         11452  
4006              
4007 0     0 0 0 sub receiver { $_[0]->{receiver} }
4008              
4009             sub new {
4010 2     2 0 7 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         28 $receiver->{parser} = $self;
4025              
4026 2         7 return $self;
4027             }
4028              
4029             sub parse {
4030 2     2 0 7 my ($self, $input) = @_;
4031              
4032 2 50       20 $input = decode_utf8($input)
4033             unless Encode::is_utf8($input);
4034 2         100 $self->{input} = $input;
4035              
4036 2         8 $self->{end} = length $self->{input};
4037              
4038 2         3 $self->{trace_on} = not $self->trace_start if TRACE;
4039              
4040 2         5 my $ok;
4041 2         5 eval {
4042 2         8 $ok = $self->call($self->func('TOP'));
4043 2         22 $self->trace_flush;
4044             };
4045 2 50       6 if ($@) {
4046 0         0 $self->trace_flush;
4047 0         0 die $@;
4048             }
4049              
4050 2 50       6 die "Parser failed" if not $ok;
4051             die "Parser finished before end of input"
4052 2 50       21 if $self->{pos} < $self->{end};
4053              
4054 2         5 return true;
4055             }
4056              
4057             sub state_curr {
4058 16522     16522 0 25842 my ($self) = @_;
4059 16522 100       41458 $self->{state}[-1] || {
4060             name => undef,
4061             doc => false,
4062             lvl => 0,
4063             beg => 0,
4064             end => 0,
4065             m => undef,
4066             t => undef,
4067             };
4068             }
4069              
4070             sub state_prev {
4071 4     4 0 9 my ($self) = @_;
4072 4         8 $self->{state}[-2]
4073             }
4074              
4075             sub state_push {
4076 6484     6484 0 10322 my ($self, $name) = @_;
4077              
4078 6484         11383 my $curr = $self->state_curr;
4079              
4080 6484         28768 push @{$self->{state}}, {
4081             name => $name,
4082             doc => $curr->{doc},
4083             lvl => $curr->{lvl} + 1,
4084             beg => $self->{pos},
4085             end => undef,
4086             m => $curr->{m},
4087             t => $curr->{t},
4088 6484         8927 };
4089             }
4090              
4091             sub state_pop {
4092 6484     6484 0 9162 my ($self) = @_;
4093 6484         7612 my $child = pop @{$self->{state}};
  6484         10625  
4094 6484         10108 my $curr = $self->state_curr;
4095 6484 50       11471 return unless defined $curr;
4096 6484         9216 $curr->{beg} = $child->{beg};
4097 6484         14746 $curr->{end} = $self->{pos};
4098             }
4099              
4100             sub call {
4101 6486     6486 0 11245 my ($self, $func, $type) = @_;
4102 6486   100     22332 $type //= 'boolean';
4103              
4104 6486         9731 my $args = [];
4105 6486 100       10970 ($func, @$args) = @$func if isArray $func;
4106              
4107 6486 100 66     12623 return $func if isNumber $func or isString $func;
4108              
4109 6484 50       11326 FAIL "Bad call type '${\ typeof $func}' for '$func'"
  0         0  
4110             unless isFunction $func;
4111              
4112 6484   33     14934 my $trace = $func->{trace} //= $func->{name};
4113              
4114 6484         14800 $self->state_push($trace);
4115              
4116 6484         10919 $self->{trace_num}++;
4117 6484         8463 $self->trace('?', $trace, $args) if TRACE;
4118              
4119 6484 100       12979 if ($func->{name} eq 'l_bare_document') {
4120 2         7 $self->state_curr->{doc} = true;
4121             }
4122              
4123             @$args = map {
4124 6484         10717 isArray($_) ? $self->call($_, 'any') :
4125 774 100       1206 isFunction($_) ? $_->{func}->() :
    100          
4126             $_;
4127             } @$args;
4128              
4129 6484         9021 my $pos = $self->{pos};
4130 6484         14695 $self->receive($func, 'try', $pos);
4131              
4132 6484         14979 my $value = $func->{func}->($self, @$args);
4133 6484   100     19116 while (isFunction($value) or isArray($value)) {
4134 2446         5948 $value = $self->call($value);
4135             }
4136              
4137 6484 50 66     15771 FAIL "Calling '$trace' returned '${\ typeof($value)}' instead of '$type'"
  0         0  
4138             if $type ne 'any' and typeof($value) ne $type;
4139              
4140 6484         9629 $self->{trace_num}++;
4141 6484 100       10966 if ($type ne 'boolean') {
4142 24         39 $self->trace('>', $value) if TRACE;
4143             }
4144             else {
4145 6460 100       12831 if ($value) {
4146 1906         12238 $self->trace('+', $trace) if TRACE;
4147 1906         3353 $self->receive($func, 'got', $pos);
4148             }
4149             else {
4150 4554         28807 $self->trace('x', $trace) if TRACE;
4151 4554         8194 $self->receive($func, 'not', $pos);
4152             }
4153             }
4154              
4155 6484         14190 $self->state_pop;
4156 6484         32761 return $value;
4157             }
4158              
4159             sub receive {
4160 12944     12944 0 20876 my ($self, $func, $type, $pos) = @_;
4161              
4162 12944   66     30538 $func->{receivers} //= $self->make_receivers;
4163 12944         20680 my $receiver = $func->{receivers}{$type};
4164 12944 100       26280 return unless $receiver;
4165              
4166             $receiver->($self->{receiver}, {
4167 186         582 text => substr($self->{input}, $pos, $self->{pos}-$pos),
4168             state => $self->state_curr,
4169             start => $pos,
4170             });
4171             }
4172              
4173             sub make_receivers {
4174 6376     6376 0 9839 my ($self) = @_;
4175 6376         8207 my $i = @{$self->{state}};
  6376         9309  
4176 6376         10268 my $names = [];
4177 6376         8134 my $n;
4178 6376   100     28467 while ($i > 0 and not(($n = $self->{state}[--$i]{name}) =~ /_/)) {
4179 5764 100       13246 if ($n =~ /^chr\((.)\)$/) {
4180 788         1572 $n = hex_char $1;
4181             }
4182             else {
4183 4976         12292 $n =~ s/\(.*//;
4184             }
4185 5764         26326 unshift @$names, $n;
4186             }
4187 6376         15222 my $name = join '__', $n, @$names;
4188              
4189             return {
4190             try => $self->{receiver}->can("try__$name"),
4191             got => $self->{receiver}->can("got__$name"),
4192 6376         66669 not => $self->{receiver}->can("not__$name"),
4193             };
4194             }
4195              
4196             # Match all subrule methods:
4197             sub all {
4198 864     864 0 2040 my ($self, @funcs) = @_;
4199             name all => sub {
4200 754     754   1102 my $pos = $self->{pos};
4201 754         1398 for my $func (@funcs) {
4202 1074 50       3967 FAIL '*** Missing function in @all group:', \@funcs
4203             unless defined $func;
4204              
4205 1074 100       2249 if (not $self->call($func)) {
4206 612         4640 $self->{pos} = $pos;
4207 612         1078 return false;
4208             }
4209             }
4210              
4211 142         1151 return true;
4212 864         3136 };
4213             }
4214              
4215             # Match any subrule method. Rules are tried in order and stops on first match:
4216             sub any {
4217 886     886 0 2195 my ($self, @funcs) = @_;
4218             name any => sub {
4219 818     818   1656 for my $func (@funcs) {
4220 2042 100       11085 if ($self->call($func)) {
4221 322         2328 return true;
4222             }
4223             }
4224              
4225 496         3981 return false;
4226 886         3208 };
4227             }
4228              
4229             sub may {
4230 6     6 0 13 my ($self, $func) = @_;
4231             name may => sub {
4232 6     6   38 $self->call($func);
4233 6         21 };
4234             }
4235              
4236             # Repeat a rule a certain number of times:
4237             sub rep {
4238 492     492 0 965 my ($self, $min, $max, $func) = @_;
4239             name rep => sub {
4240 274 50 66 274   778 return false if defined $max and $max < 0;
4241 274         437 my $count = 0;
4242 274         392 my $pos = $self->{pos};
4243 274         379 my $pos_start = $pos;
4244 274   100     751 while (not(defined $max) or $count < $max) {
4245 312 100       653 last unless $self->call($func);
4246 84 100       686 last if $self->{pos} == $pos;
4247 80         113 $count++;
4248 80         254 $pos = $self->{pos};
4249             }
4250 274 50 66     2339 if ($count >= $min and (not(defined $max) or $count <= $max)) {
      66        
4251 216         481 return true;
4252             }
4253 58         102 $self->{pos} = $pos_start;
4254 58         144 return false;
4255 492   100     2306 }, "rep($min,${\ ($max // 'null')})";
  492         2050  
4256             }
4257             sub rep2 {
4258 48     48 0 102 my ($self, $min, $max, $func) = @_;
4259             name rep2 => sub {
4260 22 50 66 22   85 return false if defined $max and $max < 0;
4261 22         39 my $count = 0;
4262 22         38 my $pos = $self->{pos};
4263 22         34 my $pos_start = $pos;
4264 22   100     93 while (not(defined $max) or $count < $max) {
4265 48 100       109 last unless $self->call($func);
4266 36 100       305 last if $self->{pos} == $pos;
4267 32         46 $count++;
4268 32         98 $pos = $self->{pos};
4269             }
4270 22 50 66     210 if ($count >= $min and (not(defined $max) or $count <= $max)) {
      66        
4271 22         50 return true;
4272             }
4273 0         0 $self->{pos} = $pos_start;
4274 0         0 return false;
4275 48   100     187 }, "rep2($min,${\ ($max // 'null')})";
  48         218  
4276             }
4277              
4278             # Call a rule depending on state value:
4279             sub case {
4280 72     72 0 163 my ($self, $var, $map) = @_;
4281             name case => sub {
4282 72     72   141 my $rule = $map->{$var};
4283 72 50       163 defined $rule or
4284             FAIL "Can't find '$var' in:", $map;
4285 72         153 $self->call($rule);
4286 72         349 }, "case($var,${\ stringify $map})";
  72         154  
4287             }
4288              
4289             # Call a rule depending on state value:
4290             sub flip {
4291 4     4 0 13 my ($self, $var, $map) = @_;
4292 4         12 my $value = $map->{$var};
4293 4 50       13 defined $value or
4294             FAIL "Can't find '$var' in:", $map;
4295 4 50       17 return $value if not ref $value;
4296 0         0 return $self->call($value, 'number');
4297             }
4298             name flip => \&flip;
4299              
4300             sub the_end {
4301 1894     1894 0 3123 my ($self) = @_;
4302             return (
4303             $self->{pos} >= $self->{end} or (
4304             $self->state_curr->{doc} and
4305             $self->start_of_line and
4306 1894   66     5895 substr($self->{input}, $self->{pos}) =~
4307             /^(?:---|\.\.\.)(?=\s|\z)/
4308             )
4309             );
4310             }
4311              
4312             # Match a single char:
4313             sub chr {
4314 2004     2004 0 3809 my ($self, $char) = @_;
4315             name chr => sub {
4316 1640 100   1640   3349 return false if $self->the_end;
4317 1554 50 100     29576 if (
      66        
      33        
4318             $self->{pos} >= $self->{end} or (
4319             $self->state_curr->{doc} and
4320             $self->start_of_line and
4321             substr($self->{input}, $self->{pos}) =~
4322             /^(?:---|\.\.\.)(?=\s|\z)/
4323             )
4324             ) {
4325 0         0 return false;
4326             }
4327 1554 100       23242 if (substr($self->{input}, $self->{pos}, 1) eq $char) {
4328 120         177 $self->{pos}++;
4329 120         239 return true;
4330             }
4331 1434         2704 return false;
4332 2004         7405 }, "chr(${\ stringify($char)})";
  2004         3999  
4333             }
4334              
4335             # Match a char in a range:
4336             sub rng {
4337 330     330 0 697 my ($self, $low, $high) = @_;
4338             name rng => sub {
4339 78 50   78   190 return false if $self->the_end;
4340 78 100 66     1651 if (
4341             $low le substr($self->{input}, $self->{pos}, 1) and
4342             substr($self->{input}, $self->{pos}, 1) le $high
4343             ) {
4344 76         138 $self->{pos}++;
4345 76         191 return true;
4346             }
4347 2         5 return false;
4348 330         1277 }, "rng(${\ stringify($low)},${\ stringify($high)})";
  330         661  
  330         621  
4349             }
4350              
4351             # Must match first rule but none of others:
4352             sub but {
4353 176     176 0 443 my ($self, @funcs) = @_;
4354             name but => sub {
4355 176 100   176   343 return false if $self->the_end;
4356 174         3130 my $pos1 = $self->{pos};
4357 174 100       440 return false unless $self->call($funcs[0]);
4358 166         1180 my $pos2 = $self->{pos};
4359 166         236 $self->{pos} = $pos1;
4360 166         493 for my $func (@funcs[1..$#funcs]) {
4361 250 100       1135 if ($self->call($func)) {
4362 24         196 $self->{pos} = $pos1;
4363 24         60 return false;
4364             }
4365             }
4366 142         1139 $self->{pos} = $pos2;
4367 142         297 return true;
4368             }
4369 176         893 }
4370              
4371             sub chk {
4372 84     84 0 202 my ($self, $type, $expr) = @_;
4373             name chk => sub {
4374 20     20   49 my $pos = $self->{pos};
4375 20 100       64 $self->{pos}-- if $type eq '<=';
4376 20         55 my $ok = $self->call($expr);
4377 20         39 $self->{pos} = $pos;
4378 20 50       52 return $type eq '!' ? not($ok) : $ok;
4379 84         343 }, "chk($type, ${\ stringify $expr})";
  84         163  
4380             }
4381              
4382             sub set {
4383 10     10 0 23 my ($self, $var, $expr) = @_;
4384             name set => sub {
4385 4     4   12 my $value = $self->call($expr, 'any');
4386 4 50       17 return false if $value == -1;
4387 4 50       11 $value = $self->auto_detect if $value eq 'auto-detect';
4388 4         12 my $state = $self->state_prev;
4389 4         12 $state->{$var} = $value;
4390 4 50       22 if ($state->{name} ne 'all') {
4391 4         11 my $size = @{$self->{state}};
  4         10  
4392 4         13 for (my $i = 3; $i < $size; $i++) {
4393 44 50       76 FAIL "failed to traverse state stack in 'set'"
4394             if $i > $size - 2;
4395 44         59 $state = $self->{state}[0 - $i];
4396 44         71 $state->{$var} = $value;
4397 44 100       99 last if $state->{name} eq 's_l_block_scalar';
4398             }
4399             }
4400 4         13 return true;
4401 10         45 }, "set('$var', ${\ stringify $expr})";
  10         22  
4402             }
4403              
4404             sub max {
4405 20     20 0 44 my ($self, $max) = @_;
4406             name max => sub {
4407 20     20   60 return true;
4408 20         81 };
4409             }
4410              
4411             sub exclude {
4412 2     2 0 5 my ($self, $rule) = @_;
4413             name exclude => sub {
4414 2     2   7 return true;
4415 2         8 };
4416             }
4417              
4418             sub add {
4419 48     48 0 105 my ($self, $x, $y) = @_;
4420             name add => sub {
4421 42 100   42   83 $y = $self->call($y, 'number') if isFunction $y;
4422 42 50       88 FAIL "y is '${\ stringify $y}', not number in 'add'"
  0         0  
4423             unless isNumber $y;
4424 42         152 return $x + $y;
4425 48         217 }, "add($x,${\ stringify $y})";
  48         110  
4426             }
4427              
4428             sub sub {
4429 2     2 0 6 my ($self, $x, $y) = @_;
4430             name sub => sub {
4431 0     0   0 return $x - $y;
4432 2         16 }, "sub($x,$y)";
4433             }
4434              
4435             # This method does not need to return a function since it is never
4436             # called in the grammar.
4437             sub match {
4438 6     6 0 14 my ($self) = @_;
4439 6         9 my $state = $self->{state};
4440 6         14 my $i = @$state - 1;
4441 6   66     31 while ($i > 0 && not defined $state->[$i]{end}) {
4442 18 50       53 FAIL "Can't find match" if $i == 1;
4443 18         42 $i--;
4444             }
4445              
4446 6         13 my ($beg, $end) = @{$self->{state}[$i]}{qw};
  6         16  
4447 6         24 return substr($self->{input}, $beg, ($end - $beg));
4448             }
4449             name match => \&match;
4450              
4451             sub len {
4452 6     6 0 13 my ($self, $str) = @_;
4453             name len => sub {
4454 6 50   6   16 $str = $self->call($str, 'string') unless isString($str);
4455 6         20 return length $str;
4456 6         25 };
4457             }
4458              
4459             sub ord {
4460 2     2 0 10 my ($self, $str) = @_;
4461             name ord => sub {
4462             # Should be `$self->call($str, 'string')`, but... Perl
4463 0 0   0   0 $str = $self->call($str, 'number') unless isString($str);
4464 0         0 return ord($str) - 48;
4465 2         13 };
4466             }
4467              
4468             sub if {
4469 10     10 0 22 my ($self, $test, $do_if_true) = @_;
4470             name if => sub {
4471 10 50   10   22 $test = $self->call($test, 'boolean') unless isBoolean $test;
4472 10 100       72 if ($test) {
4473 4         57 $self->call($do_if_true);
4474 4         9 return true;
4475             }
4476 6         48 return false;
4477 10         39 };
4478             }
4479              
4480             sub lt {
4481 4     4 0 12 my ($self, $x, $y) = @_;
4482             name lt => sub {
4483 4 50   4   10 $x = $self->call($x, 'number') unless isNumber($x);
4484 4 50       20 $y = $self->call($y, 'number') unless isNumber($y);
4485 4 50       19 return $x < $y ? true : false;
4486 4         14 }, "lt(${\ stringify $x},${\ stringify $y})";
  4         11  
  4         10  
4487             }
4488              
4489             sub le {
4490 2     2 0 7 my ($self, $x, $y) = @_;
4491             name le => sub {
4492 2 50   2   6 $x = $self->call($x, 'number') unless isNumber($x);
4493 2 50       12 $y = $self->call($y, 'number') unless isNumber($y);
4494 2 50       13 return $x <= $y ? true : false;
4495 2         10 }, "le(${\ stringify $x},${\ stringify $y})";
  2         7  
  2         7  
4496             }
4497              
4498             sub m {
4499 10     10 0 24 my ($self) = @_;
4500             name m => sub {
4501 2     2   7 $self->state_curr->{m};
4502 10         41 };
4503             }
4504              
4505             sub t {
4506 10     10 0 24 my ($self) = @_;
4507             name t => sub {
4508 2     2   8 $self->state_curr->{t};
4509 10         32 };
4510             }
4511              
4512             #------------------------------------------------------------------------------
4513             # Special grammar rules
4514             #------------------------------------------------------------------------------
4515             sub start_of_line {
4516 3364     3364 0 26198 my ($self) = @_;
4517             (
4518             $self->{pos} == 0 ||
4519             $self->{pos} >= $self->{end} ||
4520 3364 100 100     18283 substr($self->{input}, $self->{pos} - 1, 1) eq "\n"
4521             ) ? true : false;
4522             }
4523             name 'start_of_line', \&start_of_line;
4524              
4525             sub end_of_stream {
4526 34     34 0 58 my ($self) = @_;
4527 34 100       113 ($self->{pos} >= $self->{end}) ? true : false;
4528             }
4529             name 'end_of_stream', \&end_of_stream;
4530              
4531 10     10 0 143 sub empty { true }
4532             name 'empty', \∅
4533              
4534             sub auto_detect_indent {
4535 4     4 0 11 my ($self, $n) = @_;
4536 4         7 my $pos = $self->{pos};
4537 4   33     27 my $in_seq = ($pos > 0 && substr($self->{input}, $pos - 1, 1) =~ /^[\-\?\:]$/);
4538 4 50       29 substr($self->{input}, $pos) =~ /^
4539             (
4540             (?:
4541             \ *
4542             (?:\#.*)?
4543             \n
4544             )*
4545             )
4546             (\ *)
4547             /x or FAIL "auto_detect_indent";
4548 4         11 my $pre = $1;
4549 4         10 my $m = length($2);
4550 4 50 33     11 if ($in_seq and not length $pre) {
4551 0 0       0 $m++ if $n == -1;
4552             }
4553             else {
4554 4         8 $m -= $n;
4555             }
4556 4 50       9 $m = 0 if $m < 0;
4557 4         9 return $m;
4558             }
4559             name 'auto_detect_indent', \&auto_detect_indent;
4560              
4561             sub auto_detect {
4562 2     2 0 8 my ($self, $n) = @_;
4563 2 50       20 substr($self->{input}, $self->{pos}) =~ /^.*\n((?:\ *\n)*)(\ *)/
4564             or return 1;
4565 2         8 my $pre = $1;
4566 2         7 my $m = length($2) - $n;
4567 2 50       6 $m = 1 if $m < 1;
4568             # XXX change 'die' to 'error' for reporting parse errors
4569 2 50       40 die "Spaces found after indent in auto-detect (5LLU)"
4570             if $pre =~ /^.{$m}./m;
4571 2         8 return $m;
4572             }
4573             name 'auto_detect', \&auto_detect;
4574              
4575             #------------------------------------------------------------------------------
4576             # Trace debugging
4577             #------------------------------------------------------------------------------
4578             sub trace_start {
4579 0     0 0 0 '' || "$ENV{TRACE_START}";
4580             }
4581              
4582             sub trace_quiet {
4583 0 0   0 0 0 return [] if $ENV{DEBUG};
4584              
4585 0         0 my @small = (
4586             'b_as_line_feed',
4587             's_indent',
4588             'nb_char',
4589             );
4590              
4591 0         0 my @noisy = (
4592             'c_directives_end',
4593             'c_l_folded',
4594             'c_l_literal',
4595             'c_ns_alias_node',
4596             'c_ns_anchor_property',
4597             'c_ns_tag_property',
4598             'l_directive_document',
4599             'l_document_prefix',
4600             'ns_flow_content',
4601             'ns_plain',
4602             's_l_comments',
4603             's_separate',
4604             );
4605              
4606             return [
4607 0   0     0 split(',', ($ENV{TRACE_QUIET} || '')),
4608             @noisy,
4609             ];
4610             }
4611              
4612             sub trace {
4613 0     0 0 0 my ($self, $type, $call, $args) = @_;
4614 0   0     0 $args //= [];
4615              
4616 0 0       0 $call = "'$call'" if $call =~ /^($| |.* $)/;
4617 0 0 0     0 return unless $self->{trace_on} or $call eq $self->trace_start;
4618              
4619 0         0 my $level = $self->state_curr->{lvl};
4620 0         0 my $indent = ' ' x $level;
4621 0 0       0 if ($level > 0) {
4622 0         0 my $l = length "$level";
4623 0         0 $indent = "$level" . substr($indent, $l);
4624             }
4625              
4626 0         0 my $input = substr($self->{input}, $self->{pos});
4627 0 0       0 $input = substr($input, 0, 30) . '…'
4628             if length($input) > 30;
4629 0         0 $input =~ s/\t/\\t/g;
4630 0         0 $input =~ s/\r/\\r/g;
4631 0         0 $input =~ s/\n/\\n/g;
4632              
4633             my $line = sprintf(
4634             "%s%s %-40s %4d '%s'\n",
4635             $indent,
4636             $type,
4637             $self->trace_format_call($call, $args),
4638             $self->{pos},
4639 0         0 $input,
4640             );
4641              
4642 0 0       0 if ($ENV{DEBUG}) {
4643             warn sprintf "%6d %s",
4644 0         0 $self->{trace_num}, $line;
4645 0         0 return;
4646             }
4647              
4648 0         0 my $trace_info = undef;
4649 0         0 $level = "${level}_$call";
4650 0 0 0     0 if ($type eq '?' and not $self->{trace_off}) {
4651 0         0 $trace_info = [$type, $level, $line, $self->{trace_num}];
4652             }
4653 0 0       0 if (grep $_ eq $call, @{$self->trace_quiet}) {
  0         0  
4654 0 0       0 $self->{trace_off} += $type eq '?' ? 1 : -1;
4655             }
4656 0 0 0     0 if ($type ne '?' and not $self->{trace_off}) {
4657 0         0 $trace_info = [$type, $level, $line, $self->{trace_num}];
4658             }
4659              
4660 0 0       0 if (defined $trace_info) {
4661             my ($prev_type, $prev_level, $prev_line, $trace_num) =
4662 0         0 @{$self->{trace_info}};
  0         0  
4663 0 0 0     0 if ($prev_type eq '?' and $prev_level eq $level) {
4664 0         0 $trace_info->[1] = '';
4665 0 0       0 if ($line =~ /^\d*\ *\+/) {
4666 0         0 $prev_line =~ s/\?/=/;
4667             }
4668             else {
4669 0         0 $prev_line =~ s/\?/!/;
4670             }
4671             }
4672 0 0       0 if ($prev_level) {
4673             warn sprintf "%5d %6d %s",
4674 0         0 ++$self->{trace_line}, $trace_num, $prev_line;
4675             }
4676              
4677 0         0 $self->{trace_info} = $trace_info;
4678             }
4679              
4680 0 0       0 if ($call eq $self->trace_start) {
4681 0         0 $self->{trace_on} = not $self->{trace_on};
4682             }
4683             }
4684              
4685             sub trace_format_call {
4686 0     0 0 0 my ($self, $call, $args) = @_;
4687 0 0       0 return $call unless @$args;
4688 0         0 my $list = join ',', map stringify($_), @$args;
4689 0         0 return "$call($list)";
4690             }
4691              
4692             sub trace_flush {
4693 2     2 0 5 my ($self) = @_;
4694 2         7 my ($type, $level, $line, $count) = @{$self->{trace_info}};
  2         10  
4695 2 50       11 if (my $line = $self->{trace_info}[2]) {
4696             warn sprintf "%5d %6d %s",
4697 0         0 ++$self->{trace_line}, $count, $line;
4698             }
4699             }
4700              
4701             1;
4702              
4703             # vim: sw=2:
4704              
4705              
4706 2     2   40 use v5.12;
  2         8  
4707             package PerlYamlReferenceParserReceiver;
4708 2     2   16 use PerlYamlReferenceParserPrelude;
  2         4  
  2         8861  
4709              
4710             sub stream_start_event {
4711 2     2   16 { event => 'stream_start' };
4712             }
4713             sub stream_end_event {
4714 2     2   10 { event => 'stream_end' };
4715             }
4716             sub document_start_event {
4717 4   33 4   38 { event => 'document_start', explicit => (shift || false), version => undef };
4718             }
4719             sub document_end_event {
4720 2   33 2   13 { event => 'document_end', explicit => (shift || false) };
4721             }
4722             sub mapping_start_event {
4723 6   66 6   41 { event => 'mapping_start', flow => (shift || false) };
4724             }
4725             sub mapping_end_event {
4726 2     2   10 { event => 'mapping_end' };
4727             }
4728             sub sequence_start_event {
4729 4   66 4   25 { event => 'sequence_start', flow => (shift || false) };
4730             }
4731             sub sequence_end_event {
4732 2     2   11 { event => 'sequence_end' };
4733             }
4734             sub scalar_event {
4735 20     20   57 my ($style, $value) = @_;
4736 20         152 { event => 'scalar', style => $style, value => $value };
4737             }
4738             sub alias_event {
4739 0     0   0 { event => 'alias', name => (shift) };
4740             }
4741             sub cache {
4742 6     6   26 { text => (shift) };
4743             }
4744              
4745             sub new {
4746 2     2   19818 my ($class, %self) = @_;
4747 2         21 bless {
4748             %self,
4749             event => [],
4750             cache => [],
4751             }, $class;
4752             }
4753              
4754             sub send {
4755 26     26   43 my ($self, $event) = @_;
4756 26 100       50 if (my $callback = $self->{callback}) {
4757 13         20 $callback->($event);
4758             }
4759             else {
4760 13         20 push @{$self->{event}}, $event;
  13         36  
4761             }
4762             }
4763              
4764             sub add {
4765 44     44   117 my ($self, $event) = @_;
4766 44 100       115 if (defined $event->{event}) {
4767 38 50       106 if (my $anchor = $self->{anchor}) {
4768 0         0 $event->{anchor} = delete $self->{anchor};
4769             }
4770 38 50       103 if (my $tag = $self->{tag}) {
4771 0         0 $event->{tag} = delete $self->{tag};
4772             }
4773             }
4774 44         155 $self->push($event);
4775 44         99 return $event;
4776             }
4777              
4778             sub push {
4779 74     74   150 my ($self, $event) = @_;
4780 74 100       90 if (@{$self->{cache}}) {
  74         165  
4781 52         89 push @{$self->{cache}[-1]}, $event;
  52         155  
4782             }
4783             else {
4784 22 100       104 if ($event->{event} =~ /(mapping_start|sequence_start|scalar)/) {
4785 14         34 $self->check_document_start;
4786             }
4787 22         71 $self->send($event);
4788             }
4789             }
4790              
4791             sub cache_up {
4792 34     34   155 my ($self, $event) = @_;
4793 34         57 CORE::push @{$self->{cache}}, [];
  34         91  
4794 34 100       117 $self->add($event) if $event;
4795             }
4796              
4797             sub cache_down {
4798 6     6   17 my ($self, $event) = @_;
4799 6 50       9 my $events = pop @{$self->{cache}} or FAIL 'cache_down';
  6         27  
4800 6         27 $self->push($_) for @$events;
4801 6 100       29 $self->add($event) if $event;
4802             }
4803              
4804             sub cache_drop {
4805 28     28   70 my ($self) = @_;
4806 28 50       46 my $events = pop @{$self->{cache}} or FAIL 'cache_drop';
  28         103  
4807 28         77 return $events;
4808             }
4809              
4810             sub cache_get {
4811 0     0   0 my ($self, $type) = @_;
4812             return
4813             $self->{cache}[-1] &&
4814             $self->{cache}[-1][0] &&
4815             $self->{cache}[-1][0]{event} eq $type &&
4816 0   0     0 $self->{cache}[-1][0];
4817             }
4818              
4819             sub check_document_start {
4820 14     14   22 my ($self) = @_;
4821 14 100       33 return unless $self->{document_start};
4822 2         12 $self->send($self->{document_start});
4823 2         5 delete $self->{document_start};
4824 2         9 $self->{document_end} = document_end_event;
4825             }
4826              
4827             sub check_document_end {
4828 4     4   11 my ($self) = @_;
4829 4 100       14 return unless $self->{document_end};
4830 2         7 $self->send($self->{document_end});
4831 2         5 delete $self->{document_end};
4832 2         6 $self->{tag_map} = {};
4833 2         21 $self->{document_start} = document_start_event;
4834             }
4835              
4836             #------------------------------------------------------------------------------
4837             sub try__l_yaml_stream {
4838 2     2   6 my ($self) = @_;
4839 2         7 $self->add(stream_start_event);
4840 2         6 $self->{tag_map} = {};
4841 2         9 $self->{document_start} = document_start_event;
4842 2         58 delete $self->{document_end};
4843             }
4844             sub got__l_yaml_stream {
4845 2     2   6 my ($self) = @_;
4846 2         11 $self->check_document_end;
4847 2         26 $self->add(stream_end_event);
4848             }
4849              
4850             sub got__ns_yaml_version {
4851 0     0   0 my ($self, $o) = @_;
4852             die "Multiple %YAML directives not allowed"
4853 0 0       0 if defined $self->{document_start}{version};
4854 0         0 $self->{document_start}{version} = $o->{text};
4855             }
4856              
4857             sub got__c_tag_handle {
4858 0     0   0 my ($self, $o) = @_;
4859 0         0 $self->{tag_handle} = $o->{text};
4860             }
4861             sub got__ns_tag_prefix {
4862 0     0   0 my ($self, $o) = @_;
4863 0         0 $self->{tag_map}{$self->{tag_handle}} = $o->{text};
4864             }
4865              
4866             sub got__c_directives_end {
4867 2     2   5 my ($self) = @_;
4868 2         14 $self->check_document_end;
4869 2         6 $self->{document_start}{explicit} = true;
4870             }
4871             sub got__c_document_end {
4872 0     0   0 my ($self) = @_;
4873             $self->{document_end}{explicit} = true
4874 0 0       0 if defined $self->{document_end};
4875 0         0 $self->check_document_end;
4876             }
4877              
4878 0     0   0 sub got__c_flow_mapping__all__x7b { $_[0]->add(mapping_start_event(true)) }
4879 0     0   0 sub got__c_flow_mapping__all__x7d { $_[0]->add(mapping_end_event) }
4880              
4881 2     2   9 sub got__c_flow_sequence__all__x5b { $_[0]->add(sequence_start_event(true)) }
4882 2     2   10 sub got__c_flow_sequence__all__x5d { $_[0]->add(sequence_end_event) }
4883              
4884 2     2   11 sub try__l_block_mapping { $_[0]->cache_up(mapping_start_event) }
4885 2     2   10 sub got__l_block_mapping { $_[0]->cache_down(mapping_end_event) }
4886 0     0   0 sub not__l_block_mapping { $_[0]->cache_drop }
4887              
4888 2     2   9 sub try__l_block_sequence { $_[0]->cache_up(sequence_start_event) }
4889 0     0   0 sub got__l_block_sequence { $_[0]->cache_down(sequence_end_event) }
4890             sub not__l_block_sequence {
4891 2     2   6 my ($self) = @_;
4892 2         20 my $event = $_[0]->cache_drop->[0];
4893 2         7 $self->{anchor} = $event->{anchor};
4894 2         10 $self->{tag} = $event->{tag};
4895             }
4896              
4897 0     0   0 sub try__ns_l_compact_mapping { $_[0]->cache_up(mapping_start_event) }
4898 0     0   0 sub got__ns_l_compact_mapping { $_[0]->cache_down(mapping_end_event) }
4899 0     0   0 sub not__ns_l_compact_mapping { $_[0]->cache_drop }
4900              
4901 0     0   0 sub try__ns_l_compact_sequence { $_[0]->cache_up(sequence_start_event) }
4902 0     0   0 sub got__ns_l_compact_sequence { $_[0]->cache_down(sequence_end_event) }
4903 0     0   0 sub not__ns_l_compact_sequence { $_[0]->cache_drop }
4904              
4905 4     4   19 sub try__ns_flow_pair { $_[0]->cache_up(mapping_start_event(true)) }
4906 0     0   0 sub got__ns_flow_pair { $_[0]->cache_down(mapping_end_event) }
4907 4     4   15 sub not__ns_flow_pair { $_[0]->cache_drop }
4908              
4909 6     6   23 sub try__ns_l_block_map_implicit_entry { $_[0]->cache_up }
4910 4     4   27 sub got__ns_l_block_map_implicit_entry { $_[0]->cache_down }
4911 2     2   12 sub not__ns_l_block_map_implicit_entry { $_[0]->cache_drop }
4912              
4913 6     6   22 sub try__c_l_block_map_explicit_entry { $_[0]->cache_up }
4914 0     0   0 sub got__c_l_block_map_explicit_entry { $_[0]->cache_down }
4915 6     6   28 sub not__c_l_block_map_explicit_entry { $_[0]->cache_drop }
4916              
4917 4     4   26 sub try__c_ns_flow_map_empty_key_entry { $_[0]->cache_up }
4918 0     0   0 sub got__c_ns_flow_map_empty_key_entry { $_[0]->cache_down }
4919 4     4   27 sub not__c_ns_flow_map_empty_key_entry { $_[0]->cache_drop }
4920              
4921             sub got__ns_plain {
4922 12     12   32 my ($self, $o) = @_;
4923 12         31 my $text = $o->{text};
4924 12         31 $text =~ s/(?:[\ \t]*\r?\n[\ \t]*)/\n/g;
4925 12 0       24 $text =~ s/(\n)(\n*)/length($2) ? $2 : ' '/ge;
  0         0  
4926 12         42 $self->add(scalar_event(plain => $text));
4927             }
4928              
4929             sub got__c_single_quoted {
4930 0     0   0 my ($self, $o) = @_;
4931 0         0 my $text = substr($o->{text}, 1, -1);
4932 0         0 $text =~ s/(?:[\ \t]*\r?\n[\ \t]*)/\n/g;
4933 0 0       0 $text =~ s/(\n)(\n*)/length($2) ? $2 : ' '/ge;
  0         0  
4934 0         0 $text =~ s/''/'/g;
4935 0         0 $self->add(scalar_event(single => $text));
4936             }
4937              
4938             sub got__c_double_quoted {
4939 0     0   0 my ($self, $o) = @_;
4940 0         0 my $text = substr($o->{text}, 1, -1);
4941 0         0 $text =~ s/(?:(?
4942 0         0 $text =~ s/\\\n[\ \t]*//g;
4943 0 0       0 $text =~ s/(\n)(\n*)/length($2) ? $2 : ' '/ge;
  0         0  
4944 0         0 $text =~ s/\\(["\/])/$1/g;
4945 0         0 $text =~ s/\\ / /g;
4946 0         0 $text =~ s/\\b/\b/g;
4947 0         0 $text =~ s/\\\t/\t/g;
4948 0         0 $text =~ s/\\t/\t/g;
4949 0         0 $text =~ s/\\n/\n/g;
4950 0         0 $text =~ s/\\r/\r/g;
4951 0         0 $text =~ s/\\x([0-9a-fA-F]{2})/chr(hex($1))/eg;
  0         0  
4952 0         0 $text =~ s/\\u([0-9a-fA-F]{4})/chr(hex($1))/eg;
  0         0  
4953 0         0 $text =~ s/\\U([0-9a-fA-F]{8})/chr(hex($1))/eg;
  0         0  
4954 0         0 $text =~ s/\\\\/\\/g;
4955 0         0 $self->add(scalar_event(double => $text));
4956             }
4957              
4958             sub got__l_empty {
4959 0     0   0 my ($self) = @_;
4960 0 0       0 $self->add(cache '') if $self->{in_scalar};
4961             }
4962             sub got__l_nb_literal_text__all__rep2 {
4963 6     6   15 my ($self, $o) = @_;
4964 6         28 $self->add(cache $o->{text});
4965             }
4966             sub try__c_l_literal {
4967 6     6   18 my ($self) = @_;
4968 6         21 $self->{in_scalar} = true;
4969 6         38 $self->cache_up;
4970             }
4971             sub got__c_l_literal {
4972 2     2   6 my ($self) = @_;
4973 2         9 delete $self->{in_scalar};
4974 2         9 my $lines = $self->cache_drop;
4975 2 50 33     46 pop @$lines if @$lines and $lines->[-1]{text} eq '';
4976 2         19 my $text = join '', map "$_->{text}\n", @$lines;
4977 2         11 my $t = $self->{parser}->state_curr->{t};
4978 2 50       10 if ($t eq 'clip') {
    0          
4979 2         15 $text =~ s/\n+\z/\n/;
4980             }
4981             elsif ($t eq 'strip') {
4982 0         0 $text =~ s/\n+\z//;
4983             }
4984 2         10 $self->add(scalar_event(literal => $text));
4985             }
4986             sub not__c_l_literal {
4987 4     4   11 my ($self) = @_;
4988 4         9 delete $self->{in_scalar};
4989 4         30 $_[0]->cache_drop;
4990             }
4991              
4992             sub got__ns_char {
4993 46     46   98 my ($self, $o) = @_;
4994 46 50       132 $self->{first} = $o->{text} if $self->{in_scalar};
4995             }
4996             sub got__s_white {
4997 26     26   53 my ($self, $o) = @_;
4998 26 50       91 $self->{first} = $o->{text} if $self->{in_scalar};
4999             }
5000             sub got__s_nb_folded_text__all__rep {
5001 0     0   0 my ($self, $o) = @_;
5002 0         0 $self->add(cache "$self->{first}$o->{text}");
5003             }
5004             sub got__s_nb_spaced_text__all__rep {
5005 0     0   0 my ($self, $o) = @_;
5006 0         0 $self->add(cache "$self->{first}$o->{text}");
5007             }
5008             sub try__c_l_folded {
5009 4     4   10 my ($self) = @_;
5010 4         13 $self->{in_scalar} = true;
5011 4         22 $self->{first} = '';
5012 4         11 $self->cache_up;
5013             }
5014             sub got__c_l_folded {
5015 0     0   0 my ($self) = @_;
5016 0         0 delete $self->{in_scalar};
5017              
5018 0         0 my @lines = map $_->{text}, @{$self->cache_drop};
  0         0  
5019 0         0 my $text = join "\n", @lines;
5020 0         0 $text =~ s/^(\S.*)\n(?=\S)/$1 /gm;
5021 0         0 $text =~ s/^(\S.*)\n(\n+)/$1$2/gm;
5022 0         0 $text =~ s/^([\ \t]+\S.*)\n(\n+)(?=\S)/$1$2/gm;
5023 0         0 $text .= "\n";
5024              
5025 0         0 my $t = $self->{parser}->state_curr->{t};
5026 0 0       0 if ($t eq 'clip') {
    0          
5027 0         0 $text =~ s/\n+\z/\n/;
5028 0 0       0 $text = '' if $text eq "\n";
5029             }
5030             elsif ($t eq 'strip') {
5031 0         0 $text =~ s/\n+\z//;
5032             }
5033 0         0 $self->add(scalar_event(folded => $text));
5034             }
5035             sub not__c_l_folded {
5036 4     4   10 my ($self) = @_;
5037 4         9 delete $self->{in_scalar};
5038 4         10 $_[0]->cache_drop;
5039             }
5040              
5041 6     6   22 sub got__e_scalar { $_[0]->add(scalar_event(plain => '')) }
5042              
5043             sub not__s_l_block_collection__all__rep__all__any__all {
5044 12     12   26 my ($self) = @_;
5045 12         29 delete $self->{anchor};
5046 12         29 delete $self->{tag};
5047             }
5048              
5049             sub got__c_ns_anchor_property {
5050 0     0   0 my ($self, $o) = @_;
5051 0         0 $self->{anchor} = substr($o->{text}, 1);
5052             }
5053              
5054             sub got__c_ns_tag_property {
5055 0     0   0 my ($self, $o) = @_;
5056 0         0 my $tag = $o->{text};
5057 0         0 my $prefix;
5058 0 0       0 if ($tag =~ /^!<(.*)>$/) {
    0          
    0          
    0          
5059 0         0 $self->{tag} = $1;
5060             }
5061             elsif ($tag =~ /^!!(.*)/) {
5062 0 0       0 if (defined($prefix = $self->{tag_map}{'!!'})) {
5063 0         0 $self->{tag} = $prefix . substr($tag, 2);
5064             }
5065             else {
5066 0         0 $self->{tag} = "tag:yaml.org,2002:$1";
5067             }
5068             }
5069             elsif ($tag =~ /^(!.*?!)/) {
5070 0         0 $prefix = $self->{tag_map}{$1};
5071 0 0       0 if (defined $prefix) {
5072 0         0 $self->{tag} = $prefix . substr($tag, length($1));
5073             }
5074             else {
5075 0         0 die "No %TAG entry for '$prefix'";
5076             }
5077             }
5078             elsif (defined($prefix = $self->{tag_map}{'!'})) {
5079 0         0 $self->{tag} = $prefix . substr($tag, 1);
5080             }
5081             else {
5082 0         0 $self->{tag} = $tag;
5083             }
5084 0         0 $self->{tag} =~ s/%([0-9a-fA-F]{2})/chr(hex($1))/eg;
  0         0  
5085             }
5086              
5087             sub got__c_ns_alias_node {
5088 0     0   0 my ($self, $o) = @_;
5089 0         0 my $name = $o->{text};
5090 0         0 $name =~ s/^\*//;
5091 0         0 $self->add(alias_event($name));
5092             }
5093              
5094             1;
5095              
5096             # vim: sw=2:
5097              
5098              
5099 2     2   29 use v5.12;
  2         8  
5100             package PerlYamlReferenceParserTestReceiver;
5101 2     2   15 use base 'PerlYamlReferenceParserReceiver';
  2         6  
  2         910  
5102              
5103 2     2   17 use PerlYamlReferenceParserPrelude;
  2         4  
  2         1406  
5104              
5105             my $event_map = {
5106             stream_start => '+STR',
5107             stream_end => '-STR',
5108             document_start => '+DOC',
5109             document_end => '-DOC',
5110             mapping_start => '+MAP',
5111             mapping_end => '-MAP',
5112             sequence_start => '+SEQ',
5113             sequence_end => '-SEQ',
5114             scalar => '=VAL',
5115             alias => '=ALI',
5116             };
5117              
5118             my $style_map = {
5119             plain => ':',
5120             single => "'",
5121             double => '"',
5122             literal => '|',
5123             folded => '>',
5124             };
5125              
5126             sub output {
5127 1     1   3 my ($self) = @_;
5128             join '', map {
5129 13         32 my $type = $event_map->{$_->{event}};
5130 13         18 my @event = ($type);
5131 13 50 66     31 push @event, '---' if $type eq '+DOC' and $_->{explicit};
5132 13 50 66     40 push @event, '...' if $type eq '-DOC' and $_->{explicit};
5133 13 50 66     36 push @event, '{}' if $type eq '+MAP' and $_->{flow};
5134 13 50 66     35 push @event, '[]' if $type eq '+SEQ' and $_->{flow};
5135 13 50       36 push @event, "&$_->{anchor}" if $_->{anchor};
5136 13 50       24 push @event, "<$_->{tag}>" if $_->{tag};
5137 13 50       23 push @event, "*$_->{name}" if $_->{name};
5138 13 100       23 if (exists $_->{value}) {
5139 5         11 my $style = $style_map->{$_->{style}};
5140 5         9 my $value = $_->{value};
5141 5         10 $value =~ s/\\/\\\\/g;
5142 5         7 $value =~ s/\x08/\\b/g;
5143 5         9 $value =~ s/\t/\\t/g;
5144 5         9 $value =~ s/\n/\\n/g;
5145 5         9 $value =~ s/\r/\\r/g;
5146 5         10 push @event, "$style$value";
5147             }
5148 13         42 join(' ', @event) . "\n";
5149 1         3 } @{$self->{event}};
  1         4  
5150             }
5151              
5152             1;
5153              
5154             # vim: sw=2:
5155