← 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:22 2010

File /usr/local/lib/perl5/5.10.1/base.pm
Statements Executed 1535
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 {
206130µs my($base) = shift;
216161µs my $fglob = ${"$base\::"}{FIELDS};
2261161µs 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 {
266141µs my($base) = shift;
2761157µs my $vglob = ${$base.'::'}{VERSION};
2861300µs 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 {
326123µs my($proto) = shift;
336124µs my($class) = ref $proto || $proto;
3461130µs return exists $Fattr->{$class};
35}
36
37sub get_attr {
38 $Fattr->{$_[0]} = [1] unless $Fattr->{$_[0]};
39 return $Fattr->{$_[0]};
40}
41
4211µ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 }
6212µs}
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 {
655232µs my $class = shift;
66
675214µs return SUCCESS unless @_;
68
69 # List of base classes from which we will inherit %FIELDS.
70523µs my $fields_base;
71
725224µs my $inheritor = caller(0);
73527µs my @isa_classes;
74
75523µs my @bases;
765244µs foreach my $base (@_) {
776117µs if ( $inheritor eq $base ) {
78 warn "Class '$inheritor' tried to inherit from itself\n";
79 }
80
8161710µs70154µs next if grep $_->isa($base), ($inheritor, @bases);
# spent 154µs making 70 calls to UNIVERSAL::isa, avg 2µs/call
82
8361103µ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'
855062µs unless defined ${$base.'::VERSION'};
86 }
87 else {
88112µs my $sigdie;
89 {
902239µs local $SIG{__DIE__};
911112.2ms eval "require $base";
92 # Only ignore "Can't locate" errors from our eval require.
93 # Other fatal errors (syntax etc) must be reported.
94114µs die if $@ && $@ !~ /^Can't locate .*? at \(eval /;
951135µs 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 }
1041134µs $sigdie = $SIG{__DIE__} || undef;
105 }
106 # Make sure a global $SIG{__DIE__} makes it out of the localization.
107114µs $SIG{__DIE__} = $sigdie if defined $sigdie;
108 ${$base.'::VERSION'} = "-1, set by base.pm"
1091119µs unless defined ${$base.'::VERSION'};
110 }
1116146µs push @bases, $base;
112
11361192µs122337µs 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.
12452168µs push @{"$inheritor\::ISA"}, @isa_classes;
125
12652410µs push @{"$inheritor\::ISA"}, @bases;
127
12852229µs 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