File Coverage

blib/lib/YAML/PP/Emitter.pm
Criterion Covered Total %
statement 512 566 90.4
branch 313 378 82.8
condition 88 92 95.6
subroutine 36 37 97.3
pod 17 25 68.0
total 966 1098 87.9


line stmt bran cond sub pod time code
1 38     38   2911 use strict;
  38         83  
  38         1124  
2 38     38   209 use warnings;
  38         87  
  38         2128  
3             package YAML::PP::Emitter;
4              
5             our $VERSION = '0.036'; # VERSION
6 38     38   9709 use Data::Dumper;
  38         104979  
  38         2614  
7              
8 38         3268 use YAML::PP::Common qw/
9             YAML_PLAIN_SCALAR_STYLE YAML_SINGLE_QUOTED_SCALAR_STYLE
10             YAML_DOUBLE_QUOTED_SCALAR_STYLE
11             YAML_LITERAL_SCALAR_STYLE YAML_FOLDED_SCALAR_STYLE
12             YAML_FLOW_SEQUENCE_STYLE YAML_FLOW_MAPPING_STYLE
13 38     38   270 /;
  38         98  
14              
15 38 50   38   263 use constant DEBUG => $ENV{YAML_PP_EMIT_DEBUG} ? 1 : 0;
  38         100  
  38         2473  
16 38     38   275 use constant DEFAULT_WIDTH => 80;
  38         83  
  38         260443  
17              
18             sub new {
19 282     282 1 1314 my ($class, %args) = @_;
20             my $self = bless {
21             indent => $args{indent} || 2,
22             writer => $args{writer},
23 282   100     2081 width => $args{width} || DEFAULT_WIDTH,
      50        
24             }, $class;
25 282         894 $self->init;
26 282         720 return $self;
27             }
28              
29             sub clone {
30 9     9 0 20 my ($self) = @_;
31 9         17 my $clone = {
32             indent => $self->indent,
33             };
34 9         42 return bless $clone, ref $self;
35             }
36              
37 13446     13446 0 21386 sub event_stack { return $_[0]->{event_stack} }
38 2889     2889 0 7809 sub set_event_stack { $_[0]->{event_stack} = $_[1] }
39 1710     1710 1 4490 sub indent { return $_[0]->{indent} }
40 250     250 0 517 sub width { return $_[0]->{width} }
41 0     0 0 0 sub line { return $_[0]->{line} }
42 6600     6600 0 17886 sub column { return $_[0]->{column} }
43 1     1 1 1593 sub set_indent { $_[0]->{indent} = $_[1] }
44 10058     10058 1 25775 sub writer { $_[0]->{writer} }
45 1570     1570 1 4622 sub set_writer { $_[0]->{writer} = $_[1] }
46 226     226 0 403 sub tagmap { return $_[0]->{tagmap} }
47 1671     1671 0 3333 sub set_tagmap { $_[0]->{tagmap} = $_[1] }
48              
49             sub init {
50 1671     1671 1 79354 my ($self) = @_;
51 1671 100       3074 unless ($self->writer) {
52 281         943 $self->set_writer(YAML::PP::Writer->new);
53             }
54             $self->set_tagmap({
55 1671         5416 'tag:yaml.org,2002:' => '!!',
56             });
57 1671         2640 $self->{open_ended} = 0;
58 1671         2836 $self->{line} = 0;
59 1671         2536 $self->{column} = 0;
60 1671         2830 $self->writer->init;
61             }
62              
63             sub mapping_start_event {
64 440     440 1 2789 DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ mapping_start_event\n";
65 440         812 my ($self, $info) = @_;
66 440         857 my $stack = $self->event_stack;
67 440         686 my $last = $stack->[-1];
68 440         722 my $indent = $last->{indent};
69 440         602 my $new_indent = $indent;
70 440         611 my $yaml = '';
71              
72 440         689 my $props = '';
73 440         653 my $anchor = $info->{anchor};
74 440         634 my $tag = $info->{tag};
75 440 100       900 if (defined $anchor) {
76 31         81 $anchor = "&$anchor";
77             }
78 440 100       823 if (defined $tag) {
79 39         92 $tag = $self->_emit_tag('map', $tag);
80             }
81 440         1425 $props = join ' ', grep defined, ($anchor, $tag);
82              
83 440   100     1442 my $flow = $last->{flow} || 0;
84 440 100 100     1442 $flow++ if ($info->{style} || 0) eq YAML_FLOW_MAPPING_STYLE;
85              
86 440         661 my $newline = 0;
87 440 100       905 if ($flow > 1) {
88 31 100       73 if ($last->{type} eq 'SEQ') {
    50          
    50          
89 30 50       63 if ($last->{newline}) {
90 0         0 $yaml .= ' ';
91             }
92 30 100       55 if ($last->{index} == 0) {
93 3         7 $yaml .= "[";
94             }
95             else {
96 27         43 $yaml .= ",";
97             }
98             }
99             elsif ($last->{type} eq 'MAP') {
100 0 0       0 if ($last->{newline}) {
101 0         0 $yaml .= ' ';
102             }
103 0 0       0 if ($last->{index} == 0) {
104 0         0 $yaml .= "{";
105             }
106             else {
107 0         0 $yaml .= ",";
108             }
109             }
110             elsif ($last->{type} eq 'MAPVALUE') {
111 1 50       4 if ($last->{index} == 0) {
112 0         0 die "Should not happen (index 0 in MAPVALUE)";
113             }
114 1         3 $yaml .= ": ";
115             }
116 31 50       75 if ($props) {
117 0         0 $yaml .= " $props ";
118             }
119 31         63 $new_indent .= ' ' x $self->indent;
120             }
121             else {
122 409 100       847 if ($last->{type} eq 'DOC') {
123 136         285 $newline = $last->{newline};
124             }
125             else {
126 273 100       582 if ($last->{newline}) {
127 37         89 $yaml .= "\n";
128 37         81 $last->{column} = 0;
129             }
130 273 100       560 if ($last->{type} eq 'MAPVALUE') {
131 62         191 $new_indent .= ' ' x $self->indent;
132 62         117 $newline = 1;
133             }
134             else {
135 211         295 $new_indent = $indent;
136 211 100 100     566 if (not $props and $self->indent == 1) {
137 31         50 $new_indent .= ' ' x 2;
138             }
139             else {
140 180         344 $new_indent .= ' ' x $self->indent;
141             }
142              
143 211 100       589 if ($last->{column}) {
144 1 50       2 my $space = $self->indent > 1 ? ' ' x ($self->indent - 1) : ' ';
145 1         2 $yaml .= $space;
146             }
147             else {
148 210         331 $yaml .= $indent;
149             }
150 211 100       462 if ($last->{type} eq 'SEQ') {
    100          
    50          
151 195         441 $yaml .= '-';
152             }
153             elsif ($last->{type} eq 'MAP') {
154 11         19 $yaml .= "?";
155 11         26 $last->{type} = 'COMPLEX';
156             }
157             elsif ($last->{type} eq 'COMPLEXVALUE') {
158 5         19 $yaml .= ":";
159             }
160             else {
161 0         0 die "Should not happen ($last->{type} in mapping_start)";
162             }
163 211         318 $last->{column} = 1;
164             }
165 273         402 $last->{newline} = 0;
166             }
167 409 100       867 if ($props) {
168 49 50       129 $yaml .= $last->{column} ? ' ' : $indent;
169 49         78 $yaml .= $props;
170 49         87 $newline = 1;
171             }
172             }
173 440         1084 $self->_write($yaml);
174 440         2116 my $new_info = {
175             index => 0, indent => $new_indent, info => $info,
176             newline => $newline,
177             column => $self->column,
178             flow => $flow,
179             };
180 440         927 $new_info->{type} = 'MAP';
181 440         619 push @{ $stack }, $new_info;
  440         862  
182 440         664 $last->{index}++;
183 440         1087 $self->{open_ended} = 0;
184             }
185              
186             sub mapping_end_event {
187 439     439 1 2044 DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ mapping_end_event\n";
188 439         828 my ($self, $info) = @_;
189 439         759 my $stack = $self->event_stack;
190              
191 439         599 my $last = pop @{ $stack };
  439         730  
192 439 100       1309 if ($last->{index} == 0) {
    100          
193 7         23 my $indent = $last->{indent};
194 7         26 my $zero_indent = $last->{zero_indent};
195 7 50       18 if ($last->{zero_indent}) {
196 0         0 $indent .= ' ' x $self->indent;
197             }
198 7 50       17 if ($self->column) {
199 7         17 $self->_write(" {}\n");
200             }
201             else {
202 0         0 $self->_write("$indent\{}\n");
203             }
204             }
205             elsif ($last->{flow}) {
206 70         103 my $yaml = "}";
207 70 100       136 if ($last->{flow} == 1) {
208 39         58 $yaml .= "\n";
209             }
210 70         940 $self->_write("$yaml");
211             }
212 439         1114 $last = $stack->[-1];
213 439         846 $last->{column} = $self->column;
214 439 100       1852 if ($last->{type} eq 'SEQ') {
    50          
    100          
    100          
    100          
215             }
216             elsif ($last->{type} eq 'MAP') {
217 0         0 $last->{type} = 'MAPVALUE';
218             }
219             elsif ($last->{type} eq 'MAPVALUE') {
220 63         178 $last->{type} = 'MAP';
221             }
222             elsif ($last->{type} eq 'COMPLEX') {
223 11         32 $last->{type} = 'COMPLEXVALUE';
224             }
225             elsif ($last->{type} eq 'COMPLEXVALUE') {
226 5         17 $last->{type} = 'MAP';
227             }
228             }
229              
230             sub sequence_start_event {
231 444     444 1 2753 DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ sequence_start_event\n";
232 444         777 my ($self, $info) = @_;
233 444         823 my $stack = $self->event_stack;
234 444         687 my $last = $stack->[-1];
235 444         753 my $indent = $last->{indent};
236 444         615 my $new_indent = $indent;
237 444         633 my $yaml = '';
238              
239 444         654 my $props = '';
240 444         665 my $anchor = $info->{anchor};
241 444         685 my $tag = $info->{tag};
242 444 100       926 if (defined $anchor) {
243 16         41 $anchor = "&$anchor";
244             }
245 444 100       787 if (defined $tag) {
246 11         24 $tag = $self->_emit_tag('seq', $tag);
247             }
248 444         1413 $props = join ' ', grep defined, ($anchor, $tag);
249              
250 444   100     1467 my $flow = $last->{flow} || 0;
251 444 100 100     2035 $flow++ if $flow or ($info->{style} || 0) eq YAML_FLOW_SEQUENCE_STYLE;
      100        
252 444         637 my $newline = 0;
253 444         591 my $zero_indent = 0;
254 444 100       901 if ($flow > 1) {
255 27 100       70 if ($last->{type} eq 'SEQ') {
    100          
    50          
256 23 50       54 if ($last->{newline}) {
257 0         0 $yaml .= ' ';
258             }
259 23 100       41 if ($last->{index} == 0) {
260 2         6 $yaml .= "[";
261             }
262             else {
263 21         36 $yaml .= ",";
264             }
265             }
266             elsif ($last->{type} eq 'MAP') {
267 1 50       17 if ($last->{newline}) {
268 0         0 $yaml .= ' ';
269             }
270 1 50       5 if ($last->{index} == 0) {
271 0         0 $yaml .= "{";
272             }
273             else {
274 1         3 $yaml .= ",";
275             }
276             }
277             elsif ($last->{type} eq 'MAPVALUE') {
278 3 50       10 if ($last->{index} == 0) {
279 0         0 die "Should not happen (index 0 in MAPVALUE)";
280             }
281 3         6 $yaml .= ": ";
282             }
283 27 50       49 if ($props) {
284 0         0 $yaml .= " $props ";
285             }
286 27         48 $new_indent .= ' ' x $self->indent;
287             }
288             else {
289 417 100       893 if ($last->{type} eq 'DOC') {
290 224         406 $newline = $last->{newline};
291             }
292             else {
293 193 100       474 if ($last->{newline}) {
294 14         48 $yaml .= "\n";
295 14         33 $last->{column} = 0;
296             }
297 193 100       392 if ($last->{type} eq 'MAPVALUE') {
298 52         103 $zero_indent = 1;
299 52         85 $newline = 1;
300             }
301             else {
302 141 100 100     392 if (not $props and $self->indent == 1) {
303 26         44 $new_indent .= ' ' x 2;
304             }
305             else {
306 115         219 $new_indent .= ' ' x $self->indent;
307             }
308 141 100       289 if ($last->{column}) {
309 1 50       4 my $space = $self->indent > 1 ? ' ' x ($self->indent - 1) : ' ';
310 1         7 $yaml .= $space;
311             }
312             else {
313 140         210 $yaml .= $indent;
314             }
315 141 100       289 if ($last->{type} eq 'SEQ') {
    50          
    0          
316 135         204 $yaml .= "-";
317             }
318             elsif ($last->{type} eq 'MAP') {
319 6         17 $last->{type} = 'COMPLEX';
320 6         11 $zero_indent = 1;
321 6         12 $yaml .= "?";
322             }
323             elsif ($last->{type} eq 'COMPLEXVALUE') {
324 0         0 $yaml .= ":";
325 0         0 $zero_indent = 1;
326             }
327             else {
328 0         0 die "Should not happen ($last->{type} in sequence_start)";
329             }
330 141         220 $last->{column} = 1;
331             }
332 193         343 $last->{newline} = 0;
333             }
334 417 100       1158 if ($props) {
335 19 50       48 $yaml .= $last->{column} ? ' ' : $indent;
336 19         47 $yaml .= $props;
337 19         92 $newline = 1;
338             }
339             }
340 444         1212 $self->_write($yaml);
341 444         783 $last->{index}++;
342 444         981 my $new_info = {
343             index => 0,
344             indent => $new_indent,
345             info => $info,
346             zero_indent => $zero_indent,
347             newline => $newline,
348             column => $self->column,
349             flow => $flow,
350             };
351 444         1258 $new_info->{type} = 'SEQ';
352 444         646 push @{ $stack }, $new_info;
  444         896  
353 444         1121 $self->{open_ended} = 0;
354             }
355              
356             sub sequence_end_event {
357 444     444 1 2196 DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ sequence_end_event\n";
358 444         834 my ($self, $info) = @_;
359 444         827 my $stack = $self->event_stack;
360              
361 444         661 my $last = pop @{ $stack };
  444         729  
362 444 100       1293 if ($last->{index} == 0) {
    100          
363 36         68 my $indent = $last->{indent};
364 36         67 my $zero_indent = $last->{zero_indent};
365 36 100       105 if ($last->{zero_indent}) {
366 1         3 $indent .= ' ' x $self->indent;
367             }
368 36 50       72 my $yaml .= $self->column ? ' ' : $indent;
369 36         65 $yaml .= "[]";
370 36 100       129 if ($last->{flow} < 2) {
371 31         46 $yaml .= "\n";
372             }
373 36         72 $self->_write($yaml);
374             }
375             elsif ($last->{flow}) {
376 42         65 my $yaml = "]";
377 42 100       99 if ($last->{flow} == 1) {
378 20         33 $yaml .= "\n";
379             }
380 42         67 $self->_write($yaml);
381             }
382 444         1190 $last = $stack->[-1];
383 444         798 $last->{column} = $self->column;
384 444 100       1923 if ($last->{type} eq 'SEQ') {
    100          
    100          
    100          
    50          
385             }
386             elsif ($last->{type} eq 'MAP') {
387 1         3 $last->{type} = 'MAPVALUE';
388             }
389             elsif ($last->{type} eq 'MAPVALUE') {
390 55         158 $last->{type} = 'MAP';
391             }
392             elsif ($last->{type} eq 'COMPLEX') {
393 6         20 $last->{type} = 'COMPLEXVALUE';
394             }
395             elsif ($last->{type} eq 'COMPLEXVALUE') {
396 0         0 $last->{type} = 'MAP';
397             }
398             }
399              
400             my %forbidden_first = (qw/
401             ! 1 & 1 * 1 { 1 } 1 [ 1 ] 1 | 1 > 1 @ 1 ` 1 " 1 ' 1
402             /, '#' => 1, '%' => 1, ',' => 1, " " => 1);
403             my %forbidden_first_plus_space = (qw/
404             ? 1 - 1 : 1
405             /);
406              
407             my %control = (
408             "\x00" => '\0',
409             "\x01" => '\x01',
410             "\x02" => '\x02',
411             "\x03" => '\x03',
412             "\x04" => '\x04',
413             "\x05" => '\x05',
414             "\x06" => '\x06',
415             "\x07" => '\a',
416             "\x08" => '\b',
417             "\x0b" => '\v',
418             "\x0c" => '\f',
419             "\x0e" => '\x0e',
420             "\x0f" => '\x0f',
421             "\x10" => '\x10',
422             "\x11" => '\x11',
423             "\x12" => '\x12',
424             "\x13" => '\x13',
425             "\x14" => '\x14',
426             "\x15" => '\x15',
427             "\x16" => '\x16',
428             "\x17" => '\x17',
429             "\x18" => '\x18',
430             "\x19" => '\x19',
431             "\x1a" => '\x1a',
432             "\x1b" => '\e',
433             "\x1c" => '\x1c',
434             "\x1d" => '\x1d',
435             "\x1e" => '\x1e',
436             "\x1f" => '\x1f',
437             "\x7f" => '\x7f',
438             "\x80" => '\x80',
439             "\x81" => '\x81',
440             "\x82" => '\x82',
441             "\x83" => '\x83',
442             "\x84" => '\x84',
443             "\x86" => '\x86',
444             "\x87" => '\x87',
445             "\x88" => '\x88',
446             "\x89" => '\x89',
447             "\x8a" => '\x8a',
448             "\x8b" => '\x8b',
449             "\x8c" => '\x8c',
450             "\x8d" => '\x8d',
451             "\x8e" => '\x8e',
452             "\x8f" => '\x8f',
453             "\x90" => '\x90',
454             "\x91" => '\x91',
455             "\x92" => '\x92',
456             "\x93" => '\x93',
457             "\x94" => '\x94',
458             "\x95" => '\x95',
459             "\x96" => '\x96',
460             "\x97" => '\x97',
461             "\x98" => '\x98',
462             "\x99" => '\x99',
463             "\x9a" => '\x9a',
464             "\x9b" => '\x9b',
465             "\x9c" => '\x9c',
466             "\x9d" => '\x9d',
467             "\x9e" => '\x9e',
468             "\x9f" => '\x9f',
469             "\x{2029}" => '\P',
470             "\x{2028}" => '\L',
471             "\x85" => '\N',
472             "\xa0" => '\_',
473             );
474              
475             my $control_re = '\x00-\x08\x0b\x0c\x0e-\x1f\x7f-\x84\x86-\x9f\x{d800}-\x{dfff}\x{fffe}\x{ffff}\x{2028}\x{2029}\x85\xa0';
476             my %to_escape = (
477             "\n" => '\n',
478             "\t" => '\t',
479             "\r" => '\r',
480             '\\' => '\\\\',
481             '"' => '\\"',
482             %control,
483             );
484             my $escape_re = $control_re . '\n\t\r';
485             my $escape_re_without_lb = $control_re . '\t\r';
486              
487              
488             sub scalar_event {
489 2897     2897 1 9633 DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ scalar_event\n";
490 2897         4782 my ($self, $info) = @_;
491 2897         5129 my $stack = $self->event_stack;
492 2897         4582 my $last = $stack->[-1];
493 2897         4442 my $indent = $last->{indent};
494 2897         4195 my $value = $info->{value};
495 2897         4136 my $flow = $last->{flow};
496              
497 2897         4153 my $props = '';
498 2897         4099 my $anchor = $info->{anchor};
499 2897         3963 my $tag = $info->{tag};
500 2897 100       5693 if (defined $anchor) {
501 178         338 $anchor = "&$anchor";
502             }
503 2897 100       5271 if (defined $tag) {
504 176         354 $tag = $self->_emit_tag('scalar', $tag);
505             }
506 2897         9047 $props = join ' ', grep defined, ($anchor, $tag);
507              
508 2897         3859 DEBUG and local $Data::Dumper::Useqq = 1;
509 2897 50       5407 $value = '' unless defined $value;
510              
511 2897         5891 my $style = $self->_find_best_scalar_style(
512             info => $info,
513             value => $value,
514             );
515              
516 2897         4336 my $open_ended = 0;
517              
518 2897 100       5717 if ($style == YAML_PLAIN_SCALAR_STYLE) {
    100          
    100          
    100          
519 2215         4348 $value =~ s/\n/\n\n/g;
520             }
521             elsif ($style == YAML_SINGLE_QUOTED_SCALAR_STYLE) {
522 341         829 my $new_indent = $last->{indent} . (' ' x $self->indent);
523 341         809 $value =~ s/(\n+)/"\n" x (1 + (length $1))/eg;
  0         0  
524 341         1005 my @lines = split m/\n/, $value, -1;
525 341 50       793 if (@lines > 1) {
526 0         0 for my $line (@lines[1 .. $#lines]) {
527 0 0       0 $line = $new_indent . $line
528             if length $line;
529             }
530             }
531 341         764 $value = join "\n", @lines;
532 341         591 $value =~ s/'/''/g;
533 341         878 $value = "'" . $value . "'";
534             }
535             elsif ($style == YAML_LITERAL_SCALAR_STYLE) {
536 87         130 DEBUG and warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\$value], ['value']);
537 87         158 my $indicators = '';
538 87 100       373 if ($value =~ m/\A\n* +/) {
539 25         66 $indicators .= $self->indent;
540             }
541 87         212 my $indent = $indent . ' ' x $self->indent;
542 87 100       534 if ($value !~ m/\n\z/) {
    100          
543 31         55 $indicators .= '-';
544 31         61 $value .= "\n";
545             }
546             elsif ($value =~ m/(\n|\A)\n\z/) {
547 10         18 $indicators .= '+';
548 10         31 $open_ended = 1;
549             }
550 87         484 $value =~ s/^(?=.)/$indent/gm;
551 87         285 $value = "|$indicators\n$value";
552             }
553             elsif ($style == YAML_FOLDED_SCALAR_STYLE) {
554 25         46 DEBUG and warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\$value], ['value']);
555 25         96 my @lines = split /\n/, $value, -1;
556 25         31 DEBUG and warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\@lines], ['lines']);
557 25         51 my $trailing = -1;
558 25         72 while (@lines) {
559 42 100       96 last if $lines[-1] ne '';
560 18         30 pop @lines;
561 18         39 $trailing++;
562             }
563 25         50 my %start_with_space;
564 25         82 for my $i (0 .. $#lines) {
565 43 100       148 if ($lines[ $i ] =~ m/^[ \t]+/) {
566 18         55 $start_with_space{ $i } = 1;
567             }
568             }
569 25         47 my $indicators = '';
570 25 100       105 if ($value =~ m/\A\n* +/) {
571 11         25 $indicators .= $self->indent;
572             }
573 25         76 my $indent = $indent . ' ' x $self->indent;
574 25 100       99 if ($trailing > 0) {
    100          
575 3         5 $indicators .= '+';
576 3         5 $open_ended = 1;
577             }
578             elsif ($trailing < 0) {
579 10         18 $indicators .= '-';
580             }
581 25         70 $value = ">$indicators\n";
582 25         43 my $got_content = 0;
583 25         58 for my $i (0 .. $#lines) {
584 43         88 my $line = $lines[ $i ];
585 43   100     142 my $sp = $start_with_space{ $i } || 0;
586 43 100 100     125 my $spnext = $i == $#lines ? 1 : $start_with_space{ $i+1 } || 0;
587 43 100 100     122 my $spprev = $i == 0 ? 1 : $start_with_space{ $i-1 } || 0;
588 43 100       95 my $empty = length $line ? 0 : 1;
589 43 100       106 my $emptynext = $i == $#lines ? '' : length $lines[$i+1] ? 0 : 1;
    100          
590 43         68 my $nl = 0;
591 43 100       71 if ($empty) {
592 12 100 100     37 if ($spnext and $spprev) {
    100          
    50          
593 7         11 $nl = 1;
594             }
595             elsif (not $spnext) {
596 4         8 $nl = 1;
597             }
598             elsif (not $got_content) {
599 1         3 $nl = 1;
600             }
601             }
602             else {
603 31         44 $got_content = 1;
604 31         74 $value .= "$indent$line\n";
605 31 50 66     95 if (not $sp and not $spnext) {
606 0         0 $nl = 1;
607             }
608             }
609 43 100       125 if ($nl) {
610 12         20 $value .= "\n";
611             }
612             }
613 25 100       97 $value .= "\n" x ($trailing) if $trailing > 0;
614             }
615             else {
616 229 50       1557 $value =~ s/([$escape_re"\\])/$to_escape{ $1 } || sprintf '\\u%04x', ord($1)/eg;
  344         1836  
617 229         715 $value = '"' . $value . '"';
618             }
619              
620 2897         3818 DEBUG and warn __PACKAGE__.':'.__LINE__.": (@$stack)\n";
621 2897         6216 my $yaml = $self->_emit_scalar(
622             indent => $indent,
623             props => $props,
624             value => $value,
625             style => $style,
626             );
627              
628 2897         4843 $last->{index}++;
629 2897         4679 $last->{newline} = 0;
630 2897         6915 $self->_write($yaml);
631 2897         5768 $last->{column} = $self->column;
632 2897         12367 $self->{open_ended} = $open_ended;
633             }
634              
635             sub _find_best_scalar_style {
636 2897     2897   8377 my ($self, %args) = @_;
637 2897         4734 my $info = $args{info};
638 2897         4575 my $style = $info->{style};
639 2897         4309 my $value = $args{value};
640 2897         4753 my $stack = $self->event_stack;
641 2897         4150 my $last = $stack->[-1];
642 2897         4057 my $flow = $last->{flow};
643              
644 2897         6144 my $first = substr($value, 0, 1);
645 2897 100       15888 if ($value eq '') {
    100          
646 492 100 100     1797 if ($flow and $last->{type} ne 'MAPVALUE' and $last->{type} ne 'MAP') {
    100 100        
647 20         34 $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
648             }
649             elsif (not $style) {
650 2         4 $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
651             }
652             }
653             # no control characters anywhere
654             elsif ($value =~ m/[$control_re]/) {
655 49         128 $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
656             }
657 2897   100     8745 $style ||= YAML_PLAIN_SCALAR_STYLE;
658              
659 2897 100 100     12545 if ($style == YAML_SINGLE_QUOTED_SCALAR_STYLE) {
    100          
    100          
660 230 100 100     1791 if ($value =~ m/ \n/ or $value =~ m/\n / or $value =~ m/^\n/ or $value =~ m/\n$/) {
    50 100        
      100        
661 14         24 $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
662             }
663             elsif ($value eq "\n") {
664 0         0 $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
665             }
666             }
667             elsif ($style == YAML_LITERAL_SCALAR_STYLE or $style == YAML_FOLDED_SCALAR_STYLE) {
668 69 100       204 if ($value eq '') {
    100          
669 2         4 $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
670             }
671             elsif ($flow) {
672             # no block scalars in flow
673 8 50       22 if ($value =~ tr/\n//) {
674 8         14 $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
675             }
676             else {
677 0         0 $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
678             }
679             }
680             }
681             elsif ($style == YAML_PLAIN_SCALAR_STYLE) {
682 2436 100 66     27846 if (not length $value) {
    100          
    100          
    100          
    100          
    100          
    100          
    50          
    50          
    100          
    100          
    100          
    50          
    100          
683             }
684             elsif ($value =~ m/[$escape_re_without_lb]/) {
685 25         60 $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
686             }
687             elsif ($value eq "\n") {
688 3         9 $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
689             }
690             elsif ($value !~ tr/ //c) {
691 6         17 $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
692             }
693             elsif ($value !~ tr/ \n//c) {
694 9         25 $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
695             }
696             elsif ($value =~ tr/\n//) {
697 53 50       193 $style = $flow ? YAML_DOUBLE_QUOTED_SCALAR_STYLE : YAML_LITERAL_SCALAR_STYLE;
698             }
699             elsif ($forbidden_first{ $first }) {
700 76         196 $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
701             }
702             elsif ($flow and $value =~ tr/,[]{}//) {
703 0         0 $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
704             }
705             elsif (substr($value, 0, 3) =~ m/^(?:---|\.\.\.)/) {
706 0         0 $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
707             }
708             elsif ($value =~ m/: /) {
709 4         11 $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
710             }
711             elsif ($value =~ m/ #/) {
712 8         22 $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
713             }
714             elsif ($value =~ m/[: \t]\z/) {
715 21         61 $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
716             }
717             elsif ($value =~ m/[^\x20-\x3A\x3B-\x7E\x85\xA0-\x{D7FF}\x{E000}-\x{FEFE}\x{FF00}-\x{FFFD}\x{10000}-\x{10FFFF}]/) {
718 0         0 $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
719             }
720             elsif ($forbidden_first_plus_space{ $first }) {
721 97 100 100     554 if (length ($value) == 1 or substr($value, 1, 1) =~ m/^\s/) {
722 16         36 $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
723             }
724             }
725             }
726 2897 100 100     7793 if ($style == YAML_SINGLE_QUOTED_SCALAR_STYLE and not $info->{style}) {
727 129 100 100     421 if ($value =~ tr/'// and $value !~ tr/"//) {
728 6         11 $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
729             }
730             }
731 2897         9846 return $style;
732             }
733              
734             sub _emit_scalar {
735 2897     2897   10093 my ($self, %args) = @_;
736 2897         4993 my $props = $args{props};
737 2897         4220 my $value = $args{value};
738 2897         4273 my $style = $args{style};
739 2897         5138 my $stack = $self->event_stack;
740 2897         4360 my $last = $stack->[-1];
741 2897         4348 my $flow = $last->{flow};
742              
743 2897         4220 my $yaml = '';
744 2897         3997 my $pvalue = $props;
745 2897 100 100     8755 if ($props and length $value) {
    100          
746 70         170 $pvalue .= " $value";
747             }
748             elsif (length $value) {
749 2407         3989 $pvalue .= $value;
750             }
751 2897 100       4636 if ($flow) {
752 250 100 100     520 if ($props and not length $value) {
753 36         76 $pvalue .= ' ';
754             }
755             $yaml = $self->_emit_flow_scalar(
756             value => $value,
757             pvalue => $pvalue,
758             style => $args{style},
759 250         547 );
760             }
761             else {
762             $yaml = $self->_emit_block_scalar(
763             props => $props,
764             value => $value,
765             pvalue => $pvalue,
766             indent => $args{indent},
767             style => $args{style},
768 2647         6186 );
769             }
770 2897         7239 return $yaml;
771             }
772              
773             sub _emit_block_scalar {
774 2647     2647   9980 my ($self, %args) = @_;
775 2647         4261 my $props = $args{props};
776 2647         3814 my $value = $args{value};
777 2647         4012 my $pvalue = $args{pvalue};
778 2647         3643 my $indent = $args{indent};
779 2647         3721 my $style = $args{style};
780 2647         4455 my $stack = $self->event_stack;
781 2647         3800 my $last = $stack->[-1];
782              
783 2647         3307 my $yaml;
784 2647 100 100     9353 if ($last->{type} eq 'MAP' or $last->{type} eq 'SEQ') {
785 1067 100 100     3212 if ($last->{index} == 0 and $last->{newline}) {
786 267         475 $yaml .= "\n";
787 267         426 $last->{column} = 0;
788 267         499 $last->{newline} = 0;
789             }
790             }
791 2647         4006 my $space = ' ';
792 2647   100     7355 my $multiline = ($style == YAML_LITERAL_SCALAR_STYLE or $style == YAML_FOLDED_SCALAR_STYLE);
793 2647 100       4865 if ($last->{type} eq 'MAP') {
794              
795 610 100       1063 if ($last->{column}) {
796 158 100       315 my $space = $self->indent > 1 ? ' ' x ($self->indent - 1) : ' ';
797 158         281 $yaml .= $space;
798             }
799             else {
800 452         685 $yaml .= $indent;
801             }
802 610 100 100     1400 if ($props and not length $value) {
803 72         118 $pvalue .= ' ';
804             }
805 610         1042 $last->{type} = 'MAPVALUE';
806 610 100       1126 if ($multiline) {
807             # oops, a complex key
808 7         23 $yaml .= "? ";
809 7         16 $last->{type} = 'COMPLEXVALUE';
810             }
811 610 100       1150 if (not $multiline) {
812 603         913 $pvalue .= ":";
813             }
814             }
815             else {
816 2037 100       4809 if ($last->{type} eq 'MAPVALUE') {
    100          
817 478         819 $last->{type} = 'MAP';
818             }
819             elsif ($last->{type} eq 'DOC') {
820             }
821             else {
822 474 100       893 if ($last->{column}) {
823 100 100       225 my $space = $self->indent > 1 ? ' ' x ($self->indent - 1) : ' ';
824 100         200 $yaml .= $space;
825             }
826             else {
827 374         591 $yaml .= $indent;
828             }
829 474 100       1167 if ($last->{type} eq 'COMPLEXVALUE') {
    50          
830 17         46 $last->{type} = 'MAP';
831 17         42 $yaml .= ":";
832             }
833             elsif ($last->{type} eq 'SEQ') {
834 457         621 $yaml .= "-";
835             }
836             else {
837 0         0 die "Should not happen ($last->{type} in scalar_event)";
838              
839             }
840 474         687 $last->{column} = 1;
841             }
842              
843 2037 100       4060 if (length $pvalue) {
844 1909 100       3645 if ($last->{column}) {
845 920         1979 $pvalue = "$space$pvalue";
846             }
847             }
848 2037 100       3922 if (not $multiline) {
849 1932         3380 $pvalue .= "\n";
850             }
851             }
852 2647         4286 $yaml .= $pvalue;
853 2647         7913 return $yaml;
854             }
855              
856             sub _emit_flow_scalar {
857 250     250   676 my ($self, %args) = @_;
858 250         403 my $value = $args{value};
859 250         344 my $pvalue = $args{pvalue};
860 250         390 my $stack = $self->event_stack;
861 250         332 my $last = $stack->[-1];
862              
863 250         338 my $yaml;
864 250 100       667 if ($last->{type} eq 'SEQ') {
    100          
    50          
865 65 100       152 if ($last->{index} == 0) {
866 37 100       76 if ($self->column) {
867 33         54 $yaml .= ' ';
868             }
869 37         67 $yaml .= "[";
870             }
871             else {
872 28         55 $yaml .= ", ";
873             }
874             }
875             elsif ($last->{type} eq 'MAP') {
876 93 100       196 if ($last->{index} == 0) {
877 70 100       138 if ($self->column) {
878 69         118 $yaml .= ' ';
879             }
880 70         105 $yaml .= "{";
881             }
882             else {
883 23         37 $yaml .= ", ";
884             }
885 93         153 $last->{type} = 'MAPVALUE';
886             }
887             elsif ($last->{type} eq 'MAPVALUE') {
888 92 50       183 if ($last->{index} == 0) {
889 0         0 die "Should not happen (index 0 in MAPVALUE)";
890             }
891 92         159 $yaml .= ": ";
892 92         150 $last->{type} = 'MAP';
893             }
894 250 100       396 if ($self->column + length $pvalue > $self->width) {
895 10         16 $yaml .= "\n";
896 10         21 $yaml .= $last->{indent};
897 10         18 $yaml .= ' ' x $self->indent;
898             }
899 250         393 $yaml .= $pvalue;
900 250         645 return $yaml;
901             }
902              
903             sub alias_event {
904 91     91 1 249 DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ alias_event\n";
905 91         158 my ($self, $info) = @_;
906 91         236 my $stack = $self->event_stack;
907 91         143 my $last = $stack->[-1];
908 91         159 my $indent = $last->{indent};
909 91         163 my $flow = $last->{flow};
910              
911 91         192 my $alias = '*' . $info->{value};
912              
913 91         138 my $yaml = '';
914 91 100 100     343 if ($last->{type} eq 'MAP' or $last->{type} eq 'SEQ') {
915 67 50 66     211 if ($last->{index} == 0 and $last->{newline}) {
916 0         0 $yaml .= "\n";
917 0         0 $last->{column} = 0;
918 0         0 $last->{newline} = 0;
919             }
920             }
921 91 100       201 $yaml .= $last->{column} ? ' ' : $indent;
922 91 100       171 if ($flow) {
923 2         3 my $space = '';
924 2 50       7 if ($last->{type} eq 'SEQ') {
    50          
    0          
925 0 0       0 if ($last->{index} == 0) {
926 0 0       0 if ($flow == 1) {
927 0         0 $yaml .= ' ';
928             }
929 0         0 $yaml .= "[";
930             }
931             else {
932 0         0 $yaml .= ", ";
933             }
934             }
935             elsif ($last->{type} eq 'MAP') {
936 2 50       8 if ($last->{index} == 0) {
937 0 0       0 if ($flow == 1) {
938 0         0 $yaml .= ' ';
939             }
940 0         0 $yaml .= "{";
941             }
942             else {
943 2         3 $yaml .= ", ";
944             }
945 2         4 $last->{type} = 'MAPVALUE';
946 2         3 $space = ' ';
947             }
948             elsif ($last->{type} eq 'MAPVALUE') {
949 0 0       0 if ($last->{index} == 0) {
950 0         0 die 23;
951 0 0       0 if ($flow == 1) {
952 0         0 $yaml .= ' ';
953             }
954 0         0 $yaml .= "{";
955             }
956             else {
957 0         0 $yaml .= ": ";
958             }
959 0         0 $last->{type} = 'MAP';
960             }
961 2         6 $yaml .= "$alias$space";
962             }
963             else {
964 89 100       194 if ($last->{type} eq 'MAP') {
965 12         28 $yaml .= "$alias :";
966 12         23 $last->{type} = 'MAPVALUE';
967             }
968             else {
969              
970 77 100       170 if ($last->{type} eq 'MAPVALUE') {
    50          
971 22         37 $last->{type} = 'MAP';
972             }
973             elsif ($last->{type} eq 'DOC') {
974             # TODO an alias at document level isn't actually valid
975             }
976             else {
977 55 100       154 if ($last->{type} eq 'COMPLEXVALUE') {
    50          
    50          
978 2         4 $last->{type} = 'MAP';
979 2         3 $yaml .= ": ";
980             }
981             elsif ($last->{type} eq 'COMPLEX') {
982 0         0 $yaml .= ": ";
983             }
984             elsif ($last->{type} eq 'SEQ') {
985 53         76 $yaml .= "- ";
986             }
987             else {
988 0         0 die "Unexpected";
989             }
990             }
991 77         130 $yaml .= "$alias\n";
992             }
993             }
994              
995 91         346 $self->_write("$yaml");
996 91         167 $last->{index}++;
997 91         201 $last->{column} = $self->column;
998 91         272 $self->{open_ended} = 0;
999             }
1000              
1001             sub document_start_event {
1002 1445     1445 1 3050 DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ document_start_event\n";
1003 1445         2504 my ($self, $info) = @_;
1004 1445         2181 my $newline = 0;
1005 1445         2336 my $implicit = $info->{implicit};
1006 1445 100       3083 if ($info->{version_directive}) {
1007 18 100       42 if ($self->{open_ended}) {
1008 10         25 $self->_write("...\n");
1009             }
1010 18         71 $self->_write("%YAML $info->{version_directive}->{major}.$info->{version_directive}->{minor}\n");
1011 18         32 $self->{open_ended} = 0;
1012 18         33 $implicit = 0; # we need ---
1013             }
1014 1445 100       3194 unless ($implicit) {
1015 297         457 $newline = 1;
1016 297         690 $self->_write("---");
1017             }
1018             $self->set_event_stack([
1019             {
1020 1445         3564 type => 'DOC', index => 0, indent => '', info => $info,
1021             newline => $newline, column => $self->column,
1022             }
1023             ]);
1024             }
1025              
1026             sub document_end_event {
1027 1444     1444 1 3138 DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ document_end_event\n";
1028 1444         2584 my ($self, $info) = @_;
1029 1444         3839 $self->set_event_stack([]);
1030 1444 100 100     5647 if ($self->{open_ended} or not $info->{implicit}) {
1031 126         356 $self->_write("...\n");
1032 126         303 $self->{open_ended} = 0;
1033             }
1034             else {
1035 1318         4824 $self->{open_ended} = 1;
1036             }
1037             }
1038              
1039       1389 1   sub stream_start_event {
1040             }
1041              
1042       1388 1   sub stream_end_event {
1043             }
1044              
1045             sub _emit_tag {
1046 226     226   497 my ($self, $type, $tag) = @_;
1047 226         450 my $map = $self->tagmap;
1048 226         769 for my $key (sort keys %$map) {
1049 226 100       1623 if ($tag =~ m/^\Q$key\E(.*)/) {
1050 184         579 $tag = $map->{ $key } . $1;
1051 184         496 return $tag;
1052             }
1053             }
1054 42 50       240 if ($tag =~ m/^(!.*)/) {
1055 42         119 $tag = "$1";
1056             }
1057             else {
1058 0         0 $tag = "!<$tag>";
1059             }
1060 42         94 return $tag;
1061             }
1062              
1063             sub finish {
1064 1290     1290 1 2473 my ($self) = @_;
1065 1290         2152 $self->writer->finish;
1066             }
1067              
1068             sub _write {
1069 4478     4478   8428 my ($self, $yaml) = @_;
1070 4478 100       9146 return unless length $yaml;
1071 4038         11592 my @lines = split m/\n/, $yaml, -1;
1072 4038         7259 my $newlines = @lines - 1;
1073 4038         6482 $self->{line} += $newlines;
1074 4038 100       7968 if (length $lines[-1]) {
1075 1666 100       2751 if ($newlines) {
1076 243         457 $self->{column} = length $lines[-1];
1077             }
1078             else {
1079 1423         2213 $self->{column} += length $lines[-1];
1080             }
1081             }
1082             else {
1083 2372         3642 $self->{column} = 0;
1084             }
1085 4038         7454 $self->writer->write($yaml);
1086             }
1087              
1088             1;
1089              
1090             __END__