File | /usr/share/perl5/YAML/Node.pm |
Statements Executed | 21 |
Total Time | 0.0015566 seconds |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
0 | 0 | 0 | 0s | 0s | BEGIN | YAML::Node::
0 | 0 | 0 | 0s | 0s | keys | YAML::Node::
0 | 0 | 0 | 0s | 0s | kind | YAML::Node::
0 | 0 | 0 | 0s | 0s | new | YAML::Node::
0 | 0 | 0 | 0s | 0s | node | YAML::Node::
0 | 0 | 0 | 0s | 0s | tag | YAML::Node::
0 | 0 | 0 | 0s | 0s | ynode | YAML::Node::
0 | 0 | 0 | 0s | 0s | CLEAR | yaml_mapping::
0 | 0 | 0 | 0s | 0s | DELETE | yaml_mapping::
0 | 0 | 0 | 0s | 0s | EXISTS | yaml_mapping::
0 | 0 | 0 | 0s | 0s | FETCH | yaml_mapping::
0 | 0 | 0 | 0s | 0s | FIRSTKEY | yaml_mapping::
0 | 0 | 0 | 0s | 0s | NEXTKEY | yaml_mapping::
0 | 0 | 0 | 0s | 0s | STORE | yaml_mapping::
0 | 0 | 0 | 0s | 0s | TIEHASH | yaml_mapping::
0 | 0 | 0 | 0s | 0s | new | yaml_mapping::
0 | 0 | 0 | 0s | 0s | FETCH | yaml_scalar::
0 | 0 | 0 | 0s | 0s | STORE | yaml_scalar::
0 | 0 | 0 | 0s | 0s | TIESCALAR | yaml_scalar::
0 | 0 | 0 | 0s | 0s | new | yaml_scalar::
0 | 0 | 0 | 0s | 0s | FETCH | yaml_sequence::
0 | 0 | 0 | 0s | 0s | FETCHSIZE | yaml_sequence::
0 | 0 | 0 | 0s | 0s | STORE | yaml_sequence::
0 | 0 | 0 | 0s | 0s | TIEARRAY | yaml_sequence::
0 | 0 | 0 | 0s | 0s | new | yaml_sequence::
0 | 0 | 0 | 0s | 0s | undone | yaml_sequence::
Line | Stmts. | Exclusive Time | Avg. | Code |
---|---|---|---|---|
1 | package YAML::Node; | |||
2 | 6 | 48µs | 8µs | use strict; use warnings; # spent 21µs making 1 call to warnings::import
# spent 7µs making 1 call to strict::import |
3 | 6 | 49µs | 8µs | use YAML::Base; use base 'YAML::Base'; # spent 72µs making 1 call to base::import
# spent 42µs making 1 call to Exporter::import |
4 | 3 | 1.42ms | 472µs | use YAML::Tag; # spent 12µs making 1 call to import |
5 | ||||
6 | 1 | 2µs | 2µs | our @EXPORT = qw(ynode); |
7 | ||||
8 | sub 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 | ||||
22 | sub 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 | ||||
40 | sub node { $_->{NODE} } | |||
41 | sub kind { $_->{KIND} } | |||
42 | sub 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 | } | |||
52 | sub 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 | #============================================================================== | |||
64 | package yaml_scalar; | |||
65 | 1 | 9µs | 9µs | @yaml_scalar::ISA = qw(YAML::Node); |
66 | ||||
67 | sub new { | |||
68 | my ($class, $self) = @_; | |||
69 | tie $_[2], $class, $self; | |||
70 | } | |||
71 | ||||
72 | sub TIESCALAR { | |||
73 | my ($class, $self) = @_; | |||
74 | bless $self, $class; | |||
75 | $self | |||
76 | } | |||
77 | ||||
78 | sub FETCH { | |||
79 | my ($self) = @_; | |||
80 | $self->{NODE} | |||
81 | } | |||
82 | ||||
83 | sub STORE { | |||
84 | my ($self, $value) = @_; | |||
85 | $self->{NODE} = $value | |||
86 | } | |||
87 | ||||
88 | #============================================================================== | |||
89 | package yaml_sequence; | |||
90 | 1 | 5µs | 5µs | @yaml_sequence::ISA = qw(YAML::Node); |
91 | ||||
92 | sub new { | |||
93 | my ($class, $self) = @_; | |||
94 | my $new; | |||
95 | tie @$new, $class, $self; | |||
96 | $new | |||
97 | } | |||
98 | ||||
99 | sub TIEARRAY { | |||
100 | my ($class, $self) = @_; | |||
101 | bless $self, $class | |||
102 | } | |||
103 | ||||
104 | sub FETCHSIZE { | |||
105 | my ($self) = @_; | |||
106 | scalar @{$self->{NODE}}; | |||
107 | } | |||
108 | ||||
109 | sub FETCH { | |||
110 | my ($self, $index) = @_; | |||
111 | $self->{NODE}[$index] | |||
112 | } | |||
113 | ||||
114 | sub STORE { | |||
115 | my ($self, $index, $value) = @_; | |||
116 | $self->{NODE}[$index] = $value | |||
117 | } | |||
118 | ||||
119 | sub undone { | |||
120 | die "Not implemented yet"; # XXX | |||
121 | } | |||
122 | ||||
123 | 1 | 5µs | 5µ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 | #============================================================================== | |||
128 | package yaml_mapping; | |||
129 | 1 | 10µs | 10µs | @yaml_mapping::ISA = qw(YAML::Node); |
130 | ||||
131 | sub new { | |||
132 | my ($class, $self) = @_; | |||
133 | @{$self->{KEYS}} = sort keys %{$self->{NODE}}; | |||
134 | my $new; | |||
135 | tie %$new, $class, $self; | |||
136 | $new | |||
137 | } | |||
138 | ||||
139 | sub TIEHASH { | |||
140 | my ($class, $self) = @_; | |||
141 | bless $self, $class | |||
142 | } | |||
143 | ||||
144 | sub 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 | ||||
153 | sub 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 | ||||
170 | sub 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 | ||||
187 | sub CLEAR { | |||
188 | my ($self) = @_; | |||
189 | @{$self->{KEYS}} = (); | |||
190 | %{$self->{HASH}} = (); | |||
191 | } | |||
192 | ||||
193 | sub FIRSTKEY { | |||
194 | my ($self) = @_; | |||
195 | $self->{ITER} = 0; | |||
196 | $self->{KEYS}[0] | |||
197 | } | |||
198 | ||||
199 | sub NEXTKEY { | |||
200 | my ($self) = @_; | |||
201 | $self->{KEYS}[++$self->{ITER}] | |||
202 | } | |||
203 | ||||
204 | sub EXISTS { | |||
205 | my ($self, $key) = @_; | |||
206 | exists $self->{NODE}{$key} | |||
207 | } | |||
208 | ||||
209 | 1 | 12µs | 12µs | 1; |
210 | ||||
211 | __END__ | |||
212 | ||||
213 | =head1 NAME | |||
214 | ||||
215 | YAML::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 | ||||
226 | yields: | |||
227 | ||||
228 | --- !ingerson.com/fruit | |||
229 | orange: orange | |||
230 | apple: red | |||
231 | grape: green | |||
232 | ||||
233 | =head1 DESCRIPTION | |||
234 | ||||
235 | A generic node in YAML is similar to a plain hash, array, or scalar node | |||
236 | in Perl except that it must also keep track of its type. The type is a | |||
237 | URI called the YAML type tag. | |||
238 | ||||
239 | YAML::Node is a class for generating and manipulating these containers. | |||
240 | A YAML node (or ynode) is a tied hash, array or scalar. In most ways it | |||
241 | behaves just like the plain thing. But you can assign and retrieve and | |||
242 | YAML type tag URI to it. For the hash flavor, you can also assign the | |||
243 | order that the keys will be retrieved in. By default a ynode will offer | |||
244 | its keys in the same order that they were assigned. | |||
245 | ||||
246 | YAML::Node has a class method call new() that will return a ynode. You | |||
247 | pass it a regular node and an optional type tag. After that you can | |||
248 | use it like a normal Perl node, but when you YAML::Dump it, the magical | |||
249 | properties will be honored. | |||
250 | ||||
251 | This is how you can control the sort order of hash keys during a YAML | |||
252 | serialization. By default, YAML sorts keys alphabetically. But notice | |||
253 | in the above example that the keys were Dumped in the same order they | |||
254 | were assigned. | |||
255 | ||||
256 | YAML::Node exports a function called ynode(). This function returns the tied object so that you can call special methods on it like ->keys(). | |||
257 | ||||
258 | keys() 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 | ||||
268 | produces: | |||
269 | ||||
270 | --- | |||
271 | grape: green | |||
272 | apple: red | |||
273 | ||||
274 | It tells the ynode which keys and what order to use. | |||
275 | ||||
276 | ynodes will play a very important role in how programs use YAML. They | |||
277 | are the foundation of how a Perl class can marshall the Loading and | |||
278 | Dumping of its objects. | |||
279 | ||||
280 | The upcoming versions of YAML.pm will have much more information on this. | |||
281 | ||||
282 | =head1 AUTHOR | |||
283 | ||||
284 | Ingy döt Net <ingy@cpan.org> | |||
285 | ||||
286 | =head1 COPYRIGHT | |||
287 | ||||
288 | Copyright (c) 2006. Ingy döt Net. All rights reserved. | |||
289 | ||||
290 | Copyright (c) 2002. Brian Ingerson. All rights reserved. | |||
291 | ||||
292 | This program is free software; you can redistribute it and/or modify it | |||
293 | under the same terms as Perl itself. | |||
294 | ||||
295 | See L<http://www.perl.com/perl/misc/Artistic.html> | |||
296 | ||||
297 | =cut |