| 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 | Hash::MultiValue::create |
| 100001 | 1 | 1 | 1.65s | 1.94s | Hash::MultiValue::DESTROY |
| 100001 | 1 | 1 | 1.46s | 1.52s | Hash::MultiValue::merge_flat |
| 100001 | 1 | 1 | 1.43s | 3.76s | Hash::MultiValue::new |
| 102107 | 1 | 1 | 1.06s | 1.12s | Hash::MultiValue::get_all |
| 1 | 1 | 1 | 34µs | 40µs | Hash::MultiValue::BEGIN@18 |
| 1 | 1 | 1 | 19µs | 19µs | Hash::MultiValue::BEGIN@5 |
| 1 | 1 | 1 | 18µs | 42µs | Hash::MultiValue::BEGIN@3 |
| 1 | 1 | 1 | 15µs | 76µs | Hash::MultiValue::BEGIN@12 |
| 1 | 1 | 1 | 14µs | 69µs | Hash::MultiValue::BEGIN@9 |
| 1 | 1 | 1 | 13µs | 32µs | Hash::MultiValue::BEGIN@4 |
| 1 | 1 | 1 | 5µs | 5µs | Hash::MultiValue::BEGIN@8 |
| 0 | 0 | 0 | 0s | 0s | Hash::MultiValue::STORABLE_freeze |
| 0 | 0 | 0 | 0s | 0s | Hash::MultiValue::STORABLE_thaw |
| 0 | 0 | 0 | 0s | 0s | Hash::MultiValue::__ANON__[:29] |
| 0 | 0 | 0 | 0s | 0s | Hash::MultiValue::__ANON__[:31] |
| 0 | 0 | 0 | 0s | 0s | Hash::MultiValue::add |
| 0 | 0 | 0 | 0s | 0s | Hash::MultiValue::as_hashref |
| 0 | 0 | 0 | 0s | 0s | Hash::MultiValue::as_hashref_mixed |
| 0 | 0 | 0 | 0s | 0s | Hash::MultiValue::as_hashref_multi |
| 0 | 0 | 0 | 0s | 0s | Hash::MultiValue::clear |
| 0 | 0 | 0 | 0s | 0s | Hash::MultiValue::clone |
| 0 | 0 | 0 | 0s | 0s | Hash::MultiValue::each |
| 0 | 0 | 0 | 0s | 0s | Hash::MultiValue::flatten |
| 0 | 0 | 0 | 0s | 0s | Hash::MultiValue::from_mixed |
| 0 | 0 | 0 | 0s | 0s | Hash::MultiValue::get |
| 0 | 0 | 0 | 0s | 0s | Hash::MultiValue::get_one |
| 0 | 0 | 0 | 0s | 0s | Hash::MultiValue::keys |
| 0 | 0 | 0 | 0s | 0s | Hash::MultiValue::merge_mixed |
| 0 | 0 | 0 | 0s | 0s | Hash::MultiValue::mixed |
| 0 | 0 | 0 | 0s | 0s | Hash::MultiValue::multi |
| 0 | 0 | 0 | 0s | 0s | Hash::MultiValue::ref |
| 0 | 0 | 0 | 0s | 0s | Hash::MultiValue::remove |
| 0 | 0 | 0 | 0s | 0s | Hash::MultiValue::set |
| 0 | 0 | 0 | 0s | 0s | Hash::MultiValue::values |
| 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__ |