| 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 | YAML::Node::BEGIN |
| 0 | 0 | 0 | 0s | 0s | YAML::Node::keys |
| 0 | 0 | 0 | 0s | 0s | YAML::Node::kind |
| 0 | 0 | 0 | 0s | 0s | YAML::Node::new |
| 0 | 0 | 0 | 0s | 0s | YAML::Node::node |
| 0 | 0 | 0 | 0s | 0s | YAML::Node::tag |
| 0 | 0 | 0 | 0s | 0s | YAML::Node::ynode |
| 0 | 0 | 0 | 0s | 0s | yaml_mapping::CLEAR |
| 0 | 0 | 0 | 0s | 0s | yaml_mapping::DELETE |
| 0 | 0 | 0 | 0s | 0s | yaml_mapping::EXISTS |
| 0 | 0 | 0 | 0s | 0s | yaml_mapping::FETCH |
| 0 | 0 | 0 | 0s | 0s | yaml_mapping::FIRSTKEY |
| 0 | 0 | 0 | 0s | 0s | yaml_mapping::NEXTKEY |
| 0 | 0 | 0 | 0s | 0s | yaml_mapping::STORE |
| 0 | 0 | 0 | 0s | 0s | yaml_mapping::TIEHASH |
| 0 | 0 | 0 | 0s | 0s | yaml_mapping::new |
| 0 | 0 | 0 | 0s | 0s | yaml_scalar::FETCH |
| 0 | 0 | 0 | 0s | 0s | yaml_scalar::STORE |
| 0 | 0 | 0 | 0s | 0s | yaml_scalar::TIESCALAR |
| 0 | 0 | 0 | 0s | 0s | yaml_scalar::new |
| 0 | 0 | 0 | 0s | 0s | yaml_sequence::FETCH |
| 0 | 0 | 0 | 0s | 0s | yaml_sequence::FETCHSIZE |
| 0 | 0 | 0 | 0s | 0s | yaml_sequence::STORE |
| 0 | 0 | 0 | 0s | 0s | yaml_sequence::TIEARRAY |
| 0 | 0 | 0 | 0s | 0s | yaml_sequence::new |
| 0 | 0 | 0 | 0s | 0s | yaml_sequence::undone |
| 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 |