← Index
NYTProf Performance Profile   « block view • line view • sub view »
For 05.Domain_and_Item.t
  Run on Tue May 4 17:21:41 2010
Reported on Tue May 4 17:23:22 2010

File /usr/local/lib/perl5/5.10.1/base.pm
Statements Executed 2274
Statement Execution Time 6.39ms
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
79797213.2ms22.8msbase::::importbase::import
8811512µs512µsbase::::has_versionbase::has_version
8811250µs250µsbase::::has_fieldsbase::has_fields
8811197µs197µsbase::::has_attrbase::has_attr
11114µs34µsbase::::BEGIN@3base::BEGIN@3
1118µs47µ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µs254µs
# spent 34µs (14+20) within base::BEGIN@3 which was called # once (14µs+20µs) by Class::MOP::Mixin::AttributeCore::BEGIN@12 at line 3
use strict 'vars';
# spent 34µs making 1 call to base::BEGIN@3 # spent 20µs making 1 call to strict::import
43811µs286µs
# spent 47µs (8+39) within base::BEGIN@4 which was called # once (8µs+39µs) by Class::MOP::Mixin::AttributeCore::BEGIN@12 at line 4
use vars qw($VERSION);
# spent 47µs making 1 call to base::BEGIN@4 # spent 39µs making 1 call to vars::import
51800ns$VERSION = '2.14';
6124µ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
171800nsmy $Fattr = \%fields::attr;
18
19
# spent 250µs within base::has_fields which was called 88 times, avg 3µs/call: # 88 times (250µs+0s) by base::import at line 113, avg 3µs/call
sub has_fields {
208839µs my($base) = shift;
218880µs my $fglob = ${"$base\::"}{FIELDS};
2288209µs return( ($fglob && 'GLOB' eq ref($fglob) && *$fglob{HASH}) ? 1 : 0 );
23}
24
25
# spent 512µs within base::has_version which was called 88 times, avg 6µs/call: # 88 times (512µs+0s) by base::import at line 83, avg 6µs/call
sub has_version {
268850µs my($base) = shift;
2788189µs my $vglob = ${$base.'::'}{VERSION};
2888330µs return( ($vglob && *$vglob{SCALAR}) ? 1 : 0 );
29}
30
31
# spent 197µs within base::has_attr which was called 88 times, avg 2µs/call: # 88 times (197µs+0s) by base::import at line 113, avg 2µs/call
sub has_attr {
328831µs my($proto) = shift;
338834µs my($class) = ref $proto || $proto;
3488168µ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 }
6213µs}
63
64
# spent 22.8ms (13.2+9.58) within base::import which was called 79 times, avg 288µs/call: # once (492µs+4.50ms) by Moose::Meta::Attribute::BEGIN@20 at line 20 of Moose/Meta/Attribute.pm # once (2.03ms+1.71ms) by Sub::Name::BEGIN@50 at line 50 of Sub/Name.pm # once (1.46ms+1.89ms) by DateTime::Locale::en_US::BEGIN@25 at line 25 of DateTime/Locale/en_US.pm # once (536µs+1.72ms) by Class::MOP::Class::BEGIN@22 at line 22 of Class/MOP/Class.pm # once (590µs+1.04ms) by Class::MOP::Method::Accessor::BEGIN@14 at line 14 of Class/MOP/Method/Accessor.pm # once (473µs+517µs) by DateTime::TimeZone::Floating::BEGIN@9 at line 9 of DateTime/TimeZone/Floating.pm # once (651µs+202µs) by Class::MOP::Method::Wrapped::BEGIN@14 at line 14 of Class/MOP/Method/Wrapped.pm # once (569µs+183µs) by Class::MOP::Method::Constructor::BEGIN@14 at line 14 of Class/MOP/Method/Constructor.pm # once (372µs+109µs) by Moose::Meta::Method::Overridden::BEGIN@10 at line 10 of Moose/Meta/Method/Overridden.pm # once (317µs+119µs) by Class::MOP::Mixin::AttributeCore::BEGIN@12 at line 12 of Class/MOP/Mixin/AttributeCore.pm # once (301µs+78µs) by Class::MOP::Instance::BEGIN@13 at line 13 of Class/MOP/Instance.pm # once (94µs+22µs) by Test::Deep::SuperHash::BEGIN@60 at line 60 of Test/Deep/Hash.pm # once (74µs+14µs) by Test::Deep::SuperHashKeys::BEGIN@42 at line 42 of Test/Deep/HashKeys.pm # once (76µs+12µs) by Test::Deep::SuperHashKeysOnly::BEGIN@100 at line 100 of Test/Deep/HashKeysOnly.pm # once (57µs+24µs) by Moose::Meta::Method::Constructor::BEGIN@12 at line 12 of Moose/Meta/Method/Constructor.pm # once (65µs+12µs) by Test::Deep::SuperHashElements::BEGIN@70 at line 70 of Test/Deep/HashElements.pm # once (63µs+10µs) by Moose::Meta::TypeCoercion::Union::BEGIN@14 at line 14 of Moose/Meta/TypeCoercion/Union.pm # once (47µs+24µs) by Moose::Meta::Method::Accessor::BEGIN@11 at line 11 of Moose/Meta/Method/Accessor.pm # once (46µs+24µ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 (46µs+22µs) by Moose::Meta::Role::BEGIN@23 at line 23 of Moose/Meta/Role.pm # once (41µs+27µs) by Class::MOP::Attribute::BEGIN@17 at line 17 of Class/MOP/Attribute.pm # once (43µs+23µs) by Moose::Meta::Method::Destructor::BEGIN@15 at line 15 of Moose/Meta/Method/Destructor.pm # once (42µs+23µs) by Moose::Meta::Method::Delegation::BEGIN@14 at line 14 of Moose/Meta/Method/Delegation.pm # once (40µs+20µs) by Exception::Class::Base::BEGIN@11 at line 11 of Exception/Class/Base.pm # once (39µs+19µs) by MooseX::Types::Util::BEGIN@13 at line 13 of MooseX/Types/Util.pm # once (37µs+18µs) by JSON::BEGIN@6 at line 6 of JSON.pm # once (39µs+16µs) by Test::Deep::SubHash::BEGIN@83 at line 83 of Test/Deep/Hash.pm # once (39µs+14µs) by Moose::Meta::Role::Composite::BEGIN@13 at line 13 of Moose/Meta/Role/Composite.pm # once (41µs+11µs) by Moose::Meta::Role::Method::BEGIN@11 at line 11 of Moose/Meta/Role/Method.pm # once (37µs+15µs) by Test::Deep::SubHashKeys::BEGIN@56 at line 56 of Test/Deep/HashKeys.pm # once (34µs+16µs) by DateTime::Infinite::BEGIN@11 at line 11 of DateTime/Infinite.pm # once (38µs+11µs) by SimpleDB::Class::Exception::ObjectNotFound::BEGIN@3 at line 3 of (eval 0)[Exception/Class.pm:172] at line 172 of Exception/Class.pm # once (36µs+13µs) by Class::MOP::Mixin::HasAttributes::BEGIN@13 at line 13 of Class/MOP/Mixin/HasAttributes.pm # once (34µs+12µs) by Moose::Meta::TypeConstraint::Registry::BEGIN@14 at line 14 of Moose/Meta/TypeConstraint/Registry.pm # once (35µs+12µs) by Moose::Meta::Role::Application::RoleSummation::BEGIN@15 at line 15 of Moose/Meta/Role/Application/RoleSummation.pm # once (33µs+13µs) by Moose::Meta::Instance::BEGIN@11 at line 11 of Moose/Meta/Instance.pm # once (35µs+11µ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 (33µs+13µs) by Moose::Meta::Class::BEGIN@25 at line 25 of Moose/Meta/Class.pm # once (32µs+13µs) by Test::Deep::SubHashKeysOnly::BEGIN@114 at line 114 of Test/Deep/HashKeysOnly.pm # once (32µs+13µs) by Test::Deep::SubHashElements::BEGIN@83 at line 83 of Test/Deep/HashElements.pm # once (29µs+16µs) by Moose::Meta::Class::Immutable::Trait::BEGIN@12 at line 12 of Moose/Meta/Class/Immutable/Trait.pm # once (31µs+12µs) by Moose::Meta::Role::Application::ToClass::BEGIN@14 at line 14 of Moose/Meta/Role/Application/ToClass.pm # once (32µs+11µs) by Variable::Magic::BEGIN@560 at line 560 of Variable/Magic.pm # once (30µs+13µs) by Class::MOP::Mixin::HasMethods::BEGIN@14 at line 14 of Class/MOP/Mixin/HasMethods.pm # once (30µs+12µs) by Moose::Meta::Role::Attribute::BEGIN@13 at line 13 of Moose/Meta/Role/Attribute.pm # once (31µs+11µs) by Moose::Meta::TypeConstraint::Role::BEGIN@14 at line 14 of Moose/Meta/TypeConstraint/Role.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 (28µs+13µs) by Moose::Meta::Role::Method::Required::BEGIN@11 at line 11 of Moose/Meta/Role/Method/Required.pm # once (31µs+11µs) by Moose::Meta::Method::Augmented::BEGIN@10 at line 10 of Moose/Meta/Method/Augmented.pm # once (29µs+12µ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::TypeConstraint::Union::BEGIN@14 at line 14 of Moose/Meta/TypeConstraint/Union.pm # once (28µs+12µs) by Moose::Meta::Role::Application::ToRole::BEGIN@13 at line 13 of Moose/Meta/Role/Application/ToRole.pm # once (29µs+11µs) by SimpleDB::Class::Exception::BEGIN@3 at line 3 of (eval 0)[Exception/Class.pm:172] at line 172 of Exception/Class.pm # once (29µs+11µs) by Moose::Meta::TypeConstraint::Class::BEGIN@14 at line 14 of Moose/Meta/TypeConstraint/Class.pm # once (29µs+11µs) by Moose::Meta::TypeConstraint::Parameterizable::BEGIN@11 at line 11 of Moose/Meta/TypeConstraint/Parameterizable.pm # once (28µs+11µs) by SimpleDB::Class::Exception::InvalidObject::BEGIN@3 at line 3 of (eval 0)[Exception/Class.pm:172] at line 172 of Exception/Class.pm # once (28µs+11µs) by Moose::Meta::TypeConstraint::DuckType::BEGIN@17 at line 17 of Moose/Meta/TypeConstraint/DuckType.pm # once (27µs+12µs) by Sub::Name::BEGIN@49 at line 49 of Sub/Name.pm # once (26µs+13µs) by Moose::Meta::TypeConstraint::BEGIN@14 at line 14 of Moose/Meta/TypeConstraint.pm # once (28µs+11µ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 (28µs+11µs) by Moose::Meta::TypeConstraint::Enum::BEGIN@13 at line 13 of Moose/Meta/TypeConstraint/Enum.pm # once (28µs+10µs) by DateTime::Infinite::Future::BEGIN@42 at line 42 of DateTime/Infinite.pm # once (27µs+12µs) by Memcached::libmemcached::BEGIN@19 at line 19 of Memcached/libmemcached.pm # once (27µs+11µs) by SimpleDB::Class::Exception::Connection::BEGIN@3 at line 3 of (eval 0)[Exception/Class.pm:172] at line 172 of Exception/Class.pm # once (27µs+10µs) by SimpleDB::Class::Exception::InvalidParam::BEGIN@3 at line 3 of (eval 0)[Exception/Class.pm:172] at line 172 of Exception/Class.pm # once (26µs+11µs) by Moose::Meta::TypeConstraint::Parameterized::BEGIN@15 at line 15 of Moose/Meta/TypeConstraint/Parameterized.pm # once (26µs+10µs) by DateTime::Infinite::Past::BEGIN@63 at line 63 of DateTime/Infinite.pm # once (26µs+10µs) by Memcached::libmemcached::API::BEGIN@23 at line 23 of Memcached/libmemcached/API.pm # once (1.25ms+-1.25ms) by Class::MOP::Module::BEGIN@14 at line 14 of Class/MOP/Module.pm # once (58µs+-58µs) by DateTime::Locale::root::BEGIN@25 at line 25 of DateTime/Locale/root.pm # once (1.70ms+-1.70ms) by DateTime::Locale::en::BEGIN@25 at line 25 of DateTime/Locale/en.pm # once (36µs+-36µs) by DateTime::TimeZone::OffsetOnly::BEGIN@9 at line 9 of DateTime/TimeZone/OffsetOnly.pm # once (28µs+-28µs) by Class::MOP::Method::BEGIN@14 at line 14 of Class/MOP/Method.pm # once (26µs+-26µs) by DateTime::TimeZone::UTC::BEGIN@9 at line 9 of DateTime/TimeZone/UTC.pm # once (55µs+-55µs) by Class::MOP::Package::BEGIN@14 at line 14 of Class/MOP/Package.pm # once (36µs+-36µs) by Class::MOP::Method::Inlined::BEGIN@13 at line 13 of Class/MOP/Method/Inlined.pm # once (29µs+-29µs) by Class::MOP::Method::Generated::BEGIN@13 at line 13 of Class/MOP/Method/Generated.pm # once (34µs+-34µs) by Moose::Meta::Mixin::AttributeCore::BEGIN@9 at line 9 of Moose/Meta/Mixin/AttributeCore.pm # once (36µs+-36µs) by Moose::Meta::Method::BEGIN@10 at line 10 of Moose/Meta/Method.pm
sub import {
657943µs my $class = shift;
66
677913µs return SUCCESS unless @_;
68
69 # List of base classes from which we will inherit %FIELDS.
70798µs my $fields_base;
71
727930µs my $inheritor = caller(0);
73799µs my @isa_classes;
74
757910µs my @bases;
767961µs foreach my $base (@_) {
778826µs if ( $inheritor eq $base ) {
78 warn "Class '$inheritor' tried to inherit from itself\n";
79 }
80
8188926µs97190µs next if grep $_->isa($base), ($inheritor, @bases);
# spent 190µs making 97 calls to UNIVERSAL::isa, avg 2µs/call
82
8388128µs88512µs if (has_version($base)) {
# spent 512µs making 88 calls to base::has_version, avg 6µs/call
84 ${$base.'::VERSION'} = '-1, set by base.pm'
856978µs unless defined ${$base.'::VERSION'};
86 }
87 else {
88193µs my $sigdie;
89 {
903857µs local $SIG{__DIE__};
91191.48ms eval "require $base";
92 # Only ignore "Can't locate" errors from our eval require.
93 # Other fatal errors (syntax etc) must be reported.
94197µs die if $@ && $@ !~ /^Can't locate .*? at \(eval /;
951950µ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 }
1041947µs $sigdie = $SIG{__DIE__} || undef;
105 }
106 # Make sure a global $SIG{__DIE__} makes it out of the localization.
107195µs $SIG{__DIE__} = $sigdie if defined $sigdie;
108 ${$base.'::VERSION'} = "-1, set by base.pm"
1091943µs unless defined ${$base.'::VERSION'};
110 }
1118855µs push @bases, $base;
112
11388259µs176447µs if ( has_fields($base) || has_attr($base) ) {
# spent 250µs making 88 calls to base::has_fields, avg 3µs/call # spent 197µs making 88 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.
12479199µs push @{"$inheritor\::ISA"}, @isa_classes;
125
12679528µs push @{"$inheritor\::ISA"}, @bases;
127
12879312µ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
181112µ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