Filename | /usr/share/perl5/YAML/Node.pm |
Statements | Executed 16 statements in 1.74ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 800µs | 868µs | BEGIN@4 | YAML::Node::
1 | 1 | 1 | 11µs | 16µs | BEGIN@1.8 | YAML::
1 | 1 | 1 | 11µs | 23µs | BEGIN@1 | YAML::
1 | 1 | 1 | 8µs | 22µs | BEGIN@7 | 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 | 4 | 57µs | 4 | 56µs | use strict; use warnings; # spent 23µs making 1 call to YAML::BEGIN@1
# spent 16µs making 1 call to YAML::BEGIN@1.8
# spent 12µs making 1 call to strict::import
# spent 5µs making 1 call to warnings::import |
2 | package YAML::Node; | ||||
3 | |||||
4 | 2 | 684µs | 1 | 868µs | # spent 868µs (800+67) within YAML::Node::BEGIN@4 which was called:
# once (800µs+67µs) by YAML::BEGIN@11 at line 4 # spent 868µs making 1 call to YAML::Node::BEGIN@4 |
5 | 1 | 500ns | require YAML::Mo; | ||
6 | |||||
7 | 2 | 972µs | 2 | 36µs | # spent 22µs (8+14) within YAML::Node::BEGIN@7 which was called:
# once (8µs+14µs) by YAML::BEGIN@11 at line 7 # spent 22µs making 1 call to YAML::Node::BEGIN@7
# spent 14µs making 1 call to Exporter::import |
8 | 1 | 8µs | our @ISA = qw(Exporter YAML::Mo::Object); | ||
9 | 1 | 500ns | our @EXPORT = qw(ynode); | ||
10 | |||||
11 | sub ynode { | ||||
12 | my $self; | ||||
13 | if (ref($_[0]) eq 'HASH') { | ||||
14 | $self = tied(%{$_[0]}); | ||||
15 | } | ||||
16 | elsif (ref($_[0]) eq 'ARRAY') { | ||||
17 | $self = tied(@{$_[0]}); | ||||
18 | } | ||||
19 | elsif (ref(\$_[0]) eq 'GLOB') { | ||||
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 | 3µ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 | 3µ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 | 2µ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 | 5µs | 1; |