Filename | /usr/local/share/perl/5.18.2/Hash/MultiValue.pm |
Statements | Executed 2608473 statements in 9.61s |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
100001 | 1 | 1 | 1.67s | 2.05s | create | Hash::MultiValue::
100001 | 1 | 1 | 1.65s | 1.94s | DESTROY | Hash::MultiValue::
100001 | 1 | 1 | 1.46s | 1.52s | merge_flat | Hash::MultiValue::
100001 | 1 | 1 | 1.43s | 3.76s | new | Hash::MultiValue::
102107 | 1 | 1 | 1.06s | 1.12s | get_all | Hash::MultiValue::
1 | 1 | 1 | 34µs | 40µs | BEGIN@18 | Hash::MultiValue::
1 | 1 | 1 | 19µs | 19µs | BEGIN@5 | Hash::MultiValue::
1 | 1 | 1 | 18µs | 42µs | BEGIN@3 | Hash::MultiValue::
1 | 1 | 1 | 15µs | 76µs | BEGIN@12 | Hash::MultiValue::
1 | 1 | 1 | 14µs | 69µs | BEGIN@9 | Hash::MultiValue::
1 | 1 | 1 | 13µs | 32µs | BEGIN@4 | Hash::MultiValue::
1 | 1 | 1 | 5µs | 5µs | BEGIN@8 | Hash::MultiValue::
0 | 0 | 0 | 0s | 0s | STORABLE_freeze | Hash::MultiValue::
0 | 0 | 0 | 0s | 0s | STORABLE_thaw | Hash::MultiValue::
0 | 0 | 0 | 0s | 0s | __ANON__[:29] | Hash::MultiValue::
0 | 0 | 0 | 0s | 0s | __ANON__[:31] | Hash::MultiValue::
0 | 0 | 0 | 0s | 0s | add | Hash::MultiValue::
0 | 0 | 0 | 0s | 0s | as_hashref | Hash::MultiValue::
0 | 0 | 0 | 0s | 0s | as_hashref_mixed | Hash::MultiValue::
0 | 0 | 0 | 0s | 0s | as_hashref_multi | Hash::MultiValue::
0 | 0 | 0 | 0s | 0s | clear | Hash::MultiValue::
0 | 0 | 0 | 0s | 0s | clone | Hash::MultiValue::
0 | 0 | 0 | 0s | 0s | each | Hash::MultiValue::
0 | 0 | 0 | 0s | 0s | flatten | Hash::MultiValue::
0 | 0 | 0 | 0s | 0s | from_mixed | Hash::MultiValue::
0 | 0 | 0 | 0s | 0s | get | Hash::MultiValue::
0 | 0 | 0 | 0s | 0s | get_one | Hash::MultiValue::
0 | 0 | 0 | 0s | 0s | keys | Hash::MultiValue::
0 | 0 | 0 | 0s | 0s | merge_mixed | Hash::MultiValue::
0 | 0 | 0 | 0s | 0s | mixed | Hash::MultiValue::
0 | 0 | 0 | 0s | 0s | multi | Hash::MultiValue::
0 | 0 | 0 | 0s | 0s | ref | Hash::MultiValue::
0 | 0 | 0 | 0s | 0s | remove | Hash::MultiValue::
0 | 0 | 0 | 0s | 0s | set | Hash::MultiValue::
0 | 0 | 0 | 0s | 0s | values | Hash::MultiValue::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Hash::MultiValue; | ||||
2 | |||||
3 | 2 | 39µs | 2 | 65µs | # spent 42µs (18+23) within Hash::MultiValue::BEGIN@3 which was called:
# once (18µs+23µs) by Plack::Request::BEGIN@9 at line 3 # spent 42µs making 1 call to Hash::MultiValue::BEGIN@3
# spent 23µs making 1 call to strict::import |
4 | 2 | 35µs | 2 | 52µs | # spent 32µs (13+20) within Hash::MultiValue::BEGIN@4 which was called:
# once (13µs+20µs) by Plack::Request::BEGIN@9 at line 4 # spent 32µs making 1 call to Hash::MultiValue::BEGIN@4
# spent 20µs making 1 call to warnings::unimport |
5 | 2 | 81µs | 1 | 19µs | # spent 19µs within Hash::MultiValue::BEGIN@5 which was called:
# once (19µs+0s) by Plack::Request::BEGIN@9 at line 5 # spent 19µs making 1 call to Hash::MultiValue::BEGIN@5 |
6 | 1 | 800ns | our $VERSION = '0.15'; | ||
7 | |||||
8 | 2 | 34µs | 1 | 5µs | # spent 5µs within Hash::MultiValue::BEGIN@8 which was called:
# once (5µs+0s) by Plack::Request::BEGIN@9 at line 8 # spent 5µs making 1 call to Hash::MultiValue::BEGIN@8 |
9 | 2 | 48µs | 2 | 123µs | # spent 69µs (14+55) within Hash::MultiValue::BEGIN@9 which was called:
# once (14µs+55µs) by Plack::Request::BEGIN@9 at line 9 # spent 69µs making 1 call to Hash::MultiValue::BEGIN@9
# spent 55µs making 1 call to Exporter::import |
10 | |||||
11 | # there does not seem to be a relevant RT or perldelta entry for this | ||||
12 | 2 | 226µs | 2 | 137µs | # spent 76µs (15+61) within Hash::MultiValue::BEGIN@12 which was called:
# once (15µs+61µs) by Plack::Request::BEGIN@9 at line 12 # spent 76µs making 1 call to Hash::MultiValue::BEGIN@12
# spent 61µs making 1 call to constant::import |
13 | |||||
14 | 1 | 100ns | my %keys; | ||
15 | 1 | 0s | my %values; | ||
16 | 1 | 400ns | my %registry; | ||
17 | |||||
18 | # spent 40µs (34+6) within Hash::MultiValue::BEGIN@18 which was called:
# once (34µs+6µs) by Plack::Request::BEGIN@9 at line 32 | ||||
19 | 1 | 900ns | require Config; | ||
20 | 1 | 10µs | 1 | 6µs | my $needs_registry = ($^O eq 'Win32' || $Config::Config{useithreads}); # spent 6µs making 1 call to Config::FETCH |
21 | 1 | 600ns | if ($needs_registry) { | ||
22 | *CLONE = sub { | ||||
23 | foreach my $oldaddr (keys %registry) { | ||||
24 | my $this = refaddr $registry{$oldaddr}; | ||||
25 | $keys{$this} = delete $keys{$oldaddr}; | ||||
26 | $values{$this} = delete $values{$oldaddr}; | ||||
27 | Scalar::Util::weaken($registry{$this} = delete $registry{$oldaddr}); | ||||
28 | } | ||||
29 | 1 | 4µs | }; | ||
30 | } | ||||
31 | 1 | 12µs | *NEEDS_REGISTRY = sub () { $needs_registry }; | ||
32 | 1 | 1.92ms | 1 | 40µs | } # spent 40µs making 1 call to Hash::MultiValue::BEGIN@18 |
33 | |||||
34 | 1 | 500ns | if (defined &UNIVERSAL::ref::import) { | ||
35 | UNIVERSAL::ref->import; | ||||
36 | } | ||||
37 | |||||
38 | sub ref { 'HASH' } | ||||
39 | |||||
40 | # spent 2.05s (1.67+379ms) within Hash::MultiValue::create which was called 100001 times, avg 20µs/call:
# 100001 times (1.67s+379ms) by Hash::MultiValue::new at line 52, avg 20µs/call | ||||
41 | 100001 | 45.7ms | my $class = shift; | ||
42 | 100001 | 156ms | my $self = bless {}, $class; | ||
43 | 100001 | 706ms | 100001 | 185ms | my $this = refaddr $self; # spent 185ms making 100001 calls to Scalar::Util::refaddr, avg 2µs/call |
44 | 100001 | 180ms | $keys{$this} = []; | ||
45 | 100001 | 85.4ms | $values{$this} = []; | ||
46 | 100001 | 722ms | 100001 | 194ms | Scalar::Util::weaken($registry{$this} = $self) if NEEDS_REGISTRY; # spent 194ms making 100001 calls to Scalar::Util::weaken, avg 2µs/call |
47 | 100001 | 385ms | $self; | ||
48 | } | ||||
49 | |||||
50 | # spent 3.76s (1.43+2.32) within Hash::MultiValue::new which was called 100001 times, avg 38µs/call:
# 100001 times (1.43s+2.32s) by Plack::Request::_parse_query at line 96 of Plack/Request.pm, avg 38µs/call | ||||
51 | 100001 | 57.4ms | my $class = shift; | ||
52 | 100001 | 259ms | 100001 | 2.05s | my $self = $class->create; # spent 2.05s making 100001 calls to Hash::MultiValue::create, avg 20µs/call |
53 | 100001 | 113ms | unshift @_, $self; | ||
54 | 100001 | 1.59s | 200002 | 1.79s | goto &{ $self->can('merge_flat') }; # spent 1.52s making 100001 calls to Hash::MultiValue::merge_flat, avg 15µs/call
# spent 276ms making 100001 calls to UNIVERSAL::can, avg 3µs/call |
55 | } | ||||
56 | |||||
57 | sub from_mixed { | ||||
58 | my $class = shift; | ||||
59 | my $self = $class->create; | ||||
60 | unshift @_, $self; | ||||
61 | goto &{ $self->can('merge_mixed') }; | ||||
62 | } | ||||
63 | |||||
64 | # spent 1.94s (1.65+293ms) within Hash::MultiValue::DESTROY which was called 100001 times, avg 19µs/call:
# 100001 times (1.65s+293ms) by HTTP::Server::PSGI::accept_loop at line 107 of HTTP/Server/PSGI.pm, avg 19µs/call | ||||
65 | 100001 | 997ms | 100001 | 293ms | my $this = refaddr shift; # spent 293ms making 100001 calls to Scalar::Util::refaddr, avg 3µs/call |
66 | 100001 | 305ms | delete $keys{$this}; | ||
67 | 100001 | 167ms | delete $values{$this}; | ||
68 | 100001 | 640ms | delete $registry{$this} if NEEDS_REGISTRY; | ||
69 | } | ||||
70 | |||||
71 | sub get { | ||||
72 | my($self, $key) = @_; | ||||
73 | $self->{$key}; | ||||
74 | } | ||||
75 | |||||
76 | # spent 1.12s (1.06+59.1ms) within Hash::MultiValue::get_all which was called 102107 times, avg 11µs/call:
# 102107 times (1.06s+59.1ms) by PONAPI::Server::_ponapi_query_params at line 262 of lib/PONAPI/Server.pm, avg 11µs/call | ||||
77 | 102107 | 57.5ms | my($self, $key) = @_; | ||
78 | 102107 | 431ms | 102107 | 59.1ms | my $this = refaddr $self; # spent 59.1ms making 102107 calls to Scalar::Util::refaddr, avg 579ns/call |
79 | 102107 | 79.7ms | my $k = $keys{$this}; | ||
80 | 102107 | 815ms | (@{$values{$this}}[grep { $key eq $k->[$_] } 0 .. $#$k]); | ||
81 | } | ||||
82 | |||||
83 | sub get_one { | ||||
84 | my ($self, $key) = @_; | ||||
85 | my @v = $self->get_all($key); | ||||
86 | return $v[0] if @v == 1; | ||||
87 | Carp::croak "Key not found: $key" if not @v; | ||||
88 | Carp::croak "Multiple values match: $key"; | ||||
89 | } | ||||
90 | |||||
91 | sub set { | ||||
92 | my $self = shift; | ||||
93 | my $key = shift; | ||||
94 | |||||
95 | my $this = refaddr $self; | ||||
96 | my $k = $keys{$this}; | ||||
97 | my $v = $values{$this}; | ||||
98 | |||||
99 | my @idx = grep { $key eq $k->[$_] } 0 .. $#$k; | ||||
100 | |||||
101 | my $added = @_ - @idx; | ||||
102 | if ($added > 0) { | ||||
103 | my $start = $#$k + 1; | ||||
104 | push @$k, ($key) x $added; | ||||
105 | push @idx, $start .. $#$k; | ||||
106 | } | ||||
107 | elsif ($added < 0) { | ||||
108 | my ($start, @drop, @keep) = splice @idx, $added; | ||||
109 | for my $i ($start+1 .. $#$k) { | ||||
110 | if (@drop and $i == $drop[0]) { | ||||
111 | shift @drop; | ||||
112 | next; | ||||
113 | } | ||||
114 | push @keep, $i; | ||||
115 | } | ||||
116 | |||||
117 | splice @$_, $start, 0+@$_, ( _SPLICE_SAME_ARRAY_SEGFAULT | ||||
118 | ? @{[ @$_[@keep] ]} # force different source array | ||||
119 | : @$_[@keep] | ||||
120 | ) for $k, $v; | ||||
121 | } | ||||
122 | |||||
123 | if (@_) { | ||||
124 | @$v[@idx] = @_; | ||||
125 | $self->{$key} = $_[-1]; | ||||
126 | } | ||||
127 | else { | ||||
128 | delete $self->{$key}; | ||||
129 | } | ||||
130 | |||||
131 | $self; | ||||
132 | } | ||||
133 | |||||
134 | sub add { | ||||
135 | my $self = shift; | ||||
136 | my $key = shift; | ||||
137 | $self->merge_mixed( $key => \@_ ); | ||||
138 | $self; | ||||
139 | } | ||||
140 | |||||
141 | # spent 1.52s (1.46+57.3ms) within Hash::MultiValue::merge_flat which was called 100001 times, avg 15µs/call:
# 100001 times (1.46s+57.3ms) by Plack::Request::_parse_query at line 54, avg 15µs/call | ||||
142 | 100001 | 63.7ms | my $self = shift; | ||
143 | 100001 | 425ms | 100001 | 57.3ms | my $this = refaddr $self; # spent 57.3ms making 100001 calls to Scalar::Util::refaddr, avg 573ns/call |
144 | 100001 | 67.1ms | my $k = $keys{$this}; | ||
145 | 100001 | 73.4ms | my $v = $values{$this}; | ||
146 | 100001 | 497ms | push @{ $_ & 1 ? $v : $k }, $_[$_] for 0 .. $#_; | ||
147 | 100001 | 242ms | @{$self}{@$k} = @$v; | ||
148 | 100001 | 456ms | $self; | ||
149 | } | ||||
150 | |||||
151 | sub merge_mixed { | ||||
152 | my $self = shift; | ||||
153 | my $this = refaddr $self; | ||||
154 | my $k = $keys{$this}; | ||||
155 | my $v = $values{$this}; | ||||
156 | |||||
157 | my $hash; | ||||
158 | $hash = shift if @_ == 1; | ||||
159 | |||||
160 | while ( my ($key, $value) = @_ ? splice @_, 0, 2 : each %$hash ) { | ||||
161 | my @value = CORE::ref($value) eq 'ARRAY' ? @$value : $value; | ||||
162 | next if not @value; | ||||
163 | $self->{$key} = $value[-1]; | ||||
164 | push @$k, ($key) x @value; | ||||
165 | push @$v, @value; | ||||
166 | } | ||||
167 | |||||
168 | $self; | ||||
169 | } | ||||
170 | |||||
171 | sub remove { | ||||
172 | my ($self, $key) = @_; | ||||
173 | $self->set($key); | ||||
174 | $self; | ||||
175 | } | ||||
176 | |||||
177 | sub clear { | ||||
178 | my $self = shift; | ||||
179 | %$self = (); | ||||
180 | my $this = refaddr $self; | ||||
181 | $keys{$this} = []; | ||||
182 | $values{$this} = []; | ||||
183 | $self; | ||||
184 | } | ||||
185 | |||||
186 | sub clone { | ||||
187 | my $self = shift; | ||||
188 | CORE::ref($self)->new($self->flatten); | ||||
189 | } | ||||
190 | |||||
191 | sub keys { | ||||
192 | my $self = shift; | ||||
193 | return @{$keys{refaddr $self}}; | ||||
194 | } | ||||
195 | |||||
196 | sub values { | ||||
197 | my $self = shift; | ||||
198 | return @{$values{refaddr $self}}; | ||||
199 | } | ||||
200 | |||||
201 | sub flatten { | ||||
202 | my $self = shift; | ||||
203 | my $this = refaddr $self; | ||||
204 | my $k = $keys{$this}; | ||||
205 | my $v = $values{$this}; | ||||
206 | map { $k->[$_], $v->[$_] } 0 .. $#$k; | ||||
207 | } | ||||
208 | |||||
209 | sub each { | ||||
210 | my ($self, $code) = @_; | ||||
211 | my $this = refaddr $self; | ||||
212 | my $k = $keys{$this}; | ||||
213 | my $v = $values{$this}; | ||||
214 | for (0 .. $#$k) { | ||||
215 | $code->($k->[$_], $v->[$_]); | ||||
216 | } | ||||
217 | return $self; | ||||
218 | } | ||||
219 | |||||
220 | sub as_hashref { | ||||
221 | my $self = shift; | ||||
222 | my %hash = %$self; | ||||
223 | \%hash; | ||||
224 | } | ||||
225 | |||||
226 | sub as_hashref_mixed { | ||||
227 | my $self = shift; | ||||
228 | my $this = refaddr $self; | ||||
229 | my $k = $keys{$this}; | ||||
230 | my $v = $values{$this}; | ||||
231 | |||||
232 | my %hash; | ||||
233 | push @{$hash{$k->[$_]}}, $v->[$_] for 0 .. $#$k; | ||||
234 | for (CORE::values %hash) { | ||||
235 | $_ = $_->[0] if 1 == @$_; | ||||
236 | } | ||||
237 | |||||
238 | \%hash; | ||||
239 | } | ||||
240 | |||||
241 | sub mixed { $_[0]->as_hashref_mixed } | ||||
242 | |||||
243 | sub as_hashref_multi { | ||||
244 | my $self = shift; | ||||
245 | my $this = refaddr $self; | ||||
246 | my $k = $keys{$this}; | ||||
247 | my $v = $values{$this}; | ||||
248 | |||||
249 | my %hash; | ||||
250 | push @{$hash{$k->[$_]}}, $v->[$_] for 0 .. $#$k; | ||||
251 | |||||
252 | \%hash; | ||||
253 | } | ||||
254 | |||||
255 | sub multi { $_[0]->as_hashref_multi } | ||||
256 | |||||
257 | sub STORABLE_freeze { | ||||
258 | my $self = shift; | ||||
259 | my $this = refaddr $self; | ||||
260 | return '', $keys{$this}, $values{$this}; | ||||
261 | } | ||||
262 | |||||
263 | sub STORABLE_thaw { | ||||
264 | my $self = shift; | ||||
265 | my ($is_cloning, $serialised, $k, $v) = @_; | ||||
266 | my $this = refaddr $self; | ||||
267 | $keys {$this} = $k; | ||||
268 | $values{$this} = $v; | ||||
269 | @{$self}{@$k} = @$v; | ||||
270 | return $self; | ||||
271 | } | ||||
272 | |||||
273 | 1 | 7µs | 1; | ||
274 | __END__ |