← Index
NYTProf Performance Profile   « line view »
For svc/members/upsert
  Run on Tue Jan 13 11:50:22 2015
Reported on Tue Jan 13 12:09:50 2015

Filename/usr/share/perl5/YAML/Node.pm
StatementsExecuted 16 statements in 1.74ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
111800µs868µsYAML::Node::::BEGIN@4 YAML::Node::BEGIN@4
11111µs16µsYAML::::BEGIN@1.8 YAML::BEGIN@1.8
11111µs23µsYAML::::BEGIN@1 YAML::BEGIN@1
1118µs22µsYAML::Node::::BEGIN@7 YAML::Node::BEGIN@7
0000s0sYAML::Node::::keys YAML::Node::keys
0000s0sYAML::Node::::kind YAML::Node::kind
0000s0sYAML::Node::::new YAML::Node::new
0000s0sYAML::Node::::node YAML::Node::node
0000s0sYAML::Node::::tag YAML::Node::tag
0000s0sYAML::Node::::ynode YAML::Node::ynode
0000s0syaml_mapping::::CLEAR yaml_mapping::CLEAR
0000s0syaml_mapping::::DELETE yaml_mapping::DELETE
0000s0syaml_mapping::::EXISTS yaml_mapping::EXISTS
0000s0syaml_mapping::::FETCH yaml_mapping::FETCH
0000s0syaml_mapping::::FIRSTKEY yaml_mapping::FIRSTKEY
0000s0syaml_mapping::::NEXTKEY yaml_mapping::NEXTKEY
0000s0syaml_mapping::::STORE yaml_mapping::STORE
0000s0syaml_mapping::::TIEHASH yaml_mapping::TIEHASH
0000s0syaml_mapping::::new yaml_mapping::new
0000s0syaml_scalar::::FETCH yaml_scalar::FETCH
0000s0syaml_scalar::::STORE yaml_scalar::STORE
0000s0syaml_scalar::::TIESCALAR yaml_scalar::TIESCALAR
0000s0syaml_scalar::::new yaml_scalar::new
0000s0syaml_sequence::::FETCHyaml_sequence::FETCH
0000s0syaml_sequence::::FETCHSIZEyaml_sequence::FETCHSIZE
0000s0syaml_sequence::::STOREyaml_sequence::STORE
0000s0syaml_sequence::::TIEARRAYyaml_sequence::TIEARRAY
0000s0syaml_sequence::::newyaml_sequence::new
0000s0syaml_sequence::::undoneyaml_sequence::undone
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1457µs456µs
# spent 23µs (11+12) within YAML::BEGIN@1 which was called: # once (11µs+12µs) by YAML::BEGIN@11 at line 1 # spent 16µs (11+5) within YAML::BEGIN@1.8 which was called: # once (11µs+5µs) by YAML::BEGIN@11 at line 1
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
2package YAML::Node;
3
42684µs1868µ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
use YAML::Tag;
# spent 868µs making 1 call to YAML::Node::BEGIN@4
51500nsrequire YAML::Mo;
6
72972µs236µ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
use Exporter;
# spent 22µs making 1 call to YAML::Node::BEGIN@7 # spent 14µs making 1 call to Exporter::import
818µsour @ISA = qw(Exporter YAML::Mo::Object);
91500nsour @EXPORT = qw(ynode);
10
11sub 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
28sub 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
46sub node { $_->{NODE} }
47sub kind { $_->{KIND} }
48sub 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}
58sub 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#==============================================================================
70package yaml_scalar;
71
7213µs@yaml_scalar::ISA = qw(YAML::Node);
73
74sub new {
75 my ($class, $self) = @_;
76 tie $_[2], $class, $self;
77}
78
79sub TIESCALAR {
80 my ($class, $self) = @_;
81 bless $self, $class;
82 $self
83}
84
85sub FETCH {
86 my ($self) = @_;
87 $self->{NODE}
88}
89
90sub STORE {
91 my ($self, $value) = @_;
92 $self->{NODE} = $value
93}
94
95#==============================================================================
96package yaml_sequence;
97
9813µs@yaml_sequence::ISA = qw(YAML::Node);
99
100sub new {
101 my ($class, $self) = @_;
102 my $new;
103 tie @$new, $class, $self;
104 $new
105}
106
107sub TIEARRAY {
108 my ($class, $self) = @_;
109 bless $self, $class
110}
111
112sub FETCHSIZE {
113 my ($self) = @_;
114 scalar @{$self->{NODE}};
115}
116
117sub FETCH {
118 my ($self, $index) = @_;
119 $self->{NODE}[$index]
120}
121
122sub STORE {
123 my ($self, $index, $value) = @_;
124 $self->{NODE}[$index] = $value
125}
126
127sub undone {
128 die "Not implemented yet"; # XXX
129}
130
13113µ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#==============================================================================
136package yaml_mapping;
137
13812µs@yaml_mapping::ISA = qw(YAML::Node);
139
140sub new {
141 my ($class, $self) = @_;
142 @{$self->{KEYS}} = sort keys %{$self->{NODE}};
143 my $new;
144 tie %$new, $class, $self;
145 $new
146}
147
148sub TIEHASH {
149 my ($class, $self) = @_;
150 bless $self, $class
151}
152
153sub 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
162sub 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
179sub 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
196sub CLEAR {
197 my ($self) = @_;
198 @{$self->{KEYS}} = ();
199 %{$self->{HASH}} = ();
200}
201
202sub FIRSTKEY {
203 my ($self) = @_;
204 $self->{ITER} = 0;
205 $self->{KEYS}[0]
206}
207
208sub NEXTKEY {
209 my ($self) = @_;
210 $self->{KEYS}[++$self->{ITER}]
211}
212
213sub EXISTS {
214 my ($self, $key) = @_;
215 exists $self->{NODE}{$key}
216}
217
21815µs1;