← Index
NYTProf Performance Profile   « block view • line view • sub view »
For conv.pl
  Run on Sun Nov 14 21:14:18 2010
Reported on Sun Nov 14 21:17:51 2010

Filename/usr/share/perl/5.10/base.pm
StatementsExecuted 261 statements in 2.49ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
99926.9ms27.7msbase::::importbase::import
911138µs138µsbase::::has_versionbase::has_version
91185µs85µsbase::::has_fieldsbase::has_fields
91177µs77µsbase::::has_attrbase::has_attr
11123µs47µsbase::::BEGIN@3base::BEGIN@3
11113µs50µsbase::::BEGIN@4base::BEGIN@4
0000s0sbase::::__ANON__[:53]base::__ANON__[:53]
0000s0sbase::::__ANON__[:60]base::__ANON__[:60]
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
3342µs271µs
# spent 47µs (23+24) within base::BEGIN@3 which was called: # once (23µs+24µs) by MARC::File::XML::BEGIN@6 at line 3
use strict 'vars';
# spent 47µs making 1 call to base::BEGIN@3 # spent 24µs making 1 call to strict::import
431.22ms287µs
# spent 50µs (13+37) within base::BEGIN@4 which was called: # once (13µs+37µs) by MARC::File::XML::BEGIN@6 at line 4
use vars qw($VERSION);
# spent 50µs making 1 call to base::BEGIN@4 # spent 37µs making 1 call to vars::import
512µs$VERSION = '2.14';
6121µs$VERSION = eval $VERSION;
# spent 5µs executing statements in string eval
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
1611µsmy $Fattr = \%fields::attr;
17
18
# spent 85µs within base::has_fields which was called 9 times, avg 9µs/call: # 9 times (85µs+0s) by base::import at line 112, avg 9µs/call
sub has_fields {
1927100µs my($base) = shift;
20 my $fglob = ${"$base\::"}{FIELDS};
21 return( ($fglob && 'GLOB' eq ref($fglob) && *$fglob{HASH}) ? 1 : 0 );
22}
23
24
# spent 138µs within base::has_version which was called 9 times, avg 15µs/call: # 9 times (138µs+0s) by base::import at line 82, avg 15µs/call
sub has_version {
2527153µs my($base) = shift;
26 my $vglob = ${$base.'::'}{VERSION};
27 return( ($vglob && *$vglob{SCALAR}) ? 1 : 0 );
28}
29
30
# spent 77µs within base::has_attr which was called 9 times, avg 9µs/call: # 9 times (77µs+0s) by base::import at line 112, avg 9µs/call
sub has_attr {
312785µs my($proto) = shift;
32 my($class) = ref $proto || $proto;
33 return exists $Fattr->{$class};
34}
35
36sub get_attr {
37 $Fattr->{$_[0]} = [1] unless $Fattr->{$_[0]};
38 return $Fattr->{$_[0]};
39}
40
41214µsif ($] < 5.009) {
42 *get_fields = sub {
43 # Shut up a possible typo warning.
44 () = \%{$_[0].'::FIELDS'};
45 my $f = \%{$_[0].'::FIELDS'};
46
47 # should be centralized in fields? perhaps
48 # fields::mk_FIELDS_be_OK. Peh. As long as %{ $package . '::FIELDS' }
49 # is used here anyway, it doesn't matter.
50 bless $f, 'pseudohash' if (ref($f) ne 'pseudohash');
51
52 return $f;
53 }
54}
55else {
56 *get_fields = sub {
57 # Shut up a possible typo warning.
58 () = \%{$_[0].'::FIELDS'};
59 return \%{$_[0].'::FIELDS'};
60 }
61}
62
63
# spent 27.7ms (26.9+808µs) within base::import which was called 9 times, avg 3.07ms/call: # once (23.5ms+162µs) by MARC::File::SAX::BEGIN@11 at line 11 of MARC/File/SAX.pm # once (1.84ms+114µs) by MARC::Charset::Code::BEGIN@5 at line 5 of MARC/Charset/Code.pm # once (1.08ms+329µs) by MARC::File::XML::BEGIN@6 at line 6 of MARC/File/XML.pm # once (81µs+39µs) by MARC::Charset::BEGIN@7 at line 7 of MARC/Charset.pm # once (71µs+40µs) by MARC::File::Encode::BEGIN@21 at line 21 of MARC/File/Encode.pm # once (68µs+38µs) by Encode::BEGIN@13 at line 13 of Encode.pm # once (70µs+34µs) by XML::SAX::Expat::BEGIN@9 at line 9 of XML/SAX/Expat.pm # once (59µs+27µs) by MARC::Charset::Constants::BEGIN@20 at line 20 of MARC/Charset/Constants.pm # once (59µs+25µs) by Encode::Alias::BEGIN@8 at line 8 of Encode/Alias.pm
sub import {
6490289µs my $class = shift;
65
66 return SUCCESS unless @_;
67
68 # List of base classes from which we will inherit %FIELDS.
69 my $fields_base;
70
71 my $inheritor = caller(0);
72 my @isa_classes;
73
74 my @bases;
75 foreach my $base (@_) {
7645351µs if ( $inheritor eq $base ) {
77 warn "Class '$inheritor' tried to inherit from itself\n";
78 }
79
80935µs next if grep $_->isa($base), ($inheritor, @bases);
# spent 35µs making 9 calls to UNIVERSAL::isa, avg 4µs/call
81
821846µs9138µs if (has_version($base)) {
# spent 138µs making 9 calls to base::has_version, avg 15µs/call
83 ${$base.'::VERSION'} = '-1, set by base.pm'
84 unless defined ${$base.'::VERSION'};
85 }
86 else {
87 my $sigdie;
88 {
8915156µs local $SIG{__DIE__};
90 eval "require $base";
# spent 141µs executing statements in string eval # spent 127µs executing statements in string eval # spent 115µs executing statements in string eval
91 # Only ignore "Can't locate" errors from our eval require.
92 # Other fatal errors (syntax etc) must be reported.
93 die if $@ && $@ !~ /^Can't locate .*? at \(eval /;
94 unless (%{"$base\::"}) {
95 require Carp;
96 local $" = " ";
97 Carp::croak(<<ERROR);
98Base class package "$base" is empty.
99 (Perhaps you need to 'use' the module which defines that package first,
100 or make that module available in \@INC (\@INC contains: @INC).
101ERROR
102 }
103 $sigdie = $SIG{__DIE__} || undef;
104 }
105 # Make sure a global $SIG{__DIE__} makes it out of the localization.
106 $SIG{__DIE__} = $sigdie if defined $sigdie;
107 ${$base.'::VERSION'} = "-1, set by base.pm"
108 unless defined ${$base.'::VERSION'};
109 }
110 push @bases, $base;
111
11218162µs if ( has_fields($base) || has_attr($base) ) {
# spent 85µs making 9 calls to base::has_fields, avg 9µs/call # spent 77µs making 9 calls to base::has_attr, avg 9µs/call
113 # No multiple fields inheritance *suck*
114 if ($fields_base) {
115 require Carp;
116 Carp::croak("Can't multiply inherit fields");
117 } else {
118 $fields_base = $base;
119 }
120 }
121 }
122 # Save this until the end so it's all or nothing if the above loop croaks.
123 push @{"$inheritor\::ISA"}, @isa_classes;
124
125 push @{"$inheritor\::ISA"}, @bases;
126
127 if( defined $fields_base ) {
128 inherit_fields($inheritor, $fields_base);
129 }
130}
131
132sub inherit_fields {
133 my($derived, $base) = @_;
134
135 return SUCCESS unless $base;
136
137 my $battr = get_attr($base);
138 my $dattr = get_attr($derived);
139 my $dfields = get_fields($derived);
140 my $bfields = get_fields($base);
141
142 $dattr->[0] = @$battr;
143
144 if( keys %$dfields ) {
145 warn <<"END";
146$derived is inheriting from $base but already has its own fields!
147This will cause problems. Be sure you use base BEFORE declaring fields.
148END
149
150 }
151
152 # Iterate through the base's fields adding all the non-private
153 # ones to the derived class. Hang on to the original attribute
154 # (Public, Private, etc...) and add Inherited.
155 # This is all too complicated to do efficiently with add_fields().
156 while (my($k,$v) = each %$bfields) {
157 my $fno;
158 if ($fno = $dfields->{$k} and $fno != $v) {
159 require Carp;
160 Carp::croak ("Inherited fields can't override existing fields");
161 }
162
163 if( $battr->[$v] & PRIVATE ) {
164 $dattr->[$v] = PRIVATE | INHERITED;
165 }
166 else {
167 $dattr->[$v] = INHERITED | $battr->[$v];
168 $dfields->{$k} = $v;
169 }
170 }
171
172 foreach my $idx (1..$#{$battr}) {
173 next if defined $dattr->[$idx];
174 $dattr->[$idx] = $battr->[$idx] & INHERITED;
175 }
176}
177
17818µs1;
179
180__END__
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.