| Filename | /usr/share/perl5/YAML/Node.pm |
| Statements | Executed 20 statements in 1.51ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 269µs | 438µs | YAML::Node::BEGIN@7 |
| 1 | 1 | 1 | 19µs | 23µs | YAML::Node::BEGIN@3 |
| 1 | 1 | 1 | 16µs | 31µs | YAML::Node::BEGIN@4 |
| 1 | 1 | 1 | 10µs | 48µs | YAML::Node::BEGIN@6 |
| 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 | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package YAML::Node; | ||||
| 2 | |||||
| 3 | 3 | 28µs | 2 | 28µs | # spent 23µs (19+5) within YAML::Node::BEGIN@3 which was called:
# once (19µs+5µs) by YAML::BEGIN@7 at line 3 # spent 23µs making 1 call to YAML::Node::BEGIN@3
# spent 5µs making 1 call to strict::import |
| 4 | 3 | 28µs | 2 | 45µs | # spent 31µs (16+14) within YAML::Node::BEGIN@4 which was called:
# once (16µs+14µs) by YAML::BEGIN@7 at line 4 # spent 31µs making 1 call to YAML::Node::BEGIN@4
# spent 14µs making 1 call to warnings::import |
| 5 | |||||
| 6 | 3 | 28µs | 2 | 87µs | # spent 48µs (10+39) within YAML::Node::BEGIN@6 which was called:
# once (10µs+39µs) by YAML::BEGIN@7 at line 6 # spent 48µs making 1 call to YAML::Node::BEGIN@6
# spent 39µs making 1 call to Exporter::import |
| 7 | 3 | 1.38ms | 1 | 438µs | # spent 438µs (269+169) within YAML::Node::BEGIN@7 which was called:
# once (269µs+169µs) by YAML::BEGIN@7 at line 7 # spent 438µs making 1 call to YAML::Node::BEGIN@7 |
| 8 | |||||
| 9 | 1 | 800ns | our $VERSION = '0.71'; | ||
| 10 | 1 | 13µs | our @ISA = 'YAML::Base'; | ||
| 11 | 1 | 800ns | our @EXPORT = qw(ynode); | ||
| 12 | |||||
| 13 | sub ynode { | ||||
| 14 | my $self; | ||||
| 15 | if (ref($_[0]) eq 'HASH') { | ||||
| 16 | $self = tied(%{$_[0]}); | ||||
| 17 | } | ||||
| 18 | elsif (ref($_[0]) eq 'ARRAY') { | ||||
| 19 | $self = tied(@{$_[0]}); | ||||
| 20 | } | ||||
| 21 | else { | ||||
| 22 | $self = tied($_[0]); | ||||
| 23 | } | ||||
| 24 | return (ref($self) =~ /^yaml_/) ? $self : undef; | ||||
| 25 | } | ||||
| 26 | |||||
| 27 | sub new { | ||||
| 28 | my ($class, $node, $tag) = @_; | ||||
| 29 | my $self; | ||||
| 30 | $self->{NODE} = $node; | ||||
| 31 | my (undef, $type) = $class->node_info($node); | ||||
| 32 | $self->{KIND} = (not defined $type) ? 'scalar' : | ||||
| 33 | ($type eq 'ARRAY') ? 'sequence' : | ||||
| 34 | ($type eq 'HASH') ? 'mapping' : | ||||
| 35 | $class->die("Can't create YAML::Node from '$type'"); | ||||
| 36 | tag($self, ($tag || '')); | ||||
| 37 | if ($self->{KIND} eq 'scalar') { | ||||
| 38 | yaml_scalar->new($self, $_[1]); | ||||
| 39 | return \ $_[1]; | ||||
| 40 | } | ||||
| 41 | my $package = "yaml_" . $self->{KIND}; | ||||
| 42 | $package->new($self) | ||||
| 43 | } | ||||
| 44 | |||||
| 45 | sub node { $_->{NODE} } | ||||
| 46 | sub kind { $_->{KIND} } | ||||
| 47 | sub tag { | ||||
| 48 | my ($self, $value) = @_; | ||||
| 49 | if (defined $value) { | ||||
| 50 | $self->{TAG} = YAML::Tag->new($value); | ||||
| 51 | return $self; | ||||
| 52 | } | ||||
| 53 | else { | ||||
| 54 | return $self->{TAG}; | ||||
| 55 | } | ||||
| 56 | } | ||||
| 57 | sub keys { | ||||
| 58 | my ($self, $value) = @_; | ||||
| 59 | if (defined $value) { | ||||
| 60 | $self->{KEYS} = $value; | ||||
| 61 | return $self; | ||||
| 62 | } | ||||
| 63 | else { | ||||
| 64 | return $self->{KEYS}; | ||||
| 65 | } | ||||
| 66 | } | ||||
| 67 | |||||
| 68 | #============================================================================== | ||||
| 69 | package yaml_scalar; | ||||
| 70 | |||||
| 71 | 1 | 6µs | @yaml_scalar::ISA = qw(YAML::Node); | ||
| 72 | |||||
| 73 | sub new { | ||||
| 74 | my ($class, $self) = @_; | ||||
| 75 | tie $_[2], $class, $self; | ||||
| 76 | } | ||||
| 77 | |||||
| 78 | sub TIESCALAR { | ||||
| 79 | my ($class, $self) = @_; | ||||
| 80 | bless $self, $class; | ||||
| 81 | $self | ||||
| 82 | } | ||||
| 83 | |||||
| 84 | sub FETCH { | ||||
| 85 | my ($self) = @_; | ||||
| 86 | $self->{NODE} | ||||
| 87 | } | ||||
| 88 | |||||
| 89 | sub STORE { | ||||
| 90 | my ($self, $value) = @_; | ||||
| 91 | $self->{NODE} = $value | ||||
| 92 | } | ||||
| 93 | |||||
| 94 | #============================================================================== | ||||
| 95 | package yaml_sequence; | ||||
| 96 | |||||
| 97 | 1 | 5µs | @yaml_sequence::ISA = qw(YAML::Node); | ||
| 98 | |||||
| 99 | sub new { | ||||
| 100 | my ($class, $self) = @_; | ||||
| 101 | my $new; | ||||
| 102 | tie @$new, $class, $self; | ||||
| 103 | $new | ||||
| 104 | } | ||||
| 105 | |||||
| 106 | sub TIEARRAY { | ||||
| 107 | my ($class, $self) = @_; | ||||
| 108 | bless $self, $class | ||||
| 109 | } | ||||
| 110 | |||||
| 111 | sub FETCHSIZE { | ||||
| 112 | my ($self) = @_; | ||||
| 113 | scalar @{$self->{NODE}}; | ||||
| 114 | } | ||||
| 115 | |||||
| 116 | sub FETCH { | ||||
| 117 | my ($self, $index) = @_; | ||||
| 118 | $self->{NODE}[$index] | ||||
| 119 | } | ||||
| 120 | |||||
| 121 | sub STORE { | ||||
| 122 | my ($self, $index, $value) = @_; | ||||
| 123 | $self->{NODE}[$index] = $value | ||||
| 124 | } | ||||
| 125 | |||||
| 126 | sub undone { | ||||
| 127 | die "Not implemented yet"; # XXX | ||||
| 128 | } | ||||
| 129 | |||||
| 130 | 1 | 4µs | *STORESIZE = *POP = *PUSH = *SHIFT = *UNSHIFT = *SPLICE = *DELETE = *EXISTS = | ||
| 131 | *STORESIZE = *POP = *PUSH = *SHIFT = *UNSHIFT = *SPLICE = *DELETE = *EXISTS = | ||||
| 132 | *undone; # XXX Must implement before release | ||||
| 133 | |||||
| 134 | #============================================================================== | ||||
| 135 | package yaml_mapping; | ||||
| 136 | |||||
| 137 | 1 | 5µs | @yaml_mapping::ISA = qw(YAML::Node); | ||
| 138 | |||||
| 139 | sub new { | ||||
| 140 | my ($class, $self) = @_; | ||||
| 141 | @{$self->{KEYS}} = sort keys %{$self->{NODE}}; | ||||
| 142 | my $new; | ||||
| 143 | tie %$new, $class, $self; | ||||
| 144 | $new | ||||
| 145 | } | ||||
| 146 | |||||
| 147 | sub TIEHASH { | ||||
| 148 | my ($class, $self) = @_; | ||||
| 149 | bless $self, $class | ||||
| 150 | } | ||||
| 151 | |||||
| 152 | sub FETCH { | ||||
| 153 | my ($self, $key) = @_; | ||||
| 154 | if (exists $self->{NODE}{$key}) { | ||||
| 155 | return (grep {$_ eq $key} @{$self->{KEYS}}) | ||||
| 156 | ? $self->{NODE}{$key} : undef; | ||||
| 157 | } | ||||
| 158 | return $self->{HASH}{$key}; | ||||
| 159 | } | ||||
| 160 | |||||
| 161 | sub STORE { | ||||
| 162 | my ($self, $key, $value) = @_; | ||||
| 163 | if (exists $self->{NODE}{$key}) { | ||||
| 164 | $self->{NODE}{$key} = $value; | ||||
| 165 | } | ||||
| 166 | elsif (exists $self->{HASH}{$key}) { | ||||
| 167 | $self->{HASH}{$key} = $value; | ||||
| 168 | } | ||||
| 169 | else { | ||||
| 170 | if (not grep {$_ eq $key} @{$self->{KEYS}}) { | ||||
| 171 | push(@{$self->{KEYS}}, $key); | ||||
| 172 | } | ||||
| 173 | $self->{HASH}{$key} = $value; | ||||
| 174 | } | ||||
| 175 | $value | ||||
| 176 | } | ||||
| 177 | |||||
| 178 | sub DELETE { | ||||
| 179 | my ($self, $key) = @_; | ||||
| 180 | my $return; | ||||
| 181 | if (exists $self->{NODE}{$key}) { | ||||
| 182 | $return = $self->{NODE}{$key}; | ||||
| 183 | } | ||||
| 184 | elsif (exists $self->{HASH}{$key}) { | ||||
| 185 | $return = delete $self->{NODE}{$key}; | ||||
| 186 | } | ||||
| 187 | for (my $i = 0; $i < @{$self->{KEYS}}; $i++) { | ||||
| 188 | if ($self->{KEYS}[$i] eq $key) { | ||||
| 189 | splice(@{$self->{KEYS}}, $i, 1); | ||||
| 190 | } | ||||
| 191 | } | ||||
| 192 | return $return; | ||||
| 193 | } | ||||
| 194 | |||||
| 195 | sub CLEAR { | ||||
| 196 | my ($self) = @_; | ||||
| 197 | @{$self->{KEYS}} = (); | ||||
| 198 | %{$self->{HASH}} = (); | ||||
| 199 | } | ||||
| 200 | |||||
| 201 | sub FIRSTKEY { | ||||
| 202 | my ($self) = @_; | ||||
| 203 | $self->{ITER} = 0; | ||||
| 204 | $self->{KEYS}[0] | ||||
| 205 | } | ||||
| 206 | |||||
| 207 | sub NEXTKEY { | ||||
| 208 | my ($self) = @_; | ||||
| 209 | $self->{KEYS}[++$self->{ITER}] | ||||
| 210 | } | ||||
| 211 | |||||
| 212 | sub EXISTS { | ||||
| 213 | my ($self, $key) = @_; | ||||
| 214 | exists $self->{NODE}{$key} | ||||
| 215 | } | ||||
| 216 | |||||
| 217 | 1 | 9µs | 1; | ||
| 218 | |||||
| 219 | __END__ |