← Index
NYTProf Performance Profile   « line view »
For ../prof.pl
  Run on Wed Dec 14 15:33:55 2022
Reported on Wed Dec 14 15:40:04 2022

Filename/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/YAML/PP/Emitter.pm
StatementsExecuted 36 statements in 5.50ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11133µs58µsYAML::PP::Emitter::::BEGIN@6YAML::PP::Emitter::BEGIN@6
11124µs47µsYAML::PP::Emitter::::initYAML::PP::Emitter::init
11120µs22µsYAML::PP::Dumper::::BEGIN@1 YAML::PP::Dumper::BEGIN@1
1119µs56µsYAML::PP::Emitter::::newYAML::PP::Emitter::new
1118µs55µsYAML::PP::Emitter::::BEGIN@15YAML::PP::Emitter::BEGIN@15
1118µs40µsYAML::PP::Emitter::::BEGIN@8YAML::PP::Emitter::BEGIN@8
1115µs28µsYAML::PP::Dumper::::BEGIN@2 YAML::PP::Dumper::BEGIN@2
1115µs29µsYAML::PP::Emitter::::BEGIN@16YAML::PP::Emitter::BEGIN@16
2214µs4µsYAML::PP::Emitter::::writerYAML::PP::Emitter::writer
1112µs2µsYAML::PP::Emitter::::set_tagmapYAML::PP::Emitter::set_tagmap
1112µs2µsYAML::PP::Emitter::::set_writerYAML::PP::Emitter::set_writer
0000s0sYAML::PP::Emitter::::_emit_block_scalarYAML::PP::Emitter::_emit_block_scalar
0000s0sYAML::PP::Emitter::::_emit_flow_scalarYAML::PP::Emitter::_emit_flow_scalar
0000s0sYAML::PP::Emitter::::_emit_scalarYAML::PP::Emitter::_emit_scalar
0000s0sYAML::PP::Emitter::::_emit_tagYAML::PP::Emitter::_emit_tag
0000s0sYAML::PP::Emitter::::_find_best_scalar_styleYAML::PP::Emitter::_find_best_scalar_style
0000s0sYAML::PP::Emitter::::_writeYAML::PP::Emitter::_write
0000s0sYAML::PP::Emitter::::alias_eventYAML::PP::Emitter::alias_event
0000s0sYAML::PP::Emitter::::cloneYAML::PP::Emitter::clone
0000s0sYAML::PP::Emitter::::columnYAML::PP::Emitter::column
0000s0sYAML::PP::Emitter::::document_end_eventYAML::PP::Emitter::document_end_event
0000s0sYAML::PP::Emitter::::document_start_eventYAML::PP::Emitter::document_start_event
0000s0sYAML::PP::Emitter::::event_stackYAML::PP::Emitter::event_stack
0000s0sYAML::PP::Emitter::::finishYAML::PP::Emitter::finish
0000s0sYAML::PP::Emitter::::indentYAML::PP::Emitter::indent
0000s0sYAML::PP::Emitter::::lineYAML::PP::Emitter::line
0000s0sYAML::PP::Emitter::::mapping_end_eventYAML::PP::Emitter::mapping_end_event
0000s0sYAML::PP::Emitter::::mapping_start_eventYAML::PP::Emitter::mapping_start_event
0000s0sYAML::PP::Emitter::::scalar_eventYAML::PP::Emitter::scalar_event
0000s0sYAML::PP::Emitter::::sequence_end_eventYAML::PP::Emitter::sequence_end_event
0000s0sYAML::PP::Emitter::::sequence_start_eventYAML::PP::Emitter::sequence_start_event
0000s0sYAML::PP::Emitter::::set_event_stackYAML::PP::Emitter::set_event_stack
0000s0sYAML::PP::Emitter::::set_indentYAML::PP::Emitter::set_indent
0000s0sYAML::PP::Emitter::::stream_end_eventYAML::PP::Emitter::stream_end_event
0000s0sYAML::PP::Emitter::::stream_start_eventYAML::PP::Emitter::stream_start_event
0000s0sYAML::PP::Emitter::::tagmapYAML::PP::Emitter::tagmap
0000s0sYAML::PP::Emitter::::widthYAML::PP::Emitter::width
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1225µs224µs
# spent 22µs (20+2) within YAML::PP::Dumper::BEGIN@1 which was called: # once (20µs+2µs) by YAML::PP::Dumper::BEGIN@9 at line 1
use strict;
# spent 22µs making 1 call to YAML::PP::Dumper::BEGIN@1 # spent 2µs making 1 call to strict::import
2238µs251µs
# spent 28µs (5+23) within YAML::PP::Dumper::BEGIN@2 which was called: # once (5µs+23µs) by YAML::PP::Dumper::BEGIN@9 at line 2
use warnings;
# spent 28µs making 1 call to YAML::PP::Dumper::BEGIN@2 # spent 23µs making 1 call to warnings::import
3package YAML::PP::Emitter;
4
511µsour $VERSION = '0.035'; # VERSION
6263µs283µs
# spent 58µs (33+25) within YAML::PP::Emitter::BEGIN@6 which was called: # once (33µs+25µs) by YAML::PP::Dumper::BEGIN@9 at line 6
use Data::Dumper;
# spent 58µs making 1 call to YAML::PP::Emitter::BEGIN@6 # spent 25µs making 1 call to Exporter::import
7
811µs
# spent 40µs (8+32) within YAML::PP::Emitter::BEGIN@8 which was called: # once (8µs+32µs) by YAML::PP::Dumper::BEGIN@9 at line 13
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
13145µs272µs/;
# spent 40µs making 1 call to YAML::PP::Emitter::BEGIN@8 # spent 32µs making 1 call to Exporter::import
14
15225µs2102µs
# spent 55µs (8+47) within YAML::PP::Emitter::BEGIN@15 which was called: # once (8µs+47µs) by YAML::PP::Dumper::BEGIN@9 at line 15
use constant DEBUG => $ENV{YAML_PP_EMIT_DEBUG} ? 1 : 0;
# spent 55µs making 1 call to YAML::PP::Emitter::BEGIN@15 # spent 47µs making 1 call to constant::import
1625.17ms253µs
# spent 29µs (5+24) within YAML::PP::Emitter::BEGIN@16 which was called: # once (5µs+24µs) by YAML::PP::Dumper::BEGIN@9 at line 16
use constant DEFAULT_WIDTH => 80;
# spent 29µs making 1 call to YAML::PP::Emitter::BEGIN@16 # spent 24µs making 1 call to constant::import
17
18
# spent 56µs (9+47) within YAML::PP::Emitter::new which was called: # once (9µs+47µs) by YAML::PP::Dumper::new at line 37 of YAML/PP/Dumper.pm
sub new {
1911µs my ($class, %args) = @_;
20 my $self = bless {
21 indent => $args{indent} || 2,
22 writer => $args{writer},
2312µs width => $args{width} || DEFAULT_WIDTH,
24 }, $class;
2513µs147µs $self->init;
# spent 47µs making 1 call to YAML::PP::Emitter::init
2613µs return $self;
27}
28
29sub clone {
30 my ($self) = @_;
31 my $clone = {
32 indent => $self->indent,
33 };
34 return bless $clone, ref $self;
35}
36
37sub event_stack { return $_[0]->{event_stack} }
38sub set_event_stack { $_[0]->{event_stack} = $_[1] }
39sub indent { return $_[0]->{indent} }
40sub width { return $_[0]->{width} }
41sub line { return $_[0]->{line} }
42sub column { return $_[0]->{column} }
43sub set_indent { $_[0]->{indent} = $_[1] }
4427µs
# spent 4µs within YAML::PP::Emitter::writer which was called 2 times, avg 2µs/call: # once (3µs+0s) by YAML::PP::Emitter::init at line 51 # once (1µs+0s) by YAML::PP::Emitter::init at line 60
sub writer { $_[0]->{writer} }
4513µs
# spent 2µs within YAML::PP::Emitter::set_writer which was called: # once (2µs+0s) by YAML::PP::Emitter::init at line 51
sub set_writer { $_[0]->{writer} = $_[1] }
46sub tagmap { return $_[0]->{tagmap} }
4713µs
# spent 2µs within YAML::PP::Emitter::set_tagmap which was called: # once (2µs+0s) by YAML::PP::Emitter::init at line 55
sub set_tagmap { $_[0]->{tagmap} = $_[1] }
48
49
# spent 47µs (24+23) within YAML::PP::Emitter::init which was called: # once (24µs+23µs) by YAML::PP::Emitter::new at line 25
sub init {
5011µs my ($self) = @_;
5116µs39µs unless ($self->writer) {
# spent 4µs making 1 call to YAML::PP::Writer::new # spent 3µs making 1 call to YAML::PP::Emitter::writer # spent 2µs making 1 call to YAML::PP::Emitter::set_writer
52 $self->set_writer(YAML::PP::Writer->new);
53 }
54 $self->set_tagmap({
5513µs12µs 'tag:yaml.org,2002:' => '!!',
# spent 2µs making 1 call to YAML::PP::Emitter::set_tagmap
56 });
5711µs $self->{open_ended} = 0;
5811µs $self->{line} = 0;
5911µs $self->{column} = 0;
6014µs212µs $self->writer->init;
# spent 11µs making 1 call to YAML::PP::Writer::init # spent 1µs making 1 call to YAML::PP::Emitter::writer
61}
62
63sub mapping_start_event {
64 DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ mapping_start_event\n";
65 my ($self, $info) = @_;
66 my $stack = $self->event_stack;
67 my $last = $stack->[-1];
68 my $indent = $last->{indent};
69 my $new_indent = $indent;
70 my $yaml = '';
71
72 my $props = '';
73 my $anchor = $info->{anchor};
74 my $tag = $info->{tag};
75 if (defined $anchor) {
76 $anchor = "&$anchor";
77 }
78 if (defined $tag) {
79 $tag = $self->_emit_tag('map', $tag);
80 }
81 $props = join ' ', grep defined, ($anchor, $tag);
82
83 my $flow = $last->{flow} || 0;
84 $flow++ if ($info->{style} || 0) eq YAML_FLOW_MAPPING_STYLE;
85
86 my $newline = 0;
87 if ($flow > 1) {
88 if ($last->{type} eq 'SEQ') {
89 if ($last->{newline}) {
90 $yaml .= ' ';
91 }
92 if ($last->{index} == 0) {
93 $yaml .= "[";
94 }
95 else {
96 $yaml .= ",";
97 }
98 }
99 elsif ($last->{type} eq 'MAP') {
100 if ($last->{newline}) {
101 $yaml .= ' ';
102 }
103 if ($last->{index} == 0) {
104 $yaml .= "{";
105 }
106 else {
107 $yaml .= ",";
108 }
109 }
110 elsif ($last->{type} eq 'MAPVALUE') {
111 if ($last->{index} == 0) {
112 die "Should not happen (index 0 in MAPVALUE)";
113 }
114 $yaml .= ": ";
115 }
116 if ($props) {
117 $yaml .= " $props ";
118 }
119 $new_indent .= ' ' x $self->indent;
120 }
121 else {
122 if ($last->{type} eq 'DOC') {
123 $newline = $last->{newline};
124 }
125 else {
126 if ($last->{newline}) {
127 $yaml .= "\n";
128 $last->{column} = 0;
129 }
130 if ($last->{type} eq 'MAPVALUE') {
131 $new_indent .= ' ' x $self->indent;
132 $newline = 1;
133 }
134 else {
135 $new_indent = $indent;
136 if (not $props and $self->indent == 1) {
137 $new_indent .= ' ' x 2;
138 }
139 else {
140 $new_indent .= ' ' x $self->indent;
141 }
142
143 if ($last->{column}) {
144 my $space = $self->indent > 1 ? ' ' x ($self->indent - 1) : ' ';
145 $yaml .= $space;
146 }
147 else {
148 $yaml .= $indent;
149 }
150 if ($last->{type} eq 'SEQ') {
151 $yaml .= '-';
152 }
153 elsif ($last->{type} eq 'MAP') {
154 $yaml .= "?";
155 $last->{type} = 'COMPLEX';
156 }
157 elsif ($last->{type} eq 'COMPLEXVALUE') {
158 $yaml .= ":";
159 }
160 else {
161 die "Should not happen ($last->{type} in mapping_start)";
162 }
163 $last->{column} = 1;
164 }
165 $last->{newline} = 0;
166 }
167 if ($props) {
168 $yaml .= $last->{column} ? ' ' : $indent;
169 $yaml .= $props;
170 $newline = 1;
171 }
172 }
173 $self->_write($yaml);
174 my $new_info = {
175 index => 0, indent => $new_indent, info => $info,
176 newline => $newline,
177 column => $self->column,
178 flow => $flow,
179 };
180 $new_info->{type} = 'MAP';
181 push @{ $stack }, $new_info;
182 $last->{index}++;
183 $self->{open_ended} = 0;
184}
185
186sub mapping_end_event {
187 DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ mapping_end_event\n";
188 my ($self, $info) = @_;
189 my $stack = $self->event_stack;
190
191 my $last = pop @{ $stack };
192 if ($last->{index} == 0) {
193 my $indent = $last->{indent};
194 my $zero_indent = $last->{zero_indent};
195 if ($last->{zero_indent}) {
196 $indent .= ' ' x $self->indent;
197 }
198 if ($self->column) {
199 $self->_write(" {}\n");
200 }
201 else {
202 $self->_write("$indent\{}\n");
203 }
204 }
205 elsif ($last->{flow}) {
206 my $yaml = "}";
207 if ($last->{flow} == 1) {
208 $yaml .= "\n";
209 }
210 $self->_write("$yaml");
211 }
212 $last = $stack->[-1];
213 $last->{column} = $self->column;
214 if ($last->{type} eq 'SEQ') {
215 }
216 elsif ($last->{type} eq 'MAP') {
217 $last->{type} = 'MAPVALUE';
218 }
219 elsif ($last->{type} eq 'MAPVALUE') {
220 $last->{type} = 'MAP';
221 }
222 elsif ($last->{type} eq 'COMPLEX') {
223 $last->{type} = 'COMPLEXVALUE';
224 }
225 elsif ($last->{type} eq 'COMPLEXVALUE') {
226 $last->{type} = 'MAP';
227 }
228}
229
230sub sequence_start_event {
231 DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ sequence_start_event\n";
232 my ($self, $info) = @_;
233 my $stack = $self->event_stack;
234 my $last = $stack->[-1];
235 my $indent = $last->{indent};
236 my $new_indent = $indent;
237 my $yaml = '';
238
239 my $props = '';
240 my $anchor = $info->{anchor};
241 my $tag = $info->{tag};
242 if (defined $anchor) {
243 $anchor = "&$anchor";
244 }
245 if (defined $tag) {
246 $tag = $self->_emit_tag('seq', $tag);
247 }
248 $props = join ' ', grep defined, ($anchor, $tag);
249
250 my $flow = $last->{flow} || 0;
251 $flow++ if $flow or ($info->{style} || 0) eq YAML_FLOW_SEQUENCE_STYLE;
252 my $newline = 0;
253 my $zero_indent = 0;
254 if ($flow > 1) {
255 if ($last->{type} eq 'SEQ') {
256 if ($last->{newline}) {
257 $yaml .= ' ';
258 }
259 if ($last->{index} == 0) {
260 $yaml .= "[";
261 }
262 else {
263 $yaml .= ",";
264 }
265 }
266 elsif ($last->{type} eq 'MAP') {
267 if ($last->{newline}) {
268 $yaml .= ' ';
269 }
270 if ($last->{index} == 0) {
271 $yaml .= "{";
272 }
273 else {
274 $yaml .= ",";
275 }
276 }
277 elsif ($last->{type} eq 'MAPVALUE') {
278 if ($last->{index} == 0) {
279 die "Should not happen (index 0 in MAPVALUE)";
280 }
281 $yaml .= ": ";
282 }
283 if ($props) {
284 $yaml .= " $props ";
285 }
286 $new_indent .= ' ' x $self->indent;
287 }
288 else {
289 if ($last->{type} eq 'DOC') {
290 $newline = $last->{newline};
291 }
292 else {
293 if ($last->{newline}) {
294 $yaml .= "\n";
295 $last->{column} = 0;
296 }
297 if ($last->{type} eq 'MAPVALUE') {
298 $zero_indent = 1;
299 $newline = 1;
300 }
301 else {
302 if (not $props and $self->indent == 1) {
303 $new_indent .= ' ' x 2;
304 }
305 else {
306 $new_indent .= ' ' x $self->indent;
307 }
308 if ($last->{column}) {
309 my $space = $self->indent > 1 ? ' ' x ($self->indent - 1) : ' ';
310 $yaml .= $space;
311 }
312 else {
313 $yaml .= $indent;
314 }
315 if ($last->{type} eq 'SEQ') {
316 $yaml .= "-";
317 }
318 elsif ($last->{type} eq 'MAP') {
319 $last->{type} = 'COMPLEX';
320 $zero_indent = 1;
321 $yaml .= "?";
322 }
323 elsif ($last->{type} eq 'COMPLEXVALUE') {
324 $yaml .= ":";
325 $zero_indent = 1;
326 }
327 else {
328 die "Should not happen ($last->{type} in sequence_start)";
329 }
330 $last->{column} = 1;
331 }
332 $last->{newline} = 0;
333 }
334 if ($props) {
335 $yaml .= $last->{column} ? ' ' : $indent;
336 $yaml .= $props;
337 $newline = 1;
338 }
339 }
340 $self->_write($yaml);
341 $last->{index}++;
342 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 $new_info->{type} = 'SEQ';
352 push @{ $stack }, $new_info;
353 $self->{open_ended} = 0;
354}
355
356sub sequence_end_event {
357 DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ sequence_end_event\n";
358 my ($self, $info) = @_;
359 my $stack = $self->event_stack;
360
361 my $last = pop @{ $stack };
362 if ($last->{index} == 0) {
363 my $indent = $last->{indent};
364 my $zero_indent = $last->{zero_indent};
365 if ($last->{zero_indent}) {
366 $indent .= ' ' x $self->indent;
367 }
368 my $yaml .= $self->column ? ' ' : $indent;
369 $yaml .= "[]";
370 if ($last->{flow} < 2) {
371 $yaml .= "\n";
372 }
373 $self->_write($yaml);
374 }
375 elsif ($last->{flow}) {
376 my $yaml = "]";
377 if ($last->{flow} == 1) {
378 $yaml .= "\n";
379 }
380 $self->_write($yaml);
381 }
382 $last = $stack->[-1];
383 $last->{column} = $self->column;
384 if ($last->{type} eq 'SEQ') {
385 }
386 elsif ($last->{type} eq 'MAP') {
387 $last->{type} = 'MAPVALUE';
388 }
389 elsif ($last->{type} eq 'MAPVALUE') {
390 $last->{type} = 'MAP';
391 }
392 elsif ($last->{type} eq 'COMPLEX') {
393 $last->{type} = 'COMPLEXVALUE';
394 }
395 elsif ($last->{type} eq 'COMPLEXVALUE') {
396 $last->{type} = 'MAP';
397 }
398}
399
400110µsmy %forbidden_first = (qw/
401 ! 1 & 1 * 1 { 1 } 1 [ 1 ] 1 | 1 > 1 @ 1 ` 1 " 1 ' 1
402/, '#' => 1, '%' => 1, ',' => 1, " " => 1);
40312µsmy %forbidden_first_plus_space = (qw/
404 ? 1 - 1 : 1
405/);
406
407129µsmy %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
47510smy $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';
476119µsmy %to_escape = (
477 "\n" => '\n',
478 "\t" => '\t',
479 "\r" => '\r',
480 '\\' => '\\\\',
481 '"' => '\\"',
482 %control,
483);
48411µsmy $escape_re = $control_re . '\n\t\r';
48510smy $escape_re_without_lb = $control_re . '\t\r';
486
487
488sub scalar_event {
489 DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ scalar_event\n";
490 my ($self, $info) = @_;
491 my $stack = $self->event_stack;
492 my $last = $stack->[-1];
493 my $indent = $last->{indent};
494 my $value = $info->{value};
495 my $flow = $last->{flow};
496
497 my $props = '';
498 my $anchor = $info->{anchor};
499 my $tag = $info->{tag};
500 if (defined $anchor) {
501 $anchor = "&$anchor";
502 }
503 if (defined $tag) {
504 $tag = $self->_emit_tag('scalar', $tag);
505 }
506 $props = join ' ', grep defined, ($anchor, $tag);
507
508 DEBUG and local $Data::Dumper::Useqq = 1;
509 $value = '' unless defined $value;
510
511 my $style = $self->_find_best_scalar_style(
512 info => $info,
513 value => $value,
514 );
515
516 my $open_ended = 0;
517
518 if ($style == YAML_PLAIN_SCALAR_STYLE) {
519 $value =~ s/\n/\n\n/g;
520 }
521 elsif ($style == YAML_SINGLE_QUOTED_SCALAR_STYLE) {
522 my $new_indent = $last->{indent} . (' ' x $self->indent);
523 $value =~ s/(\n+)/"\n" x (1 + (length $1))/eg;
524 my @lines = split m/\n/, $value, -1;
525 if (@lines > 1) {
526 for my $line (@lines[1 .. $#lines]) {
527 $line = $new_indent . $line
528 if length $line;
529 }
530 }
531 $value = join "\n", @lines;
532 $value =~ s/'/''/g;
533 $value = "'" . $value . "'";
534 }
535 elsif ($style == YAML_LITERAL_SCALAR_STYLE) {
536 DEBUG and warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\$value], ['value']);
537 my $indicators = '';
538 if ($value =~ m/\A\n* +/) {
539 $indicators .= $self->indent;
540 }
541 my $indent = $indent . ' ' x $self->indent;
542 if ($value !~ m/\n\z/) {
543 $indicators .= '-';
544 $value .= "\n";
545 }
546 elsif ($value =~ m/(\n|\A)\n\z/) {
547 $indicators .= '+';
548 $open_ended = 1;
549 }
550 $value =~ s/^(?=.)/$indent/gm;
551 $value = "|$indicators\n$value";
552 }
553 elsif ($style == YAML_FOLDED_SCALAR_STYLE) {
554 DEBUG and warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\$value], ['value']);
555 my @lines = split /\n/, $value, -1;
556 DEBUG and warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\@lines], ['lines']);
557 my $trailing = -1;
558 while (@lines) {
559 last if $lines[-1] ne '';
560 pop @lines;
561 $trailing++;
562 }
563 my %start_with_space;
564 for my $i (0 .. $#lines) {
565 if ($lines[ $i ] =~ m/^[ \t]+/) {
566 $start_with_space{ $i } = 1;
567 }
568 }
569 my $indicators = '';
570 if ($value =~ m/\A\n* +/) {
571 $indicators .= $self->indent;
572 }
573 my $indent = $indent . ' ' x $self->indent;
574 if ($trailing > 0) {
575 $indicators .= '+';
576 $open_ended = 1;
577 }
578 elsif ($trailing < 0) {
579 $indicators .= '-';
580 }
581 $value = ">$indicators\n";
582 my $got_content = 0;
583 for my $i (0 .. $#lines) {
584 my $line = $lines[ $i ];
585 my $sp = $start_with_space{ $i } || 0;
586 my $spnext = $i == $#lines ? 1 : $start_with_space{ $i+1 } || 0;
587 my $spprev = $i == 0 ? 1 : $start_with_space{ $i-1 } || 0;
588 my $empty = length $line ? 0 : 1;
589 my $emptynext = $i == $#lines ? '' : length $lines[$i+1] ? 0 : 1;
590 my $nl = 0;
591 if ($empty) {
592 if ($spnext and $spprev) {
593 $nl = 1;
594 }
595 elsif (not $spnext) {
596 $nl = 1;
597 }
598 elsif (not $got_content) {
599 $nl = 1;
600 }
601 }
602 else {
603 $got_content = 1;
604 $value .= "$indent$line\n";
605 if (not $sp and not $spnext) {
606 $nl = 1;
607 }
608 }
609 if ($nl) {
610 $value .= "\n";
611 }
612 }
613 $value .= "\n" x ($trailing) if $trailing > 0;
614 }
615 else {
616 $value =~ s/([$escape_re"\\])/$to_escape{ $1 } || sprintf '\\u%04x', ord($1)/eg;
617 $value = '"' . $value . '"';
618 }
619
620 DEBUG and warn __PACKAGE__.':'.__LINE__.": (@$stack)\n";
621 my $yaml = $self->_emit_scalar(
622 indent => $indent,
623 props => $props,
624 value => $value,
625 style => $style,
626 );
627
628 $last->{index}++;
629 $last->{newline} = 0;
630 $self->_write($yaml);
631 $last->{column} = $self->column;
632 $self->{open_ended} = $open_ended;
633}
634
635sub _find_best_scalar_style {
636 my ($self, %args) = @_;
637 my $info = $args{info};
638 my $style = $info->{style};
639 my $value = $args{value};
640 my $stack = $self->event_stack;
641 my $last = $stack->[-1];
642 my $flow = $last->{flow};
643
644 my $first = substr($value, 0, 1);
645 if ($value eq '') {
646 if ($flow and $last->{type} ne 'MAPVALUE' and $last->{type} ne 'MAP') {
647 $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
648 }
649 elsif (not $style) {
650 $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
651 }
652 }
653 # no control characters anywhere
654 elsif ($value =~ m/[$control_re]/) {
655 $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
656 }
657 $style ||= YAML_PLAIN_SCALAR_STYLE;
658
659 if ($style == YAML_SINGLE_QUOTED_SCALAR_STYLE) {
660 if ($value =~ m/ \n/ or $value =~ m/\n / or $value =~ m/^\n/ or $value =~ m/\n$/) {
661 $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
662 }
663 elsif ($value eq "\n") {
664 $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
665 }
666 }
667 elsif ($style == YAML_LITERAL_SCALAR_STYLE or $style == YAML_FOLDED_SCALAR_STYLE) {
668 if ($value eq '') {
669 $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
670 }
671 elsif ($flow) {
672 # no block scalars in flow
673 if ($value =~ tr/\n//) {
674 $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
675 }
676 else {
677 $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
678 }
679 }
680 }
681 elsif ($style == YAML_PLAIN_SCALAR_STYLE) {
682 if (not length $value) {
683 }
684 elsif ($value =~ m/[$escape_re_without_lb]/) {
685 $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
686 }
687 elsif ($value eq "\n") {
688 $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
689 }
690 elsif ($value !~ tr/ //c) {
691 $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
692 }
693 elsif ($value !~ tr/ \n//c) {
694 $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
695 }
696 elsif ($value =~ tr/\n//) {
697 $style = $flow ? YAML_DOUBLE_QUOTED_SCALAR_STYLE : YAML_LITERAL_SCALAR_STYLE;
698 }
699 elsif ($forbidden_first{ $first }) {
700 $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
701 }
702 elsif ($flow and $value =~ tr/,[]{}//) {
703 $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
704 }
705 elsif (substr($value, 0, 3) =~ m/^(?:---|\.\.\.)/) {
706 $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
707 }
708 elsif ($value =~ m/: /) {
709 $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
710 }
711 elsif ($value =~ m/ #/) {
712 $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
713 }
714 elsif ($value =~ m/[: \t]\z/) {
715 $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 $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
719 }
720 elsif ($forbidden_first_plus_space{ $first }) {
721 if (length ($value) == 1 or substr($value, 1, 1) =~ m/^\s/) {
722 $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
723 }
724 }
725 }
726 if ($style == YAML_SINGLE_QUOTED_SCALAR_STYLE and not $info->{style}) {
727 if ($value =~ tr/'// and $value !~ tr/"//) {
728 $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
729 }
730 }
731 return $style;
732}
733
734sub _emit_scalar {
735 my ($self, %args) = @_;
736 my $props = $args{props};
737 my $value = $args{value};
738 my $style = $args{style};
739 my $stack = $self->event_stack;
740 my $last = $stack->[-1];
741 my $flow = $last->{flow};
742
743 my $yaml = '';
744 my $pvalue = $props;
745 if ($props and length $value) {
746 $pvalue .= " $value";
747 }
748 elsif (length $value) {
749 $pvalue .= $value;
750 }
751 if ($flow) {
752 if ($props and not length $value) {
753 $pvalue .= ' ';
754 }
755 $yaml = $self->_emit_flow_scalar(
756 value => $value,
757 pvalue => $pvalue,
758 style => $args{style},
759 );
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 );
769 }
770 return $yaml;
771}
772
773sub _emit_block_scalar {
774 my ($self, %args) = @_;
775 my $props = $args{props};
776 my $value = $args{value};
777 my $pvalue = $args{pvalue};
778 my $indent = $args{indent};
779 my $style = $args{style};
780 my $stack = $self->event_stack;
781 my $last = $stack->[-1];
782
783 my $yaml;
784 if ($last->{type} eq 'MAP' or $last->{type} eq 'SEQ') {
785 if ($last->{index} == 0 and $last->{newline}) {
786 $yaml .= "\n";
787 $last->{column} = 0;
788 $last->{newline} = 0;
789 }
790 }
791 my $space = ' ';
792 my $multiline = ($style == YAML_LITERAL_SCALAR_STYLE or $style == YAML_FOLDED_SCALAR_STYLE);
793 if ($last->{type} eq 'MAP') {
794
795 if ($last->{column}) {
796 my $space = $self->indent > 1 ? ' ' x ($self->indent - 1) : ' ';
797 $yaml .= $space;
798 }
799 else {
800 $yaml .= $indent;
801 }
802 if ($props and not length $value) {
803 $pvalue .= ' ';
804 }
805 $last->{type} = 'MAPVALUE';
806 if ($multiline) {
807 # oops, a complex key
808 $yaml .= "? ";
809 $last->{type} = 'COMPLEXVALUE';
810 }
811 if (not $multiline) {
812 $pvalue .= ":";
813 }
814 }
815 else {
816 if ($last->{type} eq 'MAPVALUE') {
817 $last->{type} = 'MAP';
818 }
819 elsif ($last->{type} eq 'DOC') {
820 }
821 else {
822 if ($last->{column}) {
823 my $space = $self->indent > 1 ? ' ' x ($self->indent - 1) : ' ';
824 $yaml .= $space;
825 }
826 else {
827 $yaml .= $indent;
828 }
829 if ($last->{type} eq 'COMPLEXVALUE') {
830 $last->{type} = 'MAP';
831 $yaml .= ":";
832 }
833 elsif ($last->{type} eq 'SEQ') {
834 $yaml .= "-";
835 }
836 else {
837 die "Should not happen ($last->{type} in scalar_event)";
838
839 }
840 $last->{column} = 1;
841 }
842
843 if (length $pvalue) {
844 if ($last->{column}) {
845 $pvalue = "$space$pvalue";
846 }
847 }
848 if (not $multiline) {
849 $pvalue .= "\n";
850 }
851 }
852 $yaml .= $pvalue;
853 return $yaml;
854}
855
856sub _emit_flow_scalar {
857 my ($self, %args) = @_;
858 my $value = $args{value};
859 my $pvalue = $args{pvalue};
860 my $stack = $self->event_stack;
861 my $last = $stack->[-1];
862
863 my $yaml;
864 if ($last->{type} eq 'SEQ') {
865 if ($last->{index} == 0) {
866 if ($self->column) {
867 $yaml .= ' ';
868 }
869 $yaml .= "[";
870 }
871 else {
872 $yaml .= ", ";
873 }
874 }
875 elsif ($last->{type} eq 'MAP') {
876 if ($last->{index} == 0) {
877 if ($self->column) {
878 $yaml .= ' ';
879 }
880 $yaml .= "{";
881 }
882 else {
883 $yaml .= ", ";
884 }
885 $last->{type} = 'MAPVALUE';
886 }
887 elsif ($last->{type} eq 'MAPVALUE') {
888 if ($last->{index} == 0) {
889 die "Should not happen (index 0 in MAPVALUE)";
890 }
891 $yaml .= ": ";
892 $last->{type} = 'MAP';
893 }
894 if ($self->column + length $pvalue > $self->width) {
895 $yaml .= "\n";
896 $yaml .= $last->{indent};
897 $yaml .= ' ' x $self->indent;
898 }
899 $yaml .= $pvalue;
900 return $yaml;
901}
902
903sub alias_event {
904 DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ alias_event\n";
905 my ($self, $info) = @_;
906 my $stack = $self->event_stack;
907 my $last = $stack->[-1];
908 my $indent = $last->{indent};
909 my $flow = $last->{flow};
910
911 my $alias = '*' . $info->{value};
912
913 my $yaml = '';
914 if ($last->{type} eq 'MAP' or $last->{type} eq 'SEQ') {
915 if ($last->{index} == 0 and $last->{newline}) {
916 $yaml .= "\n";
917 $last->{column} = 0;
918 $last->{newline} = 0;
919 }
920 }
921 $yaml .= $last->{column} ? ' ' : $indent;
922 if ($flow) {
923 my $space = '';
924 if ($last->{type} eq 'SEQ') {
925 if ($last->{index} == 0) {
926 if ($flow == 1) {
927 $yaml .= ' ';
928 }
929 $yaml .= "[";
930 }
931 else {
932 $yaml .= ", ";
933 }
934 }
935 elsif ($last->{type} eq 'MAP') {
936 if ($last->{index} == 0) {
937 if ($flow == 1) {
938 $yaml .= ' ';
939 }
940 $yaml .= "{";
941 }
942 else {
943 $yaml .= ", ";
944 }
945 $last->{type} = 'MAPVALUE';
946 $space = ' ';
947 }
948 elsif ($last->{type} eq 'MAPVALUE') {
949 if ($last->{index} == 0) {
950 die 23;
951 if ($flow == 1) {
952 $yaml .= ' ';
953 }
954 $yaml .= "{";
955 }
956 else {
957 $yaml .= ": ";
958 }
959 $last->{type} = 'MAP';
960 }
961 $yaml .= "$alias$space";
962 }
963 else {
964 if ($last->{type} eq 'MAP') {
965 $yaml .= "$alias :";
966 $last->{type} = 'MAPVALUE';
967 }
968 else {
969
970 if ($last->{type} eq 'MAPVALUE') {
971 $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 if ($last->{type} eq 'COMPLEXVALUE') {
978 $last->{type} = 'MAP';
979 $yaml .= ": ";
980 }
981 elsif ($last->{type} eq 'COMPLEX') {
982 $yaml .= ": ";
983 }
984 elsif ($last->{type} eq 'SEQ') {
985 $yaml .= "- ";
986 }
987 else {
988 die "Unexpected";
989 }
990 }
991 $yaml .= "$alias\n";
992 }
993 }
994
995 $self->_write("$yaml");
996 $last->{index}++;
997 $last->{column} = $self->column;
998 $self->{open_ended} = 0;
999}
1000
1001sub document_start_event {
1002 DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ document_start_event\n";
1003 my ($self, $info) = @_;
1004 my $newline = 0;
1005 my $implicit = $info->{implicit};
1006 if ($info->{version_directive}) {
1007 if ($self->{open_ended}) {
1008 $self->_write("...\n");
1009 }
1010 $self->_write("%YAML $info->{version_directive}->{major}.$info->{version_directive}->{minor}\n");
1011 $self->{open_ended} = 0;
1012 $implicit = 0; # we need ---
1013 }
1014 unless ($implicit) {
1015 $newline = 1;
1016 $self->_write("---");
1017 }
1018 $self->set_event_stack([
1019 {
1020 type => 'DOC', index => 0, indent => '', info => $info,
1021 newline => $newline, column => $self->column,
1022 }
1023 ]);
1024}
1025
1026sub document_end_event {
1027 DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ document_end_event\n";
1028 my ($self, $info) = @_;
1029 $self->set_event_stack([]);
1030 if ($self->{open_ended} or not $info->{implicit}) {
1031 $self->_write("...\n");
1032 $self->{open_ended} = 0;
1033 }
1034 else {
1035 $self->{open_ended} = 1;
1036 }
1037}
1038
1039sub stream_start_event {
1040}
1041
1042sub stream_end_event {
1043}
1044
1045sub _emit_tag {
1046 my ($self, $type, $tag) = @_;
1047 my $map = $self->tagmap;
1048 for my $key (sort keys %$map) {
1049 if ($tag =~ m/^\Q$key\E(.*)/) {
1050 $tag = $map->{ $key } . $1;
1051 return $tag;
1052 }
1053 }
1054 if ($tag =~ m/^(!.*)/) {
1055 $tag = "$1";
1056 }
1057 else {
1058 $tag = "!<$tag>";
1059 }
1060 return $tag;
1061}
1062
1063sub finish {
1064 my ($self) = @_;
1065 $self->writer->finish;
1066}
1067
1068sub _write {
1069 my ($self, $yaml) = @_;
1070 return unless length $yaml;
1071 my @lines = split m/\n/, $yaml, -1;
1072 my $newlines = @lines - 1;
1073 $self->{line} += $newlines;
1074 if (length $lines[-1]) {
1075 if ($newlines) {
1076 $self->{column} = length $lines[-1];
1077 }
1078 else {
1079 $self->{column} += length $lines[-1];
1080 }
1081 }
1082 else {
1083 $self->{column} = 0;
1084 }
1085 $self->writer->write($yaml);
1086}
1087
1088130µs1;
1089
1090__END__
Report produced by the NYTProf 6.12 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.