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 | BEGIN@7 | YAML::Node::
1 | 1 | 1 | 19µs | 23µs | BEGIN@3 | YAML::Node::
1 | 1 | 1 | 16µs | 31µs | BEGIN@4 | YAML::Node::
1 | 1 | 1 | 10µs | 48µs | BEGIN@6 | 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 | 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__ |