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