← Index
NYTProf Performance Profile   « block view • line view • sub view »
For 01.HTTP.t
  Run on Tue May 4 15:25:55 2010
Reported on Tue May 4 15:26:14 2010

File /usr/local/lib/perl5/5.10.1/base.pm
Statements Executed 1536
Statement Execution Time 16.3ms
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
52525122.4ms33.9msbase::::importbase::import
6111446µs446µsbase::::has_versionbase::has_version
6111192µs192µsbase::::has_fieldsbase::has_fields
6111145µs145µsbase::::has_attrbase::has_attr
11119µs37µsbase::::BEGIN@3base::BEGIN@3
1119µs46µsbase::::BEGIN@4base::BEGIN@4
0000s0sbase::::__ANON__[:54]base::__ANON__[:54]
0000s0sbase::::__ANON__[:61]base::__ANON__[:61]
0000s0sbase::::get_attrbase::get_attr
0000s0sbase::::inherit_fieldsbase::inherit_fields
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package base;
2
3327µs256µs
# spent 37µs (19+18) within base::BEGIN@3 which was called # once (19µs+18µs) by Class::MOP::Mixin::AttributeCore::BEGIN@12 at line 3
use strict 'vars';
# spent 37µs making 1 call to base::BEGIN@3 # spent 18µs making 1 call to strict::import
43944µs282µs
# spent 46µs (9+36) within base::BEGIN@4 which was called # once (9µs+36µs) by Class::MOP::Mixin::AttributeCore::BEGIN@12 at line 4
use vars qw($VERSION);
# spent 46µs making 1 call to base::BEGIN@4 # spent 36µs making 1 call to vars::import
51700ns$VERSION = '2.14';
6122µs$VERSION = eval $VERSION;
7
8# constant.pm is slow
9sub SUCCESS () { 1 }
10
11sub PUBLIC () { 2**0 }
12sub PRIVATE () { 2**1 }
13sub INHERITED () { 2**2 }
14sub PROTECTED () { 2**3 }
15
16
171700nsmy $Fattr = \%fields::attr;
18
19
# spent 192µs within base::has_fields which was called 61 times, avg 3µs/call: # 61 times (192µs+0s) by base::import at line 113, avg 3µs/call
sub has_fields {
20183252µs my($base) = shift;
21 my $fglob = ${"$base\::"}{FIELDS};
22 return( ($fglob && 'GLOB' eq ref($fglob) && *$fglob{HASH}) ? 1 : 0 );
23}
24
25
# spent 446µs within base::has_version which was called 61 times, avg 7µs/call: # 61 times (446µs+0s) by base::import at line 83, avg 7µs/call
sub has_version {
26183498µs my($base) = shift;
27 my $vglob = ${$base.'::'}{VERSION};
28 return( ($vglob && *$vglob{SCALAR}) ? 1 : 0 );
29}
30
31
# spent 145µs within base::has_attr which was called 61 times, avg 2µs/call: # 61 times (145µs+0s) by base::import at line 113, avg 2µs/call
sub has_attr {
32183178µs my($proto) = shift;
33 my($class) = ref $proto || $proto;
34 return exists $Fattr->{$class};
35}
36
37sub get_attr {
38 $Fattr->{$_[0]} = [1] unless $Fattr->{$_[0]};
39 return $Fattr->{$_[0]};
40}
41
4224µsif ($] < 5.009) {
43 *get_fields = sub {
44 # Shut up a possible typo warning.
45 () = \%{$_[0].'::FIELDS'};
46 my $f = \%{$_[0].'::FIELDS'};
47
48 # should be centralized in fields? perhaps
49 # fields::mk_FIELDS_be_OK. Peh. As long as %{ $package . '::FIELDS' }
50 # is used here anyway, it doesn't matter.
51 bless $f, 'pseudohash' if (ref($f) ne 'pseudohash');
52
53 return $f;
54 }
55}
56else {
57 *get_fields = sub {
58 # Shut up a possible typo warning.
59 () = \%{$_[0].'::FIELDS'};
60 return \%{$_[0].'::FIELDS'};
61 }
62}
63
64
# spent 33.9ms (22.4+11.5) within base::import which was called 52 times, avg 651µs/call: # once (12.0ms+2.33ms) by Class::MOP::Method::Wrapped::BEGIN@14 at line 14 of Class/MOP/Method/Wrapped.pm # once (510µs+4.46ms) by Moose::Meta::Attribute::BEGIN@20 at line 20 of Moose/Meta/Attribute.pm # once (2.04ms+1.50ms) by Sub::Name::BEGIN@50 at line 50 of Sub/Name.pm # once (693µs+2.33ms) by Class::MOP::Class::BEGIN@22 at line 22 of Class/MOP/Class.pm # once (884µs+1.74ms) by Class::MOP::Method::Accessor::BEGIN@14 at line 14 of Class/MOP/Method/Accessor.pm # once (968µs+110µs) by Moose::Meta::Method::Overridden::BEGIN@10 at line 10 of Moose/Meta/Method/Overridden.pm # once (824µs+231µs) by Class::MOP::Method::Constructor::BEGIN@14 at line 14 of Class/MOP/Method/Constructor.pm # once (738µs+93µs) by Class::MOP::Mixin::AttributeCore::BEGIN@12 at line 12 of Class/MOP/Mixin/AttributeCore.pm # once (309µs+76µs) by Class::MOP::Instance::BEGIN@13 at line 13 of Class/MOP/Instance.pm # once (69µs+24µs) by Moose::Meta::Role::Composite::BEGIN@13 at line 13 of Moose/Meta/Role/Composite.pm # once (57µs+29µs) by Exception::Class::Base::BEGIN@11 at line 11 of Exception/Class/Base.pm # once (31µs+50µs) by Moose::Meta::TypeConstraint::Parameterizable::BEGIN@11 at line 11 of Moose/Meta/TypeConstraint/Parameterizable.pm # once (53µs+24µs) by Moose::Meta::Method::Constructor::BEGIN@12 at line 12 of Moose/Meta/Method/Constructor.pm # once (65µs+10µs) by Moose::Meta::TypeCoercion::Union::BEGIN@14 at line 14 of Moose/Meta/TypeCoercion/Union.pm # once (46µs+25µs) by Moose::Meta::Method::Destructor::BEGIN@15 at line 15 of Moose/Meta/Method/Destructor.pm # once (46µs+23µs) by Class::MOP::Attribute::BEGIN@17 at line 17 of Class/MOP/Attribute.pm # once (46µs+23µs) by Moose::Meta::Role::BEGIN@23 at line 23 of Moose/Meta/Role.pm # once (45µs+23µs) by Moose::Meta::Method::Accessor::BEGIN@11 at line 11 of Moose/Meta/Method/Accessor.pm # once (43µs+24µs) by Moose::Meta::Method::Delegation::BEGIN@14 at line 14 of Moose/Meta/Method/Delegation.pm # once (46µs+18µs) by Moose::Meta::Instance::BEGIN@11 at line 11 of Moose/Meta/Instance.pm # once (45µs+13µs) by Moose::Meta::Role::Method::BEGIN@11 at line 11 of Moose/Meta/Role/Method.pm # once (39µs+16µs) by SimpleDB::Client::Exception::Response::BEGIN@3 at line 3 of (eval 0)[Exception/Class.pm:172] at line 172 of Exception/Class.pm # once (38µs+16µs) by SimpleDB::Client::Exception::BEGIN@3 at line 3 of (eval 0)[Exception/Class.pm:172] at line 172 of Exception/Class.pm # once (42µs+13µs) by Moose::Meta::TypeConstraint::Class::BEGIN@14 at line 14 of Moose/Meta/TypeConstraint/Class.pm # once (37µs+17µs) by Sub::Name::BEGIN@49 at line 49 of Sub/Name.pm # once (38µs+16µs) by SimpleDB::Client::Exception::Connection::BEGIN@3 at line 3 of (eval 0)[Exception/Class.pm:172] at line 172 of Exception/Class.pm # once (36µs+18µs) by Moose::Meta::TypeConstraint::BEGIN@14 at line 14 of Moose/Meta/TypeConstraint.pm # once (37µs+15µs) by Moose::Meta::Role::Attribute::BEGIN@13 at line 13 of Moose/Meta/Role/Attribute.pm # once (39µs+12µs) by Moose::Meta::Role::Application::ToRole::BEGIN@13 at line 13 of Moose/Meta/Role/Application/ToRole.pm # once (32µs+17µs) by Moose::Meta::Class::Immutable::Trait::BEGIN@12 at line 12 of Moose/Meta/Class/Immutable/Trait.pm # once (36µs+11µs) by Moose::Meta::TypeConstraint::DuckType::BEGIN@17 at line 17 of Moose/Meta/TypeConstraint/DuckType.pm # once (34µs+13µs) by Moose::Meta::Class::BEGIN@25 at line 25 of Moose/Meta/Class.pm # once (30µs+16µs) by Moose::Meta::TypeConstraint::Role::BEGIN@14 at line 14 of Moose/Meta/TypeConstraint/Role.pm # once (32µs+13µs) by Moose::Meta::Role::Application::ToClass::BEGIN@14 at line 14 of Moose/Meta/Role/Application/ToClass.pm # once (30µs+12µs) by Moose::Meta::Role::Application::ToInstance::BEGIN@13 at line 13 of Moose/Meta/Role/Application/ToInstance.pm # once (29µs+12µs) by Moose::Meta::TypeConstraint::Registry::BEGIN@14 at line 14 of Moose/Meta/TypeConstraint/Registry.pm # once (31µs+11µs) by Moose::Meta::Method::Augmented::BEGIN@10 at line 10 of Moose/Meta/Method/Augmented.pm # once (30µs+12µs) by Class::MOP::Mixin::HasMethods::BEGIN@14 at line 14 of Class/MOP/Mixin/HasMethods.pm # once (28µs+13µs) by Class::MOP::Mixin::HasAttributes::BEGIN@13 at line 13 of Class/MOP/Mixin/HasAttributes.pm # once (29µs+12µs) by Moose::Meta::TypeConstraint::Union::BEGIN@14 at line 14 of Moose/Meta/TypeConstraint/Union.pm # once (29µs+11µs) by Moose::Meta::Role::Method::Conflicting::BEGIN@9 at line 9 of Moose/Meta/Role/Method/Conflicting.pm # once (29µs+11µs) by Moose::Meta::Role::Application::RoleSummation::BEGIN@15 at line 15 of Moose/Meta/Role/Application/RoleSummation.pm # once (27µs+12µs) by Moose::Meta::Role::Method::Required::BEGIN@11 at line 11 of Moose/Meta/Role/Method/Required.pm # once (28µs+11µs) by Moose::Meta::TypeConstraint::Enum::BEGIN@13 at line 13 of Moose/Meta/TypeConstraint/Enum.pm # once (26µs+11µs) by Moose::Meta::TypeConstraint::Parameterized::BEGIN@15 at line 15 of Moose/Meta/TypeConstraint/Parameterized.pm # once (40µs+-40µs) by Class::MOP::Method::Inlined::BEGIN@13 at line 13 of Class/MOP/Method/Inlined.pm # once (62µs+-62µs) by Class::MOP::Method::BEGIN@14 at line 14 of Class/MOP/Method.pm # once (48µs+-48µs) by Class::MOP::Method::Generated::BEGIN@13 at line 13 of Class/MOP/Method/Generated.pm # once (71µs+-71µs) by Class::MOP::Package::BEGIN@14 at line 14 of Class/MOP/Package.pm # once (39µs+-39µs) by Moose::Meta::Method::BEGIN@10 at line 10 of Moose/Meta/Method.pm # once (35µs+-35µs) by Moose::Meta::Mixin::AttributeCore::BEGIN@9 at line 9 of Moose/Meta/Mixin/AttributeCore.pm # once (1.71ms+-1.71ms) by Class::MOP::Module::BEGIN@14 at line 14 of Class/MOP/Module.pm
sub import {
65520934µs my $class = shift;
66
67 return SUCCESS unless @_;
68
69 # List of base classes from which we will inherit %FIELDS.
70 my $fields_base;
71
72 my $inheritor = caller(0);
73 my @isa_classes;
74
75 my @bases;
76 foreach my $base (@_) {
773051.07ms if ( $inheritor eq $base ) {
78 warn "Class '$inheritor' tried to inherit from itself\n";
79 }
80
81 next if grep $_->isa($base), ($inheritor, @bases);
# spent 154µs making 70 calls to UNIVERSAL::isa, avg 2µs/call
82
839496µs61446µs if (has_version($base)) {
# spent 446µs making 61 calls to base::has_version, avg 7µs/call
84 ${$base.'::VERSION'} = '-1, set by base.pm'
85 unless defined ${$base.'::VERSION'};
86 }
87 else {
88 my $sigdie;
89 {
9055322µs local $SIG{__DIE__};
91112.0ms eval "require $base";
92 # Only ignore "Can't locate" errors from our eval require.
93 # Other fatal errors (syntax etc) must be reported.
94 die if $@ && $@ !~ /^Can't locate .*? at \(eval /;
95 unless (%{"$base\::"}) {
96 require Carp;
97 local $" = " ";
98 Carp::croak(<<ERROR);
99Base class package "$base" is empty.
100 (Perhaps you need to 'use' the module which defines that package first,
101 or make that module available in \@INC (\@INC contains: @INC).
102ERROR
103 }
104 $sigdie = $SIG{__DIE__} || undef;
105 }
106 # Make sure a global $SIG{__DIE__} makes it out of the localization.
107 $SIG{__DIE__} = $sigdie if defined $sigdie;
108 ${$base.'::VERSION'} = "-1, set by base.pm"
109 unless defined ${$base.'::VERSION'};
110 }
111 push @bases, $base;
112
113 if ( has_fields($base) || has_attr($base) ) {
# spent 192µs making 61 calls to base::has_fields, avg 3µs/call # spent 145µs making 61 calls to base::has_attr, avg 2µs/call
114 # No multiple fields inheritance *suck*
115 if ($fields_base) {
116 require Carp;
117 Carp::croak("Can't multiply inherit fields");
118 } else {
119 $fields_base = $base;
120 }
121 }
122 }
123 # Save this until the end so it's all or nothing if the above loop croaks.
124 push @{"$inheritor\::ISA"}, @isa_classes;
125
126 push @{"$inheritor\::ISA"}, @bases;
127
128 if( defined $fields_base ) {
129 inherit_fields($inheritor, $fields_base);
130 }
131}
132
133
134sub inherit_fields {
135 my($derived, $base) = @_;
136
137 return SUCCESS unless $base;
138
139 my $battr = get_attr($base);
140 my $dattr = get_attr($derived);
141 my $dfields = get_fields($derived);
142 my $bfields = get_fields($base);
143
144 $dattr->[0] = @$battr;
145
146 if( keys %$dfields ) {
147 warn <<"END";
148$derived is inheriting from $base but already has its own fields!
149This will cause problems. Be sure you use base BEFORE declaring fields.
150END
151
152 }
153
154 # Iterate through the base's fields adding all the non-private
155 # ones to the derived class. Hang on to the original attribute
156 # (Public, Private, etc...) and add Inherited.
157 # This is all too complicated to do efficiently with add_fields().
158 while (my($k,$v) = each %$bfields) {
159 my $fno;
160 if ($fno = $dfields->{$k} and $fno != $v) {
161 require Carp;
162 Carp::croak ("Inherited fields can't override existing fields");
163 }
164
165 if( $battr->[$v] & PRIVATE ) {
166 $dattr->[$v] = PRIVATE | INHERITED;
167 }
168 else {
169 $dattr->[$v] = INHERITED | $battr->[$v];
170 $dfields->{$k} = $v;
171 }
172 }
173
174 foreach my $idx (1..$#{$battr}) {
175 next if defined $dattr->[$idx];
176 $dattr->[$idx] = $battr->[$idx] & INHERITED;
177 }
178}
179
180
181142µs1;
182
183__END__
184
185=head1 NAME
186
187base - Establish an ISA relationship with base classes at compile time
188
189=head1 SYNOPSIS
190
191 package Baz;
192 use base qw(Foo Bar);
193
194=head1 DESCRIPTION
195
196Unless you are using the C<fields> pragma, consider this module discouraged
197in favor of the lighter-weight C<parent>.
198
199Allows you to both load one or more modules, while setting up inheritance from
200those modules at the same time. Roughly similar in effect to
201
202 package Baz;
203 BEGIN {
204 require Foo;
205 require Bar;
206 push @ISA, qw(Foo Bar);
207 }
208
209C<base> employs some heuristics to determine if a module has already been
210loaded, if it has it doesn't try again. If C<base> tries to C<require> the
211module it will not die if it cannot find the module's file, but will die on any
212other error. After all this, should your base class be empty, containing no
213symbols, it will die. This is useful for inheriting from classes in the same
214file as yourself, like so:
215
216 package Foo;
217 sub exclaim { "I can have such a thing?!" }
218
219 package Bar;
220 use base "Foo";
221
222If $VERSION is not detected even after loading it, <base> will define $VERSION
223in the base package, setting it to the string C<-1, set by base.pm>.
224
225C<base> will also initialize the fields if one of the base classes has it.
226Multiple inheritance of fields is B<NOT> supported, if two or more base classes
227each have inheritable fields the 'base' pragma will croak. See L<fields>,
228L<public> and L<protected> for a description of this feature.
229
230The base class' C<import> method is B<not> called.
231
232
233=head1 DIAGNOSTICS
234
235=over 4
236
237=item Base class package "%s" is empty.
238
239base.pm was unable to require the base package, because it was not
240found in your path.
241
242=item Class 'Foo' tried to inherit from itself
243
244Attempting to inherit from yourself generates a warning.
245
246 use Foo;
247 use base 'Foo';
248
249=back
250
251=head1 HISTORY
252
253This module was introduced with Perl 5.004_04.
254
255=head1 CAVEATS
256
257Due to the limitations of the implementation, you must use
258base I<before> you declare any of your own fields.
259
260
261=head1 SEE ALSO
262
263L<fields>
264
265=cut