Profile of fields.pm

Filename	/usr/share/perl/5.10/fields.pm
Statements	Executed 319 statements in 2.28ms

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
17	2	2	1.69ms	3.83ms	fields::::__ANON__[:128]fields::__ANON__[:128]
25	2	1	224µs	224µs	fields::::_accessible_keysfields::_accessible_keys (recurses: max depth 1, inclusive time 41µs)
2	2	2	204µs	222µs	fields::::importfields::import
1	1	1	31µs	38µs	fields::::BEGIN@4fields::BEGIN@4
26	1	1	18µs	18µs	fields::::CORE:matchfields::CORE:match (opcode)
1	1	1	18µs	86µs	fields::::BEGIN@12fields::BEGIN@12
1	1	1	16µs	44µs	fields::::BEGIN@5fields::BEGIN@5
0	0	0	0s	0s	fields::::__ANON__[:10]fields::__ANON__[:10]
0	0	0	0s	0s	fields::::__ANON__[:117]fields::__ANON__[:117]
0	0	0	0s	0s	fields::::_dumpfields::_dump
0	0	0	0s	0s	fields::::inheritfields::inherit
0	0	0	0s	0s	fields::::phashfields::phash

Call graph for these subroutines as a Graphviz dot language file.

Line	State ments	Time on line	Calls	Time in subs	Code
1					package fields;
2
3	1	36µs			require 5.005;
4	3	48µs	2	45µs	# spent 38µs (31+7) within fields::BEGIN@4 which was called: # once (31µs+7µs) by Cache::Memcached::BEGIN@22 at line 4 use strict; # spent 38µs making 1 call to fields::BEGIN@4 # spent 7µs making 1 call to strict::import
5	3	103µs	2	73µs	# spent 44µs (16+29) within fields::BEGIN@5 which was called: # once (16µs+29µs) by Cache::Memcached::BEGIN@22 at line 5 no strict 'refs'; # spent 44µs making 1 call to fields::BEGIN@5 # spent 29µs making 1 call to strict::unimport
6	1	37µs			unless( eval q{require warnings::register; warnings::register->import; 1} ) { # spent 11µs executing statements in string eval
7					*warnings::warnif = sub {
8					require Carp;
9					Carp::carp(@_);
10					}
11					}
12	3	1.15ms	2	153µs	# spent 86µs (18+68) within fields::BEGIN@12 which was called: # once (18µs+68µs) by Cache::Memcached::BEGIN@22 at line 12 use vars qw(%attr $VERSION); # spent 86µs making 1 call to fields::BEGIN@12 # spent 68µs making 1 call to vars::import
13
14	1	600ns			$VERSION = '2.14';
15
16					# constant.pm is slow
17					sub PUBLIC () { 2**0 }
18					sub PRIVATE () { 2**1 }
19					sub INHERITED () { 2**2 }
20					sub PROTECTED () { 2**3 }
21
22					# The %attr hash holds the attributes of the currently assigned fields
23					# per class. The hash is indexed by class names and the hash value is
24					# an array reference. The first element in the array is the lowest field
25					# number not belonging to a base class. The remaining elements' indices
26					# are the field numbers. The values are integer bit masks, or undef
27					# in the case of base class private fields (which occupy a slot but are
28					# otherwise irrelevant to the class).
29
30					# spent 222µs (204+18) within fields::import which was called 2 times, avg 111µs/call: # once (124µs+14µs) by Cache::Memcached::BEGIN@22 at line 22 of Cache/Memcached.pm # once (80µs+5µs) by Memoize::Memcached::BEGIN@26 at line 26 of Memoize/Memcached.pm sub import {
31	2	4µs			my $class = shift;
32	2	2µs			return unless @_;
33	2	3µs			my $package = caller(0);
34					# avoid possible typo warnings
35	2	17µs			%{"$package\::FIELDS"} = () unless %{"$package\::FIELDS"};
36	2	4µs			my $fields = \%{"$package\::FIELDS"};
37	2	7µs			my $fattr = ($attr{$package} \|\|= [1]);
38	2	2µs			my $next = @$fattr;
39
40					# Quiet pseudo-hash deprecation warning for uses of fields::new.
41	2	23µs			bless \%{"$package\::FIELDS"}, 'pseudohash';
42
43	2	4µs			if ($next > $fattr->[0]
44					and ($fields->{$_[0]} \|\| 0) >= $fattr->[0])
45					{
46					# There are already fields not belonging to base classes.
47					# Looks like a possible module reload...
48					$next = $fattr->[0];
49					}
50	2	5µs			foreach my $f (@_) {
51	26	13µs			my $fno = $fields->{$f};
52
53					# Allow the module to be reloaded so long as field positions
54					# have not changed.
55	26	6µs			if ($fno and $fno != $next) {
56					require Carp;
57					if ($fno < $fattr->[0]) {
58					if ($] < 5.006001) {
59					warn("Hides field '$f' in base class") if $^W;
60					} else {
61					warnings::warnif("Hides field '$f' in base class") ;
62					}
63					} else {
64					Carp::croak("Field name '$f' already in use");
65					}
66					}
67	26	22µs			$fields->{$f} = $next;
68	26	79µs	26	18µs	$fattr->[$next] = ($f =~ /^_/) ? PRIVATE : PUBLIC; # spent 18µs making 26 calls to fields::CORE:match, avg 704ns/call
69	26	22µs			$next += 1;
70					}
71	2	10µs			if (@$fattr > $next) {
72					# Well, we gave them the benefit of the doubt by guessing the
73					# module was reloaded, but they appear to be declaring fields
74					# in more than one place. We can't be sure (without some extra
75					# bookkeeping) that the rest of the fields will be declared or
76					# have the same positions, so punt.
77					require Carp;
78					Carp::croak ("Reloaded module must declare all fields at once");
79					}
80					}
81
82					sub inherit {
83					require base;
84					goto &base::inherit_fields;
85					}
86
87					sub _dump # sometimes useful for debugging
88					{
89					for my $pkg (sort keys %attr) {
90					print "\n$pkg";
91					if (@{"$pkg\::ISA"}) {
92					print " (", join(", ", @{"$pkg\::ISA"}), ")";
93					}
94					print "\n";
95					my $fields = \%{"$pkg\::FIELDS"};
96					for my $f (sort {$fields->{$a} <=> $fields->{$b}} keys %$fields) {
97					my $no = $fields->{$f};
98					print " $no: $f";
99					my $fattr = $attr{$pkg}[$no];
100					if (defined $fattr) {
101					my @a;
102					push(@a, "public") if $fattr & PUBLIC;
103					push(@a, "private") if $fattr & PRIVATE;
104					push(@a, "inherited") if $fattr & INHERITED;
105					print "\t(", join(", ", @a), ")";
106					}
107					print "\n";
108					}
109					}
110					}
111
112	1	2µs			if ($] < 5.009) {
113					*new = sub {
114					my $class = shift;
115					$class = ref $class if ref $class;
116					return bless [\%{$class . "::FIELDS"}], $class;
117					}
118					} else {
119					# spent 3.83ms (1.69+2.14) within fields::__ANON__[/usr/share/perl/5.10/fields.pm:128] which was called 17 times, avg 225µs/call: # 9 times (1.57ms+1.54ms) by Cache::Memcached::new at line 67 of Cache/Memcached.pm, avg 346µs/call # 8 times (119µs+602µs) by Memoize::Memcached::_new at line 195 of Memoize/Memcached.pm, avg 90µs/call *new = sub {
120	17	10µs			my $class = shift;
121	17	5µs			$class = ref $class if ref $class;
122	17	184µs			require Hash::Util;
123	17	67µs			my $self = bless {}, $class;
124
125					# The lock_keys() prototype won't work since we require Hash::Util :(
126	17	89µs	34	1.50ms	&Hash::Util::lock_keys(\%$self, _accessible_keys($class)); # spent 1.28ms making 17 calls to Hash::Util::lock_keys, avg 75µs/call # spent 224µs making 17 calls to fields::_accessible_keys, avg 13µs/call
127	17	60µs			return $self;
128					}
129	1	4µs			}
130
131					# spent 224µs (224+0ns) within fields::_accessible_keys which was called 25 times, avg 9µs/call: # 17 times (184µs+41µs) by fields::__ANON__[/usr/share/perl/5.10/fields.pm:128] at line 126, avg 13µs/call # 8 times (41µs+-41µs) by fields::_accessible_keys at line 135, avg 0s/call sub _accessible_keys {
132	25	21µs			my ($class) = @_;
133					return (
134					keys %{$class.'::FIELDS'},
135	25	230µs	8	0s	map(_accessible_keys($_), @{$class.'::ISA'}), # spent 41µs making 8 calls to fields::_accessible_keys, avg 5µs/call, recursion: max depth 1, sum of overlapping time 41µs
136					);
137					}
138
139					sub phash {
140					die "Pseudo-hashes have been removed from Perl" if $] >= 5.009;
141					my $h;
142					my $v;
143					if (@_) {
144					if (ref $_[0] eq 'ARRAY') {
145					my $a = shift;
146					@$h{@$a} = 1 .. @$a;
147					if (@_) {
148					$v = shift;
149					unless (! @_ and ref $v eq 'ARRAY') {
150					require Carp;
151					Carp::croak ("Expected at most two array refs\n");
152					}
153					}
154					}
155					else {
156					if (@_ % 2) {
157					require Carp;
158					Carp::croak ("Odd number of elements initializing pseudo-hash\n");
159					}
160					my $i = 0;
161					@$h{grep ++$i % 2, @_} = 1 .. @_ / 2;
162					$i = 0;
163					$v = [grep $i++ % 2, @_];
164					}
165					}
166					else {
167					$h = {};
168					$v = [];
169					}
170					[ $h, @$v ];
171
172					}
173
174	1	9µs			1;
175
176					__END__

					# spent 18µs within fields::CORE:match which was called 26 times, avg 704ns/call: # 26 times (18µs+0s) by fields::import at line 68, avg 704ns/call sub fields::CORE:match; # opcode