← Index
Performance Profile   « block view • line view • sub view »
For t/test-parsing
  Run on Sun Nov 14 09:49:57 2010
Reported on Sun Nov 14 09:50:08 2010

File /usr/share/perl5/YAML/Node.pm
Statements Executed 21
Total Time 0.0015566 seconds
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sYAML::Node::::BEGIN YAML::Node::BEGIN
0000s0sYAML::Node::::keys YAML::Node::keys
0000s0sYAML::Node::::kind YAML::Node::kind
0000s0sYAML::Node::::new YAML::Node::new
0000s0sYAML::Node::::node YAML::Node::node
0000s0sYAML::Node::::tag YAML::Node::tag
0000s0sYAML::Node::::ynode YAML::Node::ynode
0000s0syaml_mapping::::CLEAR yaml_mapping::CLEAR
0000s0syaml_mapping::::DELETE yaml_mapping::DELETE
0000s0syaml_mapping::::EXISTS yaml_mapping::EXISTS
0000s0syaml_mapping::::FETCH yaml_mapping::FETCH
0000s0syaml_mapping::::FIRSTKEY yaml_mapping::FIRSTKEY
0000s0syaml_mapping::::NEXTKEY yaml_mapping::NEXTKEY
0000s0syaml_mapping::::STORE yaml_mapping::STORE
0000s0syaml_mapping::::TIEHASH yaml_mapping::TIEHASH
0000s0syaml_mapping::::new yaml_mapping::new
0000s0syaml_scalar::::FETCH yaml_scalar::FETCH
0000s0syaml_scalar::::STORE yaml_scalar::STORE
0000s0syaml_scalar::::TIESCALAR yaml_scalar::TIESCALAR
0000s0syaml_scalar::::new yaml_scalar::new
0000s0syaml_sequence::::FETCHyaml_sequence::FETCH
0000s0syaml_sequence::::FETCHSIZEyaml_sequence::FETCHSIZE
0000s0syaml_sequence::::STOREyaml_sequence::STORE
0000s0syaml_sequence::::TIEARRAYyaml_sequence::TIEARRAY
0000s0syaml_sequence::::newyaml_sequence::new
0000s0syaml_sequence::::undoneyaml_sequence::undone
LineStmts.Exclusive
Time
Avg.Code
1package YAML::Node;
2648µs8µsuse strict; use warnings;
# spent 21µs making 1 call to warnings::import # spent 7µs making 1 call to strict::import
3649µs8µsuse YAML::Base; use base 'YAML::Base';
# spent 72µs making 1 call to base::import # spent 42µs making 1 call to Exporter::import
431.42ms472µsuse YAML::Tag;
# spent 12µs making 1 call to import
5
612µs2µsour @EXPORT = qw(ynode);
7
8sub ynode {
9 my $self;
10 if (ref($_[0]) eq 'HASH') {
11 $self = tied(%{$_[0]});
12 }
13 elsif (ref($_[0]) eq 'ARRAY') {
14 $self = tied(@{$_[0]});
15 }
16 else {
17 $self = tied($_[0]);
18 }
19 return (ref($self) =~ /^yaml_/) ? $self : undef;
20}
21
22sub new {
23 my ($class, $node, $tag) = @_;
24 my $self;
25 $self->{NODE} = $node;
26 my (undef, $type) = $class->node_info($node);
27 $self->{KIND} = (not defined $type) ? 'scalar' :
28 ($type eq 'ARRAY') ? 'sequence' :
29 ($type eq 'HASH') ? 'mapping' :
30 $class->die("Can't create YAML::Node from '$type'");
31 tag($self, ($tag || ''));
32 if ($self->{KIND} eq 'scalar') {
33 yaml_scalar->new($self, $_[1]);
34 return \ $_[1];
35 }
36 my $package = "yaml_" . $self->{KIND};
37 $package->new($self)
38}
39
40sub node { $_->{NODE} }
41sub kind { $_->{KIND} }
42sub tag {
43 my ($self, $value) = @_;
44 if (defined $value) {
45 $self->{TAG} = YAML::Tag->new($value);
46 return $self;
47 }
48 else {
49 return $self->{TAG};
50 }
51}
52sub keys {
53 my ($self, $value) = @_;
54 if (defined $value) {
55 $self->{KEYS} = $value;
56 return $self;
57 }
58 else {
59 return $self->{KEYS};
60 }
61}
62
63#==============================================================================
64package yaml_scalar;
6519µs9µs@yaml_scalar::ISA = qw(YAML::Node);
66
67sub new {
68 my ($class, $self) = @_;
69 tie $_[2], $class, $self;
70}
71
72sub TIESCALAR {
73 my ($class, $self) = @_;
74 bless $self, $class;
75 $self
76}
77
78sub FETCH {
79 my ($self) = @_;
80 $self->{NODE}
81}
82
83sub STORE {
84 my ($self, $value) = @_;
85 $self->{NODE} = $value
86}
87
88#==============================================================================
89package yaml_sequence;
9015µs5µs@yaml_sequence::ISA = qw(YAML::Node);
91
92sub new {
93 my ($class, $self) = @_;
94 my $new;
95 tie @$new, $class, $self;
96 $new
97}
98
99sub TIEARRAY {
100 my ($class, $self) = @_;
101 bless $self, $class
102}
103
104sub FETCHSIZE {
105 my ($self) = @_;
106 scalar @{$self->{NODE}};
107}
108
109sub FETCH {
110 my ($self, $index) = @_;
111 $self->{NODE}[$index]
112}
113
114sub STORE {
115 my ($self, $index, $value) = @_;
116 $self->{NODE}[$index] = $value
117}
118
119sub undone {
120 die "Not implemented yet"; # XXX
121}
122
12315µs5µs*STORESIZE = *POP = *PUSH = *SHIFT = *UNSHIFT = *SPLICE = *DELETE = *EXISTS =
124*STORESIZE = *POP = *PUSH = *SHIFT = *UNSHIFT = *SPLICE = *DELETE = *EXISTS =
125*undone; # XXX Must implement before release
126
127#==============================================================================
128package yaml_mapping;
129110µs10µs@yaml_mapping::ISA = qw(YAML::Node);
130
131sub new {
132 my ($class, $self) = @_;
133 @{$self->{KEYS}} = sort keys %{$self->{NODE}};
134 my $new;
135 tie %$new, $class, $self;
136 $new
137}
138
139sub TIEHASH {
140 my ($class, $self) = @_;
141 bless $self, $class
142}
143
144sub FETCH {
145 my ($self, $key) = @_;
146 if (exists $self->{NODE}{$key}) {
147 return (grep {$_ eq $key} @{$self->{KEYS}})
148 ? $self->{NODE}{$key} : undef;
149 }
150 return $self->{HASH}{$key};
151}
152
153sub STORE {
154 my ($self, $key, $value) = @_;
155 if (exists $self->{NODE}{$key}) {
156 $self->{NODE}{$key} = $value;
157 }
158 elsif (exists $self->{HASH}{$key}) {
159 $self->{HASH}{$key} = $value;
160 }
161 else {
162 if (not grep {$_ eq $key} @{$self->{KEYS}}) {
163 push(@{$self->{KEYS}}, $key);
164 }
165 $self->{HASH}{$key} = $value;
166 }
167 $value
168}
169
170sub DELETE {
171 my ($self, $key) = @_;
172 my $return;
173 if (exists $self->{NODE}{$key}) {
174 $return = $self->{NODE}{$key};
175 }
176 elsif (exists $self->{HASH}{$key}) {
177 $return = delete $self->{NODE}{$key};
178 }
179 for (my $i = 0; $i < @{$self->{KEYS}}; $i++) {
180 if ($self->{KEYS}[$i] eq $key) {
181 splice(@{$self->{KEYS}}, $i, 1);
182 }
183 }
184 return $return;
185}
186
187sub CLEAR {
188 my ($self) = @_;
189 @{$self->{KEYS}} = ();
190 %{$self->{HASH}} = ();
191}
192
193sub FIRSTKEY {
194 my ($self) = @_;
195 $self->{ITER} = 0;
196 $self->{KEYS}[0]
197}
198
199sub NEXTKEY {
200 my ($self) = @_;
201 $self->{KEYS}[++$self->{ITER}]
202}
203
204sub EXISTS {
205 my ($self, $key) = @_;
206 exists $self->{NODE}{$key}
207}
208
209112µs12µs1;
210
211__END__
212
213=head1 NAME
214
215YAML::Node - A generic data node that encapsulates YAML information
216
217=head1 SYNOPSIS
218
219 use YAML;
220 use YAML::Node;
221
222 my $ynode = YAML::Node->new({}, 'ingerson.com/fruit');
223 %$ynode = qw(orange orange apple red grape green);
224 print Dump $ynode;
225
226yields:
227
228 --- !ingerson.com/fruit
229 orange: orange
230 apple: red
231 grape: green
232
233=head1 DESCRIPTION
234
235A generic node in YAML is similar to a plain hash, array, or scalar node
236in Perl except that it must also keep track of its type. The type is a
237URI called the YAML type tag.
238
239YAML::Node is a class for generating and manipulating these containers.
240A YAML node (or ynode) is a tied hash, array or scalar. In most ways it
241behaves just like the plain thing. But you can assign and retrieve and
242YAML type tag URI to it. For the hash flavor, you can also assign the
243order that the keys will be retrieved in. By default a ynode will offer
244its keys in the same order that they were assigned.
245
246YAML::Node has a class method call new() that will return a ynode. You
247pass it a regular node and an optional type tag. After that you can
248use it like a normal Perl node, but when you YAML::Dump it, the magical
249properties will be honored.
250
251This is how you can control the sort order of hash keys during a YAML
252serialization. By default, YAML sorts keys alphabetically. But notice
253in the above example that the keys were Dumped in the same order they
254were assigned.
255
256YAML::Node exports a function called ynode(). This function returns the tied object so that you can call special methods on it like ->keys().
257
258keys() works like this:
259
260 use YAML;
261 use YAML::Node;
262
263 %$node = qw(orange orange apple red grape green);
264 $ynode = YAML::Node->new($node);
265 ynode($ynode)->keys(['grape', 'apple']);
266 print Dump $ynode;
267
268produces:
269
270 ---
271 grape: green
272 apple: red
273
274It tells the ynode which keys and what order to use.
275
276ynodes will play a very important role in how programs use YAML. They
277are the foundation of how a Perl class can marshall the Loading and
278Dumping of its objects.
279
280The upcoming versions of YAML.pm will have much more information on this.
281
282=head1 AUTHOR
283
284Ingy döt Net <ingy@cpan.org>
285
286=head1 COPYRIGHT
287
288Copyright (c) 2006. Ingy döt Net. All rights reserved.
289
290Copyright (c) 2002. Brian Ingerson. All rights reserved.
291
292This program is free software; you can redistribute it and/or modify it
293under the same terms as Perl itself.
294
295See L<http://www.perl.com/perl/misc/Artistic.html>
296
297=cut