← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
  Run on Tue Oct 15 17:10:45 2013
Reported on Tue Oct 15 17:12:09 2013

Filename/usr/share/perl5/YAML/Loader.pm
StatementsExecuted 838 statements in 13.7ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1113.44ms56.7msYAML::Loader::::BEGIN@7YAML::Loader::BEGIN@7
32113.04ms9.35msYAML::Loader::::_parseYAML::Loader::_parse
32111.69ms3.30msYAML::Loader::::_parse_throwaway_commentsYAML::Loader::_parse_throwaway_comments
111875µs5.85msYAML::Loader::::BEGIN@6YAML::Loader::BEGIN@6
3211592µs10.3msYAML::Loader::::loadYAML::Loader::load
9631414µs414µsYAML::Loader::::CORE:substYAML::Loader::CORE:subst (opcode)
9631319µs319µsYAML::Loader::::CORE:matchYAML::Loader::CORE:match (opcode)
6411203µs203µsYAML::Loader::::CORE:substcontYAML::Loader::CORE:substcont (opcode)
321176µs76µsYAML::Loader::::CORE:regcompYAML::Loader::CORE:regcomp (opcode)
11130µs37µsYAML::Loader::::BEGIN@3YAML::Loader::BEGIN@3
11121µs58µsYAML::Loader::::BEGIN@285YAML::Loader::BEGIN@285
11119µs93µsYAML::Loader::::BEGIN@5YAML::Loader::BEGIN@5
11117µs42µsYAML::Loader::::BEGIN@4YAML::Loader::BEGIN@4
11116µs78µsYAML::Loader::::BEGIN@14YAML::Loader::BEGIN@14
11114µs68µsYAML::Loader::::BEGIN@13YAML::Loader::BEGIN@13
11113µs68µsYAML::Loader::::BEGIN@15YAML::Loader::BEGIN@15
11112µs64µsYAML::Loader::::BEGIN@16YAML::Loader::BEGIN@16
0000s0sYAML::Loader::::_parse_blockYAML::Loader::_parse_block
0000s0sYAML::Loader::::_parse_explicitYAML::Loader::_parse_explicit
0000s0sYAML::Loader::::_parse_implicitYAML::Loader::_parse_implicit
0000s0sYAML::Loader::::_parse_inlineYAML::Loader::_parse_inline
0000s0sYAML::Loader::::_parse_inline_double_quotedYAML::Loader::_parse_inline_double_quoted
0000s0sYAML::Loader::::_parse_inline_mappingYAML::Loader::_parse_inline_mapping
0000s0sYAML::Loader::::_parse_inline_seqYAML::Loader::_parse_inline_seq
0000s0sYAML::Loader::::_parse_inline_simpleYAML::Loader::_parse_inline_simple
0000s0sYAML::Loader::::_parse_inline_single_quotedYAML::Loader::_parse_inline_single_quoted
0000s0sYAML::Loader::::_parse_mappingYAML::Loader::_parse_mapping
0000s0sYAML::Loader::::_parse_next_lineYAML::Loader::_parse_next_line
0000s0sYAML::Loader::::_parse_nodeYAML::Loader::_parse_node
0000s0sYAML::Loader::::_parse_qualifiersYAML::Loader::_parse_qualifiers
0000s0sYAML::Loader::::_parse_seqYAML::Loader::_parse_seq
0000s0sYAML::Loader::::_parse_unfoldYAML::Loader::_parse_unfold
0000s0sYAML::Loader::::_unescapeYAML::Loader::_unescape
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package YAML::Loader;
2
3338µs244µs
# spent 37µs (30+7) within YAML::Loader::BEGIN@3 which was called: # once (30µs+7µs) by YAML::init_action_object at line 3
use strict;
# spent 37µs making 1 call to YAML::Loader::BEGIN@3 # spent 7µs making 1 call to strict::import
4333µs267µs
# spent 42µs (17+25) within YAML::Loader::BEGIN@4 which was called: # once (17µs+25µs) by YAML::init_action_object at line 4
use warnings;
# spent 42µs making 1 call to YAML::Loader::BEGIN@4 # spent 25µs making 1 call to warnings::import
5357µs2167µs
# spent 93µs (19+74) within YAML::Loader::BEGIN@5 which was called: # once (19µs+74µs) by YAML::init_action_object at line 5
use YAML::Base;
# spent 93µs making 1 call to YAML::Loader::BEGIN@5 # spent 74µs making 1 call to Exporter::import
63226µs25.92ms
# spent 5.85ms (875µs+4.98) within YAML::Loader::BEGIN@6 which was called: # once (875µs+4.98ms) by YAML::init_action_object at line 6
use YAML::Loader::Base;
# spent 5.85ms making 1 call to YAML::Loader::BEGIN@6 # spent 64µs making 1 call to Exporter::import
73328µs256.7ms
# spent 56.7ms (3.44+53.2) within YAML::Loader::BEGIN@7 which was called: # once (3.44ms+53.2ms) by YAML::init_action_object at line 7
use YAML::Types;
# spent 56.7ms making 1 call to YAML::Loader::BEGIN@7 # spent 56µs making 1 call to Exporter::import
8
912µsour $VERSION = '0.71';
10130µsour @ISA = 'YAML::Loader::Base';
11
12# Context constants
13350µs2121µs
# spent 68µs (14+54) within YAML::Loader::BEGIN@13 which was called: # once (14µs+54µs) by YAML::init_action_object at line 13
use constant LEAF => 1;
# spent 68µs making 1 call to YAML::Loader::BEGIN@13 # spent 54µs making 1 call to constant::import
14357µs2139µs
# spent 78µs (16+62) within YAML::Loader::BEGIN@14 which was called: # once (16µs+62µs) by YAML::init_action_object at line 14
use constant COLLECTION => 2;
# spent 78µs making 1 call to YAML::Loader::BEGIN@14 # spent 62µs making 1 call to constant::import
15351µs2124µs
# spent 68µs (13+56) within YAML::Loader::BEGIN@15 which was called: # once (13µs+56µs) by YAML::init_action_object at line 15
use constant VALUE => "\x07YAML\x07VALUE\x07";
# spent 68µs making 1 call to YAML::Loader::BEGIN@15 # spent 55µs making 1 call to constant::import
1632.56ms2116µs
# spent 64µs (12+52) within YAML::Loader::BEGIN@16 which was called: # once (12µs+52µs) by YAML::init_action_object at line 16
use constant COMMENT => "\x07YAML\x07COMMENT\x07";
# spent 64µs making 1 call to YAML::Loader::BEGIN@16 # spent 52µs making 1 call to constant::import
17
18# Common YAML character sets
1912µsmy $ESCAPE_CHAR = '[\\x00-\\x08\\x0b-\\x0d\\x0e-\\x1f]';
201600nsmy $FOLD_CHAR = '>';
211800nsmy $LIT_CHAR = '|';
2211µsmy $LIT_CHAR_RX = "\\$LIT_CHAR";
23
24
# spent 10.3ms (592µs+9.66) within YAML::Loader::load which was called 32 times, avg 321µs/call: # 32 times (592µs+9.66ms) by YAML::Load at line 36 of YAML.pm, avg 321µs/call
sub load {
2596495µs my $self = shift;
2632315µs $self->stream($_[0] || '');
# spent 315µs making 32 calls to YAML::Base::__ANON__[(eval 1074)[YAML/Base.pm:73]:7], avg 10µs/call
27329.35ms return $self->_parse();
# spent 9.35ms making 32 calls to YAML::Loader::_parse, avg 292µs/call
28}
29
30# Top level function for parsing. Parse each document in order and
31# handle processing for YAML headers.
32
# spent 9.35ms (3.04+6.31) within YAML::Loader::_parse which was called 32 times, avg 292µs/call: # 32 times (3.04ms+6.31ms) by YAML::Loader::load at line 27, avg 292µs/call
sub _parse {
334803.42ms my $self = shift;
34 my (%directives, $preface);
3532104µs $self->{stream} =~ s|\015\012|\012|g;
# spent 104µs making 32 calls to YAML::Loader::CORE:subst, avg 3µs/call
363229µs $self->{stream} =~ s|\015|\012|g;
# spent 29µs making 32 calls to YAML::Loader::CORE:subst, avg 891ns/call
3732360µs $self->line(0);
# spent 360µs making 32 calls to YAML::Base::__ANON__[(eval 1076)[YAML/Base.pm:73]:7], avg 11µs/call
3896318µs $self->die('YAML_PARSE_ERR_BAD_CHARS')
# spent 130µs making 32 calls to YAML::Base::__ANON__[(eval 1074)[YAML/Base.pm:73]:7], avg 4µs/call # spent 112µs making 32 calls to YAML::Loader::CORE:match, avg 4µs/call # spent 76µs making 32 calls to YAML::Loader::CORE:regcomp, avg 2µs/call
39 if $self->stream =~ /$ESCAPE_CHAR/;
40128597µs $self->die('YAML_PARSE_ERR_NO_FINAL_NEWLINE')
# spent 282µs making 32 calls to YAML::Loader::CORE:subst, avg 9µs/call # spent 203µs making 64 calls to YAML::Loader::CORE:substcont, avg 3µs/call # spent 112µs making 32 calls to YAML::Base::__ANON__[(eval 1074)[YAML/Base.pm:73]:7], avg 4µs/call
41 if length($self->stream) and
42 $self->{stream} !~ s/(.)\n\Z/$1/s;
4364467µs $self->lines([split /\x0a/, $self->stream, -1]);
# spent 318µs making 32 calls to YAML::Base::__ANON__[(eval 1078)[YAML/Base.pm:73]:7], avg 10µs/call # spent 149µs making 32 calls to YAML::Base::__ANON__[(eval 1074)[YAML/Base.pm:73]:7], avg 5µs/call
4432129µs $self->line(1);
# spent 129µs making 32 calls to YAML::Base::__ANON__[(eval 1076)[YAML/Base.pm:73]:7], avg 4µs/call
45 # Throw away any comments or blanks before the header (or start of
46 # content for headerless streams)
47323.30ms $self->_parse_throwaway_comments();
# spent 3.30ms making 32 calls to YAML::Loader::_parse_throwaway_comments, avg 103µs/call
4832353µs $self->document(0);
# spent 353µs making 32 calls to YAML::Base::__ANON__[(eval 1075)[YAML/Base.pm:73]:7], avg 11µs/call
4932323µs $self->documents([]);
# spent 323µs making 32 calls to YAML::Base::__ANON__[(eval 1077)[YAML/Base.pm:73]:7], avg 10µs/call
50 # Add an "assumed" header if there is no header and the stream is
51 # not empty (after initial throwaways).
5232128µs if (not $self->eos) {
# spent 128µs making 32 calls to YAML::Base::__ANON__[(eval 1079)[YAML/Base.pm:73]:7], avg 4µs/call
53 if ($self->lines->[0] !~ /^---(\s|$)/) {
54 unshift @{$self->lines}, '---';
55 $self->{line}--;
56 }
57 }
58
59 # Main Loop. Parse out all the top level nodes and return them.
603291µs while (not $self->eos) {
# spent 91µs making 32 calls to YAML::Base::__ANON__[(eval 1079)[YAML/Base.pm:73]:7], avg 3µs/call
61123µs $self->anchor2node({});
62 $self->{document}++;
63 $self->done(0);
64 $self->level(0);
65 $self->offset->[0] = -1;
66
67 if ($self->lines->[0] =~ /^---\s*(.*)$/) {
68 my @words = split /\s+/, $1;
69 %directives = ();
70 while (@words && $words[0] =~ /^#(\w+):(\S.*)$/) {
71 my ($key, $value) = ($1, $2);
72 shift(@words);
73 if (defined $directives{$key}) {
74 $self->warn('YAML_PARSE_WARN_MULTIPLE_DIRECTIVES',
75 $key, $self->document);
76 next;
77 }
78 $directives{$key} = $value;
79 }
80 $self->preface(join ' ', @words);
81 }
82 else {
83 $self->die('YAML_PARSE_ERR_NO_SEPARATOR');
84 }
85
86 if (not $self->done) {
87 $self->_parse_next_line(COLLECTION);
88 }
89 if ($self->done) {
90 $self->{indent} = -1;
91 $self->content('');
92 }
93
94 $directives{YAML} ||= '1.0';
95 $directives{TAB} ||= 'NONE';
96 ($self->{major_version}, $self->{minor_version}) =
97 split /\./, $directives{YAML}, 2;
98 $self->die('YAML_PARSE_ERR_BAD_MAJOR_VERSION', $directives{YAML})
99 if $self->major_version ne '1';
100 $self->warn('YAML_PARSE_WARN_BAD_MINOR_VERSION', $directives{YAML})
101 if $self->minor_version ne '0';
102 $self->die('Unrecognized TAB policy')
103 unless $directives{TAB} =~ /^(NONE|\d+)(:HARD)?$/;
104
105 push @{$self->documents}, $self->_parse_node();
106 }
10732119µs return wantarray ? @{$self->documents} : $self->documents->[-1];
# spent 119µs making 32 calls to YAML::Base::__ANON__[(eval 1077)[YAML/Base.pm:73]:7], avg 4µs/call
108}
109
110# This function is the dispatcher for parsing each node. Every node
111# recurses back through here. (Inlines are an exception as they have
112# their own sub-parser.)
113sub _parse_node {
114 my $self = shift;
115 my $preface = $self->preface;
116 $self->preface('');
117 my ($node, $type, $indicator, $escape, $chomp) = ('') x 5;
118 my ($anchor, $alias, $explicit, $implicit, $class) = ('') x 5;
119 ($anchor, $alias, $explicit, $implicit, $preface) =
120 $self->_parse_qualifiers($preface);
121 if ($anchor) {
122 $self->anchor2node->{$anchor} = CORE::bless [], 'YAML-anchor2node';
123 }
124 $self->inline('');
125 while (length $preface) {
126 my $line = $self->line - 1;
127 if ($preface =~ s/^($FOLD_CHAR|$LIT_CHAR_RX)(-|\+)?\d*\s*//) {
128 $indicator = $1;
129 $chomp = $2 if defined($2);
130 }
131 else {
132 $self->die('YAML_PARSE_ERR_TEXT_AFTER_INDICATOR') if $indicator;
133 $self->inline($preface);
134 $preface = '';
135 }
136 }
137 if ($alias) {
138 $self->die('YAML_PARSE_ERR_NO_ANCHOR', $alias)
139 unless defined $self->anchor2node->{$alias};
140 if (ref($self->anchor2node->{$alias}) ne 'YAML-anchor2node') {
141 $node = $self->anchor2node->{$alias};
142 }
143 else {
144 $node = do {my $sv = "*$alias"};
145 push @{$self->anchor2node->{$alias}}, [\$node, $self->line];
146 }
147 }
148 elsif (length $self->inline) {
149 $node = $self->_parse_inline(1, $implicit, $explicit);
150 if (length $self->inline) {
151 $self->die('YAML_PARSE_ERR_SINGLE_LINE');
152 }
153 }
154 elsif ($indicator eq $LIT_CHAR) {
155 $self->{level}++;
156 $node = $self->_parse_block($chomp);
157 $node = $self->_parse_implicit($node) if $implicit;
158 $self->{level}--;
159 }
160 elsif ($indicator eq $FOLD_CHAR) {
161 $self->{level}++;
162 $node = $self->_parse_unfold($chomp);
163 $node = $self->_parse_implicit($node) if $implicit;
164 $self->{level}--;
165 }
166 else {
167 $self->{level}++;
168 $self->offset->[$self->level] ||= 0;
169 if ($self->indent == $self->offset->[$self->level]) {
170 if ($self->content =~ /^-( |$)/) {
171 $node = $self->_parse_seq($anchor);
172 }
173 elsif ($self->content =~ /(^\?|\:( |$))/) {
174 $node = $self->_parse_mapping($anchor);
175 }
176 elsif ($preface =~ /^\s*$/) {
177 $node = $self->_parse_implicit('');
178 }
179 else {
180 $self->die('YAML_PARSE_ERR_BAD_NODE');
181 }
182 }
183 else {
184 $node = undef;
185 }
186 $self->{level}--;
187 }
188 $#{$self->offset} = $self->level;
189
190 if ($explicit) {
191 if ($class) {
192 if (not ref $node) {
193 my $copy = $node;
194 undef $node;
195 $node = \$copy;
196 }
197 CORE::bless $node, $class;
198 }
199 else {
200 $node = $self->_parse_explicit($node, $explicit);
201 }
202 }
203 if ($anchor) {
204 if (ref($self->anchor2node->{$anchor}) eq 'YAML-anchor2node') {
205 # XXX Can't remember what this code actually does
206 for my $ref (@{$self->anchor2node->{$anchor}}) {
207 ${$ref->[0]} = $node;
208 $self->warn('YAML_LOAD_WARN_UNRESOLVED_ALIAS',
209 $anchor, $ref->[1]);
210 }
211 }
212 $self->anchor2node->{$anchor} = $node;
213 }
214 return $node;
215}
216
217# Preprocess the qualifiers that may be attached to any node.
218sub _parse_qualifiers {
219 my $self = shift;
220 my ($preface) = @_;
221 my ($anchor, $alias, $explicit, $implicit, $token) = ('') x 5;
222 $self->inline('');
223 while ($preface =~ /^[&*!]/) {
224 my $line = $self->line - 1;
225 if ($preface =~ s/^\!(\S+)\s*//) {
226 $self->die('YAML_PARSE_ERR_MANY_EXPLICIT') if $explicit;
227 $explicit = $1;
228 }
229 elsif ($preface =~ s/^\!\s*//) {
230 $self->die('YAML_PARSE_ERR_MANY_IMPLICIT') if $implicit;
231 $implicit = 1;
232 }
233 elsif ($preface =~ s/^\&([^ ,:]+)\s*//) {
234 $token = $1;
235 $self->die('YAML_PARSE_ERR_BAD_ANCHOR')
236 unless $token =~ /^[a-zA-Z0-9]+$/;
237 $self->die('YAML_PARSE_ERR_MANY_ANCHOR') if $anchor;
238 $self->die('YAML_PARSE_ERR_ANCHOR_ALIAS') if $alias;
239 $anchor = $token;
240 }
241 elsif ($preface =~ s/^\*([^ ,:]+)\s*//) {
242 $token = $1;
243 $self->die('YAML_PARSE_ERR_BAD_ALIAS')
244 unless $token =~ /^[a-zA-Z0-9]+$/;
245 $self->die('YAML_PARSE_ERR_MANY_ALIAS') if $alias;
246 $self->die('YAML_PARSE_ERR_ANCHOR_ALIAS') if $anchor;
247 $alias = $token;
248 }
249 }
250 return ($anchor, $alias, $explicit, $implicit, $preface);
251}
252
253# Morph a node to it's explicit type
254sub _parse_explicit {
255 my $self = shift;
256 my ($node, $explicit) = @_;
257 my ($type, $class);
258 if ($explicit =~ /^\!?perl\/(hash|array|ref|scalar)(?:\:(\w(\w|\:\:)*)?)?$/) {
259 ($type, $class) = (($1 || ''), ($2 || ''));
260
261 # FIXME # die unless uc($type) eq ref($node) ?
262
263 if ( $type eq "ref" ) {
264 $self->die('YAML_LOAD_ERR_NO_DEFAULT_VALUE', 'XXX', $explicit)
265 unless exists $node->{VALUE()} and scalar(keys %$node) == 1;
266
267 my $value = $node->{VALUE()};
268 $node = \$value;
269 }
270
271 if ( $type eq "scalar" and length($class) and !ref($node) ) {
272 my $value = $node;
273 $node = \$value;
274 }
275
276 if ( length($class) ) {
277 CORE::bless($node, $class);
278 }
279
280 return $node;
281 }
282 if ($explicit =~ m{^!?perl/(glob|regexp|code)(?:\:(\w(\w|\:\:)*)?)?$}) {
283 ($type, $class) = (($1 || ''), ($2 || ''));
284 my $type_class = "YAML::Type::$type";
28534.53ms296µs
# spent 58µs (21+38) within YAML::Loader::BEGIN@285 which was called: # once (21µs+38µs) by YAML::init_action_object at line 285
no strict 'refs';
# spent 58µs making 1 call to YAML::Loader::BEGIN@285 # spent 38µs making 1 call to strict::unimport
286 if ($type_class->can('yaml_load')) {
287 return $type_class->yaml_load($node, $class, $self);
288 }
289 else {
290 $self->die('YAML_LOAD_ERR_NO_CONVERT', 'XXX', $explicit);
291 }
292 }
293 # This !perl/@Foo and !perl/$Foo are deprecated but still parsed
294 elsif ($YAML::TagClass->{$explicit} ||
295 $explicit =~ m{^perl/(\@|\$)?([a-zA-Z](\w|::)+)$}
296 ) {
297 $class = $YAML::TagClass->{$explicit} || $2;
298 if ($class->can('yaml_load')) {
299 require YAML::Node;
300 return $class->yaml_load(YAML::Node->new($node, $explicit));
301 }
302 else {
303 if (ref $node) {
304 return CORE::bless $node, $class;
305 }
306 else {
307 return CORE::bless \$node, $class;
308 }
309 }
310 }
311 elsif (ref $node) {
312 require YAML::Node;
313 return YAML::Node->new($node, $explicit);
314 }
315 else {
316 # XXX This is likely wrong. Failing test:
317 # --- !unknown 'scalar value'
318 return $node;
319 }
320}
321
322# Parse a YAML mapping into a Perl hash
323sub _parse_mapping {
324 my $self = shift;
325 my ($anchor) = @_;
326 my $mapping = {};
327 $self->anchor2node->{$anchor} = $mapping;
328 my $key;
329 while (not $self->done and $self->indent == $self->offset->[$self->level]) {
330 # If structured key:
331 if ($self->{content} =~ s/^\?\s*//) {
332 $self->preface($self->content);
333 $self->_parse_next_line(COLLECTION);
334 $key = $self->_parse_node();
335 $key = "$key";
336 }
337 # If "default" key (equals sign)
338 elsif ($self->{content} =~ s/^\=\s*//) {
339 $key = VALUE;
340 }
341 # If "comment" key (slash slash)
342 elsif ($self->{content} =~ s/^\=\s*//) {
343 $key = COMMENT;
344 }
345 # Regular scalar key:
346 else {
347 $self->inline($self->content);
348 $key = $self->_parse_inline();
349 $key = "$key";
350 $self->content($self->inline);
351 $self->inline('');
352 }
353
354 unless ($self->{content} =~ s/^:\s*//) {
355 $self->die('YAML_LOAD_ERR_BAD_MAP_ELEMENT');
356 }
357 $self->preface($self->content);
358 my $line = $self->line;
359 $self->_parse_next_line(COLLECTION);
360 my $value = $self->_parse_node();
361 if (exists $mapping->{$key}) {
362 $self->warn('YAML_LOAD_WARN_DUPLICATE_KEY');
363 }
364 else {
365 $mapping->{$key} = $value;
366 }
367 }
368 return $mapping;
369}
370
371# Parse a YAML sequence into a Perl array
372sub _parse_seq {
373 my $self = shift;
374 my ($anchor) = @_;
375 my $seq = [];
376 $self->anchor2node->{$anchor} = $seq;
377 while (not $self->done and $self->indent == $self->offset->[$self->level]) {
378 if ($self->content =~ /^-(?: (.*))?$/) {
379 $self->preface(defined($1) ? $1 : '');
380 }
381 else {
382 $self->die('YAML_LOAD_ERR_BAD_SEQ_ELEMENT');
383 }
384 if ($self->preface =~ /^(\s*)(\w.*\:(?: |$).*)$/) {
385 $self->indent($self->offset->[$self->level] + 2 + length($1));
386 $self->content($2);
387 $self->level($self->level + 1);
388 $self->offset->[$self->level] = $self->indent;
389 $self->preface('');
390 push @$seq, $self->_parse_mapping('');
391 $self->{level}--;
392 $#{$self->offset} = $self->level;
393 }
394 else {
395 $self->_parse_next_line(COLLECTION);
396 push @$seq, $self->_parse_node();
397 }
398 }
399 return $seq;
400}
401
402# Parse an inline value. Since YAML supports inline collections, this is
403# the top level of a sub parsing.
404sub _parse_inline {
405 my $self = shift;
406 my ($top, $top_implicit, $top_explicit) = (@_, '', '', '');
407 $self->{inline} =~ s/^\s*(.*)\s*$/$1/; # OUCH - mugwump
408 my ($node, $anchor, $alias, $explicit, $implicit) = ('') x 5;
409 ($anchor, $alias, $explicit, $implicit, $self->{inline}) =
410 $self->_parse_qualifiers($self->inline);
411 if ($anchor) {
412 $self->anchor2node->{$anchor} = CORE::bless [], 'YAML-anchor2node';
413 }
414 $implicit ||= $top_implicit;
415 $explicit ||= $top_explicit;
416 ($top_implicit, $top_explicit) = ('', '');
417 if ($alias) {
418 $self->die('YAML_PARSE_ERR_NO_ANCHOR', $alias)
419 unless defined $self->anchor2node->{$alias};
420 if (ref($self->anchor2node->{$alias}) ne 'YAML-anchor2node') {
421 $node = $self->anchor2node->{$alias};
422 }
423 else {
424 $node = do {my $sv = "*$alias"};
425 push @{$self->anchor2node->{$alias}}, [\$node, $self->line];
426 }
427 }
428 elsif ($self->inline =~ /^\{/) {
429 $node = $self->_parse_inline_mapping($anchor);
430 }
431 elsif ($self->inline =~ /^\[/) {
432 $node = $self->_parse_inline_seq($anchor);
433 }
434 elsif ($self->inline =~ /^"/) {
435 $node = $self->_parse_inline_double_quoted();
436 $node = $self->_unescape($node);
437 $node = $self->_parse_implicit($node) if $implicit;
438 }
439 elsif ($self->inline =~ /^'/) {
440 $node = $self->_parse_inline_single_quoted();
441 $node = $self->_parse_implicit($node) if $implicit;
442 }
443 else {
444 if ($top) {
445 $node = $self->inline;
446 $self->inline('');
447 }
448 else {
449 $node = $self->_parse_inline_simple();
450 }
451 $node = $self->_parse_implicit($node) unless $explicit;
452 }
453 if ($explicit) {
454 $node = $self->_parse_explicit($node, $explicit);
455 }
456 if ($anchor) {
457 if (ref($self->anchor2node->{$anchor}) eq 'YAML-anchor2node') {
458 for my $ref (@{$self->anchor2node->{$anchor}}) {
459 ${$ref->[0]} = $node;
460 $self->warn('YAML_LOAD_WARN_UNRESOLVED_ALIAS',
461 $anchor, $ref->[1]);
462 }
463 }
464 $self->anchor2node->{$anchor} = $node;
465 }
466 return $node;
467}
468
469# Parse the inline YAML mapping into a Perl hash
470sub _parse_inline_mapping {
471 my $self = shift;
472 my ($anchor) = @_;
473 my $node = {};
474 $self->anchor2node->{$anchor} = $node;
475
476 $self->die('YAML_PARSE_ERR_INLINE_MAP')
477 unless $self->{inline} =~ s/^\{\s*//;
478 while (not $self->{inline} =~ s/^\s*\}//) {
479 my $key = $self->_parse_inline();
480 $self->die('YAML_PARSE_ERR_INLINE_MAP')
481 unless $self->{inline} =~ s/^\: \s*//;
482 my $value = $self->_parse_inline();
483 if (exists $node->{$key}) {
484 $self->warn('YAML_LOAD_WARN_DUPLICATE_KEY');
485 }
486 else {
487 $node->{$key} = $value;
488 }
489 next if $self->inline =~ /^\s*\}/;
490 $self->die('YAML_PARSE_ERR_INLINE_MAP')
491 unless $self->{inline} =~ s/^\,\s*//;
492 }
493 return $node;
494}
495
496# Parse the inline YAML sequence into a Perl array
497sub _parse_inline_seq {
498 my $self = shift;
499 my ($anchor) = @_;
500 my $node = [];
501 $self->anchor2node->{$anchor} = $node;
502
503 $self->die('YAML_PARSE_ERR_INLINE_SEQUENCE')
504 unless $self->{inline} =~ s/^\[\s*//;
505 while (not $self->{inline} =~ s/^\s*\]//) {
506 my $value = $self->_parse_inline();
507 push @$node, $value;
508 next if $self->inline =~ /^\s*\]/;
509 $self->die('YAML_PARSE_ERR_INLINE_SEQUENCE')
510 unless $self->{inline} =~ s/^\,\s*//;
511 }
512 return $node;
513}
514
515# Parse the inline double quoted string.
516sub _parse_inline_double_quoted {
517 my $self = shift;
518 my $node;
519 if ($self->inline =~ /^"((?:\\"|[^"])*)"\s*(.*)$/) {
520 $node = $1;
521 $self->inline($2);
522 $node =~ s/\\"/"/g;
523 }
524 else {
525 $self->die('YAML_PARSE_ERR_BAD_DOUBLE');
526 }
527 return $node;
528}
529
530
531# Parse the inline single quoted string.
532sub _parse_inline_single_quoted {
533 my $self = shift;
534 my $node;
535 if ($self->inline =~ /^'((?:''|[^'])*)'\s*(.*)$/) {
536 $node = $1;
537 $self->inline($2);
538 $node =~ s/''/'/g;
539 }
540 else {
541 $self->die('YAML_PARSE_ERR_BAD_SINGLE');
542 }
543 return $node;
544}
545
546# Parse the inline unquoted string and do implicit typing.
547sub _parse_inline_simple {
548 my $self = shift;
549 my $value;
550 if ($self->inline =~ /^(|[^!@#%^&*].*?)(?=[\[\]\{\},]|, |: |- |:\s*$|$)/) {
551 $value = $1;
552 substr($self->{inline}, 0, length($1)) = '';
553 }
554 else {
555 $self->die('YAML_PARSE_ERR_BAD_INLINE_IMPLICIT', $value);
556 }
557 return $value;
558}
559
560sub _parse_implicit {
561 my $self = shift;
562 my ($value) = @_;
563 $value =~ s/\s*$//;
564 return $value if $value eq '';
565 return undef if $value =~ /^~$/;
566 return $value
567 unless $value =~ /^[\@\`\^]/ or
568 $value =~ /^[\-\?]\s/;
569 $self->die('YAML_PARSE_ERR_BAD_IMPLICIT', $value);
570}
571
572# Unfold a YAML multiline scalar into a single string.
573sub _parse_unfold {
574 my $self = shift;
575 my ($chomp) = @_;
576 my $node = '';
577 my $space = 0;
578 while (not $self->done and $self->indent == $self->offset->[$self->level]) {
579 $node .= $self->content. "\n";
580 $self->_parse_next_line(LEAF);
581 }
582 $node =~ s/^(\S.*)\n(?=\S)/$1 /gm;
583 $node =~ s/^(\S.*)\n(\n+\S)/$1$2/gm;
584 $node =~ s/\n*\Z// unless $chomp eq '+';
585 $node .= "\n" unless $chomp;
586 return $node;
587}
588
589# Parse a YAML block style scalar. This is like a Perl here-document.
590sub _parse_block {
591 my $self = shift;
592 my ($chomp) = @_;
593 my $node = '';
594 while (not $self->done and $self->indent == $self->offset->[$self->level]) {
595 $node .= $self->content . "\n";
596 $self->_parse_next_line(LEAF);
597 }
598 return $node if '+' eq $chomp;
599 $node =~ s/\n*\Z/\n/;
600 $node =~ s/\n\Z// if $chomp eq '-';
601 return $node;
602}
603
604# Handle Perl style '#' comments. Comments must be at the same indentation
605# level as the collection line following them.
606
# spent 3.30ms (1.69+1.61) within YAML::Loader::_parse_throwaway_comments which was called 32 times, avg 103µs/call: # 32 times (1.69ms+1.61ms) by YAML::Loader::_parse at line 47, avg 103µs/call
sub _parse_throwaway_comments {
60796639µs my $self = shift;
60896491µs while (@{$self->lines} and
# spent 346µs making 64 calls to YAML::Base::__ANON__[(eval 1078)[YAML/Base.pm:73]:7], avg 5µs/call # spent 145µs making 32 calls to YAML::Loader::CORE:match, avg 5µs/call
609 $self->lines->[0] =~ m{^\s*(\#|$)}
610 ) {
6111281.09ms64328µs shift @{$self->lines};
# spent 328µs making 64 calls to YAML::Base::__ANON__[(eval 1078)[YAML/Base.pm:73]:7], avg 5µs/call
612128351µs $self->{line}++;
# spent 290µs making 96 calls to YAML::Base::__ANON__[(eval 1078)[YAML/Base.pm:73]:7], avg 3µs/call # spent 61µs making 32 calls to YAML::Loader::CORE:match, avg 2µs/call
613 }
61464438µs $self->eos($self->{done} = not @{$self->lines});
# spent 332µs making 32 calls to YAML::Base::__ANON__[(eval 1079)[YAML/Base.pm:73]:7], avg 10µs/call # spent 106µs making 32 calls to YAML::Base::__ANON__[(eval 1078)[YAML/Base.pm:73]:7], avg 3µs/call
615}
616
617# This is the routine that controls what line is being parsed. It gets called
618# once for each line in the YAML stream.
619#
620# This routine must:
621# 1) Skip past the current line
622# 2) Determine the indentation offset for a new level
623# 3) Find the next _content_ line
624# A) Skip over any throwaways (Comments/blanks)
625# B) Set $self->indent, $self->content, $self->line
626# 4) Expand tabs appropriately
627sub _parse_next_line {
628 my $self = shift;
629 my ($type) = @_;
630 my $level = $self->level;
631 my $offset = $self->offset->[$level];
632 $self->die('YAML_EMIT_ERR_BAD_LEVEL') unless defined $offset;
633 shift @{$self->lines};
634 $self->eos($self->{done} = not @{$self->lines});
635 return if $self->eos;
636 $self->{line}++;
637
638 # Determine the offset for a new leaf node
639 if ($self->preface =~
640 qr/(?:^|\s)(?:$FOLD_CHAR|$LIT_CHAR_RX)(?:-|\+)?(\d*)\s*$/
641 ) {
642 $self->die('YAML_PARSE_ERR_ZERO_INDENT')
643 if length($1) and $1 == 0;
644 $type = LEAF;
645 if (length($1)) {
646 $self->offset->[$level + 1] = $offset + $1;
647 }
648 else {
649 # First get rid of any comments.
650 while (@{$self->lines} && ($self->lines->[0] =~ /^\s*#/)) {
651 $self->lines->[0] =~ /^( *)/ or die;
652 last unless length($1) <= $offset;
653 shift @{$self->lines};
654 $self->{line}++;
655 }
656 $self->eos($self->{done} = not @{$self->lines});
657 return if $self->eos;
658 if ($self->lines->[0] =~ /^( *)\S/ and length($1) > $offset) {
659 $self->offset->[$level+1] = length($1);
660 }
661 else {
662 $self->offset->[$level+1] = $offset + 1;
663 }
664 }
665 $offset = $self->offset->[++$level];
666 }
667 # Determine the offset for a new collection level
668 elsif ($type == COLLECTION and
669 $self->preface =~ /^(\s*(\!\S*|\&\S+))*\s*$/) {
670 $self->_parse_throwaway_comments();
671 if ($self->eos) {
672 $self->offset->[$level+1] = $offset + 1;
673 return;
674 }
675 else {
676 $self->lines->[0] =~ /^( *)\S/ or die;
677 if (length($1) > $offset) {
678 $self->offset->[$level+1] = length($1);
679 }
680 else {
681 $self->offset->[$level+1] = $offset + 1;
682 }
683 }
684 $offset = $self->offset->[++$level];
685 }
686
687 if ($type == LEAF) {
688 while (@{$self->lines} and
689 $self->lines->[0] =~ m{^( *)(\#)} and
690 length($1) < $offset
691 ) {
692 shift @{$self->lines};
693 $self->{line}++;
694 }
695 $self->eos($self->{done} = not @{$self->lines});
696 }
697 else {
698 $self->_parse_throwaway_comments();
699 }
700 return if $self->eos;
701
702 if ($self->lines->[0] =~ /^---(\s|$)/) {
703 $self->done(1);
704 return;
705 }
706 if ($type == LEAF and
707 $self->lines->[0] =~ /^ {$offset}(.*)$/
708 ) {
709 $self->indent($offset);
710 $self->content($1);
711 }
712 elsif ($self->lines->[0] =~ /^\s*$/) {
713 $self->indent($offset);
714 $self->content('');
715 }
716 else {
717 $self->lines->[0] =~ /^( *)(\S.*)$/;
718 while ($self->offset->[$level] > length($1)) {
719 $level--;
720 }
721 $self->die('YAML_PARSE_ERR_INCONSISTENT_INDENTATION')
722 if $self->offset->[$level] != length($1);
723 $self->indent(length($1));
724 $self->content($2);
725 }
726 $self->die('YAML_PARSE_ERR_INDENTATION')
727 if $self->indent - $offset > 1;
728}
729
730#==============================================================================
731# Utility subroutines.
732#==============================================================================
733
734# Printable characters for escapes
735111µsmy %unescapes = (
736 0 => "\x00",
737 a => "\x07",
738 t => "\x09",
739 n => "\x0a",
740 'v' => "\x0b", # Potential v-string error on 5.6.2 if not quoted
741 f => "\x0c",
742 r => "\x0d",
743 e => "\x1b",
744 '\\' => '\\',
745 );
746
747# Transform all the backslash style escape characters to their literal meaning
748sub _unescape {
749 my $self = shift;
750 my ($node) = @_;
751 $node =~ s/\\([never\\fart0]|x([0-9a-fA-F]{2}))/
752 (length($1)>1)?pack("H2",$2):$unescapes{$1}/gex;
753 return $node;
754}
755
756114µs1;
757
758__END__
 
# spent 319µs within YAML::Loader::CORE:match which was called 96 times, avg 3µs/call: # 32 times (145µs+0s) by YAML::Loader::_parse_throwaway_comments at line 608, avg 5µs/call # 32 times (112µs+0s) by YAML::Loader::_parse at line 38, avg 4µs/call # 32 times (61µs+0s) by YAML::Loader::_parse_throwaway_comments at line 612, avg 2µs/call
sub YAML::Loader::CORE:match; # opcode
# spent 76µs within YAML::Loader::CORE:regcomp which was called 32 times, avg 2µs/call: # 32 times (76µs+0s) by YAML::Loader::_parse at line 38, avg 2µs/call
sub YAML::Loader::CORE:regcomp; # opcode
# spent 414µs within YAML::Loader::CORE:subst which was called 96 times, avg 4µs/call: # 32 times (282µs+0s) by YAML::Loader::_parse at line 40, avg 9µs/call # 32 times (104µs+0s) by YAML::Loader::_parse at line 35, avg 3µs/call # 32 times (29µs+0s) by YAML::Loader::_parse at line 36, avg 891ns/call
sub YAML::Loader::CORE:subst; # opcode
# spent 203µs within YAML::Loader::CORE:substcont which was called 64 times, avg 3µs/call: # 64 times (203µs+0s) by YAML::Loader::_parse at line 40, avg 3µs/call
sub YAML::Loader::CORE:substcont; # opcode
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.