← Index
NYTProf Performance Profile   « block view • line view • sub view »
For bin/hailo
  Run on Thu Oct 21 22:50:37 2010
Reported on Thu Oct 21 22:52:05 2010

Filename/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/5.13.5/Tie/RefHash.pm
StatementsExecuted 42 statements in 1.46ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
111776µs1.09msTie::RefHash::::BEGIN@90 Tie::RefHash::BEGIN@90
11126µs66µsTie::RefHash::::BEGIN@3 Tie::RefHash::BEGIN@3
11125µs100µsTie::RefHash::::BEGIN@96 Tie::RefHash::BEGIN@96
21124µs32µsTie::RefHash::::STORE Tie::RefHash::STORE
11119µs19µsTie::RefHash::::BEGIN@7 Tie::RefHash::BEGIN@7
11117µs17µsTie::RefHash::::TIEHASH Tie::RefHash::TIEHASH
11112µs56µsTie::RefHash::::BEGIN@106 Tie::RefHash::BEGIN@106
11111µs47µsTie::RefHash::Nestable::::BEGIN@262Tie::RefHash::Nestable::BEGIN@262
11111µs16µsTie::RefHash::::BEGIN@93 Tie::RefHash::BEGIN@93
11111µs46µsTie::RefHash::::BEGIN@91 Tie::RefHash::BEGIN@91
11111µs53µsTie::RefHash::::BEGIN@94 Tie::RefHash::BEGIN@94
1116µs6µsTie::RefHash::::BEGIN@99 Tie::RefHash::BEGIN@99
0000s0sTie::RefHash::::CLEAR Tie::RefHash::CLEAR
0000s0sTie::RefHash::::CLONE Tie::RefHash::CLONE
0000s0sTie::RefHash::::DELETE Tie::RefHash::DELETE
0000s0sTie::RefHash::::EXISTS Tie::RefHash::EXISTS
0000s0sTie::RefHash::::FETCH Tie::RefHash::FETCH
0000s0sTie::RefHash::::FIRSTKEY Tie::RefHash::FIRSTKEY
0000s0sTie::RefHash::::NEXTKEY Tie::RefHash::NEXTKEY
0000s0sTie::RefHash::Nestable::::STORETie::RefHash::Nestable::STORE
0000s0sTie::RefHash::::STORABLE_freeze Tie::RefHash::STORABLE_freeze
0000s0sTie::RefHash::::STORABLE_thaw Tie::RefHash::STORABLE_thaw
0000s0sTie::RefHash::::__ANON__[:122] Tie::RefHash::__ANON__[:122]
0000s0sTie::RefHash::::_reindex_keys Tie::RefHash::_reindex_keys
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Tie::RefHash;
2
3235µs2105µs
# spent 66µs (26+39) within Tie::RefHash::BEGIN@3 which was called: # once (26µs+39µs) by Fatal::BEGIN@7 at line 3
use vars qw/$VERSION/;
# spent 66µs making 1 call to Tie::RefHash::BEGIN@3 # spent 40µs making 1 call to vars::import
4
512µs$VERSION = "1.38";
6
7275µs119µs
# spent 19µs within Tie::RefHash::BEGIN@7 which was called: # once (19µs+0s) by Fatal::BEGIN@7 at line 7
use 5.005;
# spent 19µs making 1 call to Tie::RefHash::BEGIN@7
8
9=head1 NAME
10
11Tie::RefHash - use references as hash keys
12
13=head1 SYNOPSIS
14
15 require 5.004;
16 use Tie::RefHash;
17 tie HASHVARIABLE, 'Tie::RefHash', LIST;
18 tie HASHVARIABLE, 'Tie::RefHash::Nestable', LIST;
19
20 untie HASHVARIABLE;
21
22=head1 DESCRIPTION
23
24This module provides the ability to use references as hash keys if you
25first C<tie> the hash variable to this module. Normally, only the
26keys of the tied hash itself are preserved as references; to use
27references as keys in hashes-of-hashes, use Tie::RefHash::Nestable,
28included as part of Tie::RefHash.
29
30It is implemented using the standard perl TIEHASH interface. Please
31see the C<tie> entry in perlfunc(1) and perltie(1) for more information.
32
33The Nestable version works by looking for hash references being stored
34and converting them to tied hashes so that they too can have
35references as keys. This will happen without warning whenever you
36store a reference to one of your own hashes in the tied hash.
37
38=head1 EXAMPLE
39
40 use Tie::RefHash;
41 tie %h, 'Tie::RefHash';
42 $a = [];
43 $b = {};
44 $c = \*main;
45 $d = \"gunk";
46 $e = sub { 'foo' };
47 %h = ($a => 1, $b => 2, $c => 3, $d => 4, $e => 5);
48 $a->[0] = 'foo';
49 $b->{foo} = 'bar';
50 for (keys %h) {
51 print ref($_), "\n";
52 }
53
54 tie %h, 'Tie::RefHash::Nestable';
55 $h{$a}->{$b} = 1;
56 for (keys %h, keys %{$h{$a}}) {
57 print ref($_), "\n";
58 }
59
60=head1 THREAD SUPPORT
61
62L<Tie::RefHash> fully supports threading using the C<CLONE> method.
63
64=head1 STORABLE SUPPORT
65
66L<Storable> hooks are provided for semantically correct serialization and
67cloning of tied refhashes.
68
69=head1 RELIC SUPPORT
70
71This version of Tie::RefHash seems to no longer work with 5.004. This has not
72been throughly investigated. Patches welcome ;-)
73
74=head1 MAINTAINER
75
76Yuval Kogman E<lt>nothingmuch@woobling.orgE<gt>
77
78=head1 AUTHOR
79
80Gurusamy Sarathy gsar@activestate.com
81
82'Nestable' by Ed Avis ed@membled.com
83
84=head1 SEE ALSO
85
86perl(1), perlfunc(1), perltie(1)
87
88=cut
89
902269µs11.09ms
# spent 1.09ms (776µs+316µs) within Tie::RefHash::BEGIN@90 which was called: # once (776µs+316µs) by Fatal::BEGIN@7 at line 90
use Tie::Hash;
# spent 1.09ms making 1 call to Tie::RefHash::BEGIN@90
91233µs282µs
# spent 46µs (11+35) within Tie::RefHash::BEGIN@91 which was called: # once (11µs+35µs) by Fatal::BEGIN@7 at line 91
use vars '@ISA';
# spent 46µs making 1 call to Tie::RefHash::BEGIN@91 # spent 35µs making 1 call to vars::import
9216µs@ISA = qw(Tie::Hash);
93225µs221µs
# spent 16µs (11+5) within Tie::RefHash::BEGIN@93 which was called: # once (11µs+5µs) by Fatal::BEGIN@7 at line 93
use strict;
# spent 16µs making 1 call to Tie::RefHash::BEGIN@93 # spent 5µs making 1 call to strict::import
94232µs296µs
# spent 53µs (11+43) within Tie::RefHash::BEGIN@94 which was called: # once (11µs+43µs) by Fatal::BEGIN@7 at line 94
use Carp qw/croak/;
# spent 53µs making 1 call to Tie::RefHash::BEGIN@94 # spent 43µs making 1 call to Exporter::import
95
96
# spent 100µs (25+75) within Tie::RefHash::BEGIN@96 which was called: # once (25µs+75µs) by Fatal::BEGIN@7 at line 104
BEGIN {
97720µs local $@;
98 # determine whether we need to take care of threads
992111µs16µs
# spent 6µs within Tie::RefHash::BEGIN@99 which was called: # once (6µs+0s) by Fatal::BEGIN@7 at line 99
use Config ();
# spent 6µs making 1 call to Tie::RefHash::BEGIN@99
10012µs175µs my $usethreads = $Config::Config{usethreads}; # && exists $INC{"threads.pm"}
# spent 75µs making 1 call to Config::FETCH
101 *_HAS_THREADS = $usethreads ? sub () { 1 } : sub () { 0 };
102 *_HAS_SCALAR_UTIL = eval { require Scalar::Util; 1 } ? sub () { 1 } : sub () { 0 };
103 *_HAS_WEAKEN = defined(&Scalar::Util::weaken) ? sub () { 1 } : sub () { 0 };
1041109µs1100µs}
# spent 100µs making 1 call to Tie::RefHash::BEGIN@96
105
106
# spent 56µs (12+44) within Tie::RefHash::BEGIN@106 which was called: # once (12µs+44µs) by Fatal::BEGIN@7 at line 124
BEGIN {
107 # create a refaddr function
108
10929µs local $@;
110
111144µs if ( _HAS_SCALAR_UTIL ) {
# spent 44µs making 1 call to Exporter::import
112 Scalar::Util->import("refaddr");
113 } else {
114 require overload;
115
116 *refaddr = sub {
117 if ( overload::StrVal($_[0]) =~ /\( 0x ([a-zA-Z0-9]+) \)$/x) {
118 return $1;
119 } else {
120 die "couldn't parse StrVal: " . overload::StrVal($_[0]);
121 }
122 };
123 }
1241593µs156µs}
# spent 56µs making 1 call to Tie::RefHash::BEGIN@106
125
12611µsmy (@thread_object_registry, $count); # used by the CLONE method to rehash the keys after their refaddr changed
127
128
# spent 17µs within Tie::RefHash::TIEHASH which was called: # once (17µs+0s) by autodie::BEGIN@6 at line 172 of Fatal.pm
sub TIEHASH {
129519µs my $c = shift;
130 my $s = [];
131 bless $s, $c;
132 while (@_) {
133 $s->STORE(shift, shift);
134 }
135
136 if (_HAS_THREADS ) {
137
138 if ( _HAS_WEAKEN ) {
139 # remember the object so that we can rekey it on CLONE
140 push @thread_object_registry, $s;
141 # but make this a weak reference, so that there are no leaks
142 Scalar::Util::weaken( $thread_object_registry[-1] );
143
144 if ( ++$count > 1000 ) {
145 # this ensures we don't fill up with a huge array dead weakrefs
146 @thread_object_registry = grep { defined } @thread_object_registry;
147 $count = 0;
148 }
149 } else {
150 $count++; # used in the warning
151 }
152 }
153
154 return $s;
155}
156
15712µsmy $storable_format_version = join("/", __PACKAGE__, "0.01");
158
159sub STORABLE_freeze {
160 my ( $self, $is_cloning ) = @_;
161 my ( $refs, $reg ) = @$self;
162 return ( $storable_format_version, [ values %$refs ], $reg );
163}
164
165sub STORABLE_thaw {
166 my ( $self, $is_cloning, $version, $refs, $reg ) = @_;
167 croak "incompatible versions of Tie::RefHash between freeze and thaw"
168 unless $version eq $storable_format_version;
169
170 @$self = ( {}, $reg );
171 $self->_reindex_keys( $refs );
172}
173
174sub CLONE {
175 my $pkg = shift;
176
177 if ( $count and not _HAS_WEAKEN ) {
178 warn "Tie::RefHash is not threadsafe without Scalar::Util::weaken";
179 }
180
181 # when the thread has been cloned all the objects need to be updated.
182 # dead weakrefs are undefined, so we filter them out
183 @thread_object_registry = grep { defined && do { $_->_reindex_keys; 1 } } @thread_object_registry;
184 $count = 0; # we just cleaned up
185}
186
187sub _reindex_keys {
188 my ( $self, $extra_keys ) = @_;
189 # rehash all the ref keys based on their new StrVal
190 %{ $self->[0] } = map { refaddr($_->[0]) => $_ } (values(%{ $self->[0] }), @{ $extra_keys || [] });
191}
192
193sub FETCH {
194 my($s, $k) = @_;
195 if (ref $k) {
196 my $kstr = refaddr($k);
197 if (defined $s->[0]{$kstr}) {
198 $s->[0]{$kstr}[1];
199 }
200 else {
201 undef;
202 }
203 }
204 else {
205 $s->[1]{$k};
206 }
207}
208
209
# spent 32µs (24+8) within Tie::RefHash::STORE which was called 2 times, avg 16µs/call: # 2 times (24µs+8µs) by Fatal::_make_fatal at line 1205 of Fatal.pm, avg 16µs/call
sub STORE {
210634µs my($s, $k, $v) = @_;
21128µs if (ref $k) {
# spent 8µs making 2 calls to Scalar::Util::refaddr, avg 4µs/call
212 $s->[0]{refaddr($k)} = [$k, $v];
213 }
214 else {
215 $s->[1]{$k} = $v;
216 }
217 $v;
218}
219
220sub DELETE {
221 my($s, $k) = @_;
222 (ref $k)
223 ? (delete($s->[0]{refaddr($k)}) || [])->[1]
224 : delete($s->[1]{$k});
225}
226
227sub EXISTS {
228 my($s, $k) = @_;
229 (ref $k) ? exists($s->[0]{refaddr($k)}) : exists($s->[1]{$k});
230}
231
232sub FIRSTKEY {
233 my $s = shift;
234 keys %{$s->[0]}; # reset iterator
235 keys %{$s->[1]}; # reset iterator
236 $s->[2] = 0; # flag for iteration, see NEXTKEY
237 $s->NEXTKEY;
238}
239
240sub NEXTKEY {
241 my $s = shift;
242 my ($k, $v);
243 if (!$s->[2]) {
244 if (($k, $v) = each %{$s->[0]}) {
245 return $v->[0];
246 }
247 else {
248 $s->[2] = 1;
249 }
250 }
251 return each %{$s->[1]};
252}
253
254sub CLEAR {
255 my $s = shift;
256 $s->[2] = 0;
257 %{$s->[0]} = ();
258 %{$s->[1]} = ();
259}
260
261package Tie::RefHash::Nestable;
262277µs282µs
# spent 47µs (11+35) within Tie::RefHash::Nestable::BEGIN@262 which was called: # once (11µs+35µs) by Fatal::BEGIN@7 at line 262
use vars '@ISA';
# spent 47µs making 1 call to Tie::RefHash::Nestable::BEGIN@262 # spent 35µs making 1 call to vars::import
26314µs@ISA = 'Tie::RefHash';
264
265sub STORE {
266 my($s, $k, $v) = @_;
267 if (ref($v) eq 'HASH' and not tied %$v) {
268 my @elems = %$v;
269 tie %$v, ref($s), @elems;
270 }
271 $s->SUPER::STORE($k, $v);
272}
273
27415µs1;