← Index
Performance Profile   « block view • line view • sub view »
For t/test-parsing
  Run on Sun Nov 14 09:49:57 2010
Reported on Sun Nov 14 09:50:11 2010

File /usr/share/perl/5.10/base.pm
Statements Executed 1846
Total Time 0.0088665 seconds
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
62626135.9ms51.8msbase::::importbase::import
7311908µs908µsbase::::has_versionbase::has_version
7311618µs618µsbase::::has_fieldsbase::has_fields
7311432µs432µsbase::::has_attrbase::has_attr
0000s0sbase::::BEGINbase::BEGIN
0000s0sbase::::__ANON__[:52]base::__ANON__[:52]
0000s0sbase::::__ANON__[:59]base::__ANON__[:59]
0000s0sbase::::get_attrbase::get_attr
0000s0sbase::::inherit_fieldsbase::inherit_fields
LineStmts.Exclusive
Time
Avg.Code
1package base;
2
3324µs8µsuse strict 'vars';
# spent 17µs making 1 call to strict::import
431.24ms412µsuse vars qw($VERSION);
# spent 29µs making 1 call to vars::import
51800ns800ns$VERSION = '2.13';
6
7# constant.pm is slow
8sub SUCCESS () { 1 }
9
10sub PUBLIC () { 2**0 }
11sub PRIVATE () { 2**1 }
12sub INHERITED () { 2**2 }
13sub PROTECTED () { 2**3 }
14
1516µs6µsmy $Fattr = \%fields::attr;
16
17
# spent 618µs within base::has_fields which was called 73 times, avg 8µs/call: # 73 times (618µs+0s) by base::import at line 111, avg 8µs/call
sub has_fields {
1873111µs2µs my($base) = shift;
1973150µs2µs my $fglob = ${"$base\::"}{FIELDS};
2073128µs2µs return( ($fglob && 'GLOB' eq ref($fglob) && *$fglob{HASH}) ? 1 : 0 );
21}
22
23
# spent 908µs within base::has_version which was called 73 times, avg 12µs/call: # 73 times (908µs+0s) by base::import at line 81, avg 12µs/call
sub has_version {
2473139µs2µs my($base) = shift;
2573334µs5µs my $vglob = ${$base.'::'}{VERSION};
2673252µs3µs return( ($vglob && *$vglob{SCALAR}) ? 1 : 0 );
27}
28
29
# spent 432µs within base::has_attr which was called 73 times, avg 6µs/call: # 73 times (432µs+0s) by base::import at line 111, avg 6µs/call
sub has_attr {
307389µs1µs my($proto) = shift;
317359µs807ns my($class) = ref $proto || $proto;
3273118µs2µs return exists $Fattr->{$class};
33}
34
35sub get_attr {
36 $Fattr->{$_[0]} = [1] unless $Fattr->{$_[0]};
37 return $Fattr->{$_[0]};
38}
39
4015µs5µsif ($] < 5.009) {
41 *get_fields = sub {
42 # Shut up a possible typo warning.
43 () = \%{$_[0].'::FIELDS'};
44 my $f = \%{$_[0].'::FIELDS'};
45
46 # should be centralized in fields? perhaps
47 # fields::mk_FIELDS_be_OK. Peh. As long as %{ $package . '::FIELDS' }
48 # is used here anyway, it doesn't matter.
49 bless $f, 'pseudohash' if (ref($f) ne 'pseudohash');
50
51 return $f;
52 }
53}
54else {
55 *get_fields = sub {
56 # Shut up a possible typo warning.
57 () = \%{$_[0].'::FIELDS'};
58 return \%{$_[0].'::FIELDS'};
59 }
6017µs7µs}
61
62
# spent 51.8ms (35.9+16.0) within base::import which was called 62 times, avg 836µs/call: # once (20.8ms+85µs) at line 14 of /usr/share/perl5/MARC/File/SAX.pm # once (679µs+9.05ms) by Moose::Meta::Attribute::BEGIN at line 22 of /usr/local/lib/perl/5.10.0/Moose/Meta/Attribute.pm # once (736µs+3.64ms) at line 24 of /usr/local/lib/perl/5.10.0/Class/MOP/Class.pm # once (511µs+3.63ms) by Moose::Meta::Method::Overridden::BEGIN at line 10 of /usr/local/lib/perl/5.10.0/Moose/Meta/Method/Overridden.pm # once (1.05ms+1.10ms) by Class::MOP::Method::Meta::BEGIN at line 16 of /usr/local/lib/perl/5.10.0/Class/MOP/Method/Meta.pm # once (1.66ms+69µs) at line 5 of /usr/share/perl5/MARC/Charset/Code.pm # once (1.10ms+82µs) at line 6 of /usr/share/perl5/MARC/File/XML.pm # once (985µs+191µs) by Class::MOP::Method::Accessor::BEGIN at line 14 of /usr/local/lib/perl/5.10.0/Class/MOP/Method/Accessor.pm # once (824µs+243µs) by Class::MOP::Method::Constructor::BEGIN at line 14 of /usr/local/lib/perl/5.10.0/Class/MOP/Method/Constructor.pm # once (953µs+52µs) at line 3 of /usr/share/perl5/YAML/Base.pm # once (330µs+96µs) by Class::MOP::Mixin::AttributeCore::BEGIN at line 12 of /usr/local/lib/perl/5.10.0/Class/MOP/Mixin/AttributeCore.pm # once (87µs+108µs) at line 25 of /usr/local/lib/perl/5.10.0/Moose/Meta/Role.pm # once (90µs+66µs) by Moose::Meta::Method::Constructor::BEGIN at line 12 of /usr/local/lib/perl/5.10.0/Moose/Meta/Method/Constructor.pm # once (57µs+96µs) by Moose::Meta::Method::Meta::BEGIN at line 11 of /usr/local/lib/perl/5.10.0/Moose/Meta/Method/Meta.pm # once (75µs+67µs) by Moose::Meta::Method::Delegation::BEGIN at line 14 of /usr/local/lib/perl/5.10.0/Moose/Meta/Method/Delegation.pm # once (74µs+66µs) by Moose::Meta::Method::Destructor::BEGIN at line 15 of /usr/local/lib/perl/5.10.0/Moose/Meta/Method/Destructor.pm # once (67µs+67µs) by Moose::Meta::Method::Accessor::BEGIN at line 11 of /usr/local/lib/perl/5.10.0/Moose/Meta/Method/Accessor.pm # once (64µs+67µs) by Class::MOP::Attribute::BEGIN at line 17 of /usr/local/lib/perl/5.10.0/Class/MOP/Attribute.pm # once (82µs+29µs) by Moose::Meta::TypeCoercion::Union::BEGIN at line 14 of /usr/local/lib/perl/5.10.0/Moose/Meta/TypeCoercion/Union.pm # once (82µs+26µs) at line 4 of /usr/share/perl5/YAML.pm # once (60µs+28µs) by Moose::Meta::Class::BEGIN at line 29 of /usr/local/lib/perl/5.10.0/Moose/Meta/Class.pm # once (58µs+30µs) by Moose::Meta::TypeConstraint::Parameterized::BEGIN at line 15 of /usr/local/lib/perl/5.10.0/Moose/Meta/TypeConstraint/Parameterized.pm # once (48µs+40µs) by Moose::Meta::TypeConstraint::Union::BEGIN at line 16 of /usr/local/lib/perl/5.10.0/Moose/Meta/TypeConstraint/Union.pm # once (50µs+37µs) by Class::MOP::Method::Wrapped::BEGIN at line 14 of /usr/local/lib/perl/5.10.0/Class/MOP/Method/Wrapped.pm # once (49µs+35µs) by Moose::Meta::Class::Immutable::Trait::BEGIN at line 13 of /usr/local/lib/perl/5.10.0/Moose/Meta/Class/Immutable/Trait.pm # once (49µs+35µs) by Moose::Meta::TypeConstraint::Enum::BEGIN at line 13 of /usr/local/lib/perl/5.10.0/Moose/Meta/TypeConstraint/Enum.pm # once (52µs+31µs) by Moose::Meta::Role::Method::Conflicting::BEGIN at line 9 of /usr/local/lib/perl/5.10.0/Moose/Meta/Role/Method/Conflicting.pm # once (48µs+35µs) by Variable::Magic::BEGIN at line 546 of /usr/local/lib/perl/5.10.0/Variable/Magic.pm # once (44µs+37µs) by Moose::Meta::Role::Method::Required::BEGIN at line 11 of /usr/local/lib/perl/5.10.0/Moose/Meta/Role/Method/Required.pm # once (47µs+34µs) by Moose::Meta::Role::Attribute::BEGIN at line 13 of /usr/local/lib/perl/5.10.0/Moose/Meta/Role/Attribute.pm # once (45µs+35µs) by Moose::Meta::Instance::BEGIN at line 13 of /usr/local/lib/perl/5.10.0/Moose/Meta/Instance.pm # once (49µs+31µs) by Moose::Meta::Role::Composite::BEGIN at line 13 of /usr/local/lib/perl/5.10.0/Moose/Meta/Role/Composite.pm # once (48µs+30µs) by Moose::Meta::TypeConstraint::Role::BEGIN at line 14 of /usr/local/lib/perl/5.10.0/Moose/Meta/TypeConstraint/Role.pm # once (48µs+29µs) by Class::MOP::Instance::BEGIN at line 13 of /usr/local/lib/perl/5.10.0/Class/MOP/Instance.pm # once (41µs+36µs) by Moose::Error::Default::BEGIN at line 13 of /usr/local/lib/perl/5.10.0/Moose/Error/Default.pm # once (49µs+28µs) by Moose::Meta::TypeConstraint::Class::BEGIN at line 14 of /usr/local/lib/perl/5.10.0/Moose/Meta/TypeConstraint/Class.pm # once (43µs+34µs) by Moose::Meta::Method::Augmented::BEGIN at line 10 of /usr/local/lib/perl/5.10.0/Moose/Meta/Method/Augmented.pm # once (44µs+32µs) by Moose::Meta::TypeConstraint::DuckType::BEGIN at line 17 of /usr/local/lib/perl/5.10.0/Moose/Meta/TypeConstraint/DuckType.pm # once (46µs+31µs) at line 11 of /usr/local/lib/perl/5.10.0/Moose/Meta/TypeConstraint/Parameterizable.pm # once (47µs+28µs) by Moose::Meta::Role::Application::RoleSummation::BEGIN at line 15 of /usr/local/lib/perl/5.10.0/Moose/Meta/Role/Application/RoleSummation.pm # once (46µs+29µs) by Moose::Meta::Role::Method::BEGIN at line 11 of /usr/local/lib/perl/5.10.0/Moose/Meta/Role/Method.pm # once (43µs+31µs) at line 7 of /usr/share/perl5/MARC/Charset.pm # once (42µs+31µs) by Moose::Meta::TypeConstraint::Registry::BEGIN at line 14 of /usr/local/lib/perl/5.10.0/Moose/Meta/TypeConstraint/Registry.pm # once (48µs+25µs) by Moose::Meta::Role::Application::ToInstance::BEGIN at line 13 of /usr/local/lib/perl/5.10.0/Moose/Meta/Role/Application/ToInstance.pm # once (45µs+28µs) at line 3 of /usr/share/perl5/YAML/Node.pm # once (38µs+33µs) by Moose::Meta::TypeConstraint::BEGIN at line 16 of /usr/local/lib/perl/5.10.0/Moose/Meta/TypeConstraint.pm # once (42µs+29µs) by Class::MOP::Mixin::HasAttributes::BEGIN at line 13 of /usr/local/lib/perl/5.10.0/Class/MOP/Mixin/HasAttributes.pm # once (41µs+30µs) at line 13 of /usr/local/lib/perl/5.10.0/Encode.pm # once (43µs+27µs) at line 20 of /usr/share/perl5/MARC/Charset/Constants.pm # once (39µs+29µs) by Class::MOP::Mixin::HasMethods::BEGIN at line 16 of /usr/local/lib/perl/5.10.0/Class/MOP/Mixin/HasMethods.pm # once (32µs+36µs) by Sub::Name::BEGIN at line 50 of /usr/local/lib/perl/5.10.0/Sub/Name.pm # once (42µs+24µs) by Encode::Alias::BEGIN at line 8 of /usr/local/lib/perl/5.10.0/Encode/Alias.pm # once (31µs+34µs) at line 49 of /usr/local/lib/perl/5.10.0/Sub/Name.pm # once (36µs+28µs) by Moose::Meta::Role::Application::ToClass::BEGIN at line 14 of /usr/local/lib/perl/5.10.0/Moose/Meta/Role/Application/ToClass.pm # once (36µs+27µs) by Moose::Meta::Role::Application::ToRole::BEGIN at line 13 of /usr/local/lib/perl/5.10.0/Moose/Meta/Role/Application/ToRole.pm # once (43µs+-43µs) by Class::MOP::Method::Inlined::BEGIN at line 13 of /usr/local/lib/perl/5.10.0/Class/MOP/Method/Inlined.pm # once (45µs+-45µs) by Moose::Meta::Method::BEGIN at line 12 of /usr/local/lib/perl/5.10.0/Moose/Meta/Method.pm # once (2.93ms+-2.93ms) at line 14 of /usr/local/lib/perl/5.10.0/Class/MOP/Module.pm # once (51µs+-51µs) by Class::MOP::Method::Generated::BEGIN at line 13 of /usr/local/lib/perl/5.10.0/Class/MOP/Method/Generated.pm # once (765µs+-765µs) at line 14 of /usr/local/lib/perl/5.10.0/Class/MOP/Method.pm # once (46µs+-46µs) by Moose::Meta::Mixin::AttributeCore::BEGIN at line 9 of /usr/local/lib/perl/5.10.0/Moose/Meta/Mixin/AttributeCore.pm # once (50µs+-50µs) at line 15 of /usr/local/lib/perl/5.10.0/Class/MOP/Package.pm
sub import {
636247µs756ns my $class = shift;
64
656226µs413ns return SUCCESS unless @_;
66
67 # List of base classes from which we will inherit %FIELDS.
686216µs263ns my $fields_base;
69
706267µs1µs my $inheritor = caller(0);
716219µs303ns my @isa_classes;
72
736218µs284ns my @bases;
746293µs2µs foreach my $base (@_) {
757341µs555ns if ( $inheritor eq $base ) {
76 warn "Class '$inheritor' tried to inherit from itself\n";
77 }
78
79731.07ms15µs next if grep $_->isa($base), ($inheritor, @bases);
# spent 446µs making 86 calls to UNIVERSAL::isa, avg 5µs/call
80
8173296µs4µs if (has_version($base)) {
# spent 908µs making 73 calls to base::has_version, avg 12µs/call
82 ${$base.'::VERSION'} = '-1, set by base.pm'
8358122µs2µs unless defined ${$base.'::VERSION'};
84 }
85 else {
86156µs407ns my $sigdie;
87 {
883085µs3µs local $SIG{__DIE__};
89152.23ms148µs eval "require $base";
90 # Only ignore "Can't locate" errors from our eval require.
91 # Other fatal errors (syntax etc) must be reported.
921515µs1µs die if $@ && $@ !~ /^Can't locate .*? at \(eval /;
931553µs4µs unless (%{"$base\::"}) {
94 require Carp;
95 local $" = " ";
96 Carp::croak(<<ERROR);
97Base class package "$base" is empty.
98 (Perhaps you need to 'use' the module which defines that package first,
99 or make that module available in \@INC (\@INC contains: @INC).
100ERROR
101 }
1021561µs4µs $sigdie = $SIG{__DIE__} || undef;
103 }
104 # Make sure a global $SIG{__DIE__} makes it out of the localization.
105158µs553ns $SIG{__DIE__} = $sigdie if defined $sigdie;
106 ${$base.'::VERSION'} = "-1, set by base.pm"
1071551µs3µs unless defined ${$base.'::VERSION'};
108 }
1097391µs1µs push @bases, $base;
110
11173627µs9µs if ( has_fields($base) || has_attr($base) ) {
# spent 618µs making 73 calls to base::has_fields, avg 8µs/call # spent 432µs making 73 calls to base::has_attr, avg 6µs/call
112 # No multiple fields inheritance *suck*
113 if ($fields_base) {
114 require Carp;
115 Carp::croak("Can't multiply inherit fields");
116 } else {
117 $fields_base = $base;
118 }
119 }
120 }
121 # Save this until the end so it's all or nothing if the above loop croaks.
12262276µs4µs push @{"$inheritor\::ISA"}, @isa_classes;
123
12462761µs12µs push @{"$inheritor\::ISA"}, @bases;
125
12662130µs2µs if( defined $fields_base ) {
127 inherit_fields($inheritor, $fields_base);
128 }
129}
130
131sub inherit_fields {
132 my($derived, $base) = @_;
133
134 return SUCCESS unless $base;
135
136 my $battr = get_attr($base);
137 my $dattr = get_attr($derived);
138 my $dfields = get_fields($derived);
139 my $bfields = get_fields($base);
140
141 $dattr->[0] = @$battr;
142
143 if( keys %$dfields ) {
144 warn <<"END";
145$derived is inheriting from $base but already has its own fields!
146This will cause problems. Be sure you use base BEFORE declaring fields.
147END
148
149 }
150
151 # Iterate through the base's fields adding all the non-private
152 # ones to the derived class. Hang on to the original attribute
153 # (Public, Private, etc...) and add Inherited.
154 # This is all too complicated to do efficiently with add_fields().
155 while (my($k,$v) = each %$bfields) {
156 my $fno;
157 if ($fno = $dfields->{$k} and $fno != $v) {
158 require Carp;
159 Carp::croak ("Inherited fields can't override existing fields");
160 }
161
162 if( $battr->[$v] & PRIVATE ) {
163 $dattr->[$v] = PRIVATE | INHERITED;
164 }
165 else {
166 $dattr->[$v] = INHERITED | $battr->[$v];
167 $dfields->{$k} = $v;
168 }
169 }
170
171 foreach my $idx (1..$#{$battr}) {
172 next if defined $dattr->[$idx];
173 $dattr->[$idx] = $battr->[$idx] & INHERITED;
174 }
175}
176
17716µs6µs1;
178
179__END__
180