← Index
NYTProf Performance Profile   « line view »
For Makefile.PL
  Run on Sun Mar 1 16:04:44 2015
Reported on Sun Mar 1 16:09:02 2015

FilenameC:/tmp64ng/perl/lib/base.pm
StatementsExecuted 78 statements in 0s
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1110s0sbase::::BEGIN@3base::BEGIN@3
1110s0sbase::::BEGIN@4base::BEGIN@4
2110s0sbase::::CORE:matchbase::CORE:match (opcode)
2110s0sbase::::CORE:substbase::CORE:subst (opcode)
0000s0sbase::::__ANON__[:48]base::__ANON__[:48]
0000s0sbase::::__ANON__[:55]base::__ANON__[:55]
0000s0sbase::::__ANON__[:63]base::__ANON__[:63]
2110s0sbase::::__ANON__[:71]base::__ANON__[:71]
0000s0sbase::::get_attrbase::get_attr
2110s0sbase::::has_attrbase::has_attr
2110s0sbase::::has_fieldsbase::has_fields
2220s0sbase::::importbase::import
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
320s20s
# spent 0s within base::BEGIN@3 which was called: # once (0s+0s) by ExtUtils::MakeMaker::Locale::BEGIN@6 at line 3
use strict 'vars';
# spent 0s making 1 call to base::BEGIN@3 # spent 0s making 1 call to strict::import
420s20s
# spent 0s within base::BEGIN@4 which was called: # once (0s+0s) by ExtUtils::MakeMaker::Locale::BEGIN@6 at line 4
use vars qw($VERSION);
# spent 0s making 1 call to base::BEGIN@4 # spent 0s making 1 call to vars::import
510s$VERSION = '2.22';
610s$VERSION = eval $VERSION;
# spent 0s 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
16
1710smy $Fattr = \%fields::attr;
18
19
# spent 0s within base::has_fields which was called 2 times, avg 0s/call: # 2 times (0s+0s) by base::import at line 126, avg 0s/call
sub has_fields {
2020s my($base) = shift;
2120s my $fglob = ${"$base\::"}{FIELDS};
2220s return( ($fglob && 'GLOB' eq ref($fglob) && *$fglob{HASH}) ? 1 : 0 );
23}
24
25
# spent 0s within base::has_attr which was called 2 times, avg 0s/call: # 2 times (0s+0s) by base::import at line 126, avg 0s/call
sub has_attr {
2620s my($proto) = shift;
2720s my($class) = ref $proto || $proto;
2820s return exists $Fattr->{$class};
29}
30
31sub get_attr {
32 $Fattr->{$_[0]} = [1] unless $Fattr->{$_[0]};
33 return $Fattr->{$_[0]};
34}
35
3610sif ($] < 5.009) {
37 *get_fields = sub {
38 # Shut up a possible typo warning.
39 () = \%{$_[0].'::FIELDS'};
40 my $f = \%{$_[0].'::FIELDS'};
41
42 # should be centralized in fields? perhaps
43 # fields::mk_FIELDS_be_OK. Peh. As long as %{ $package . '::FIELDS' }
44 # is used here anyway, it doesn't matter.
45 bless $f, 'pseudohash' if (ref($f) ne 'pseudohash');
46
47 return $f;
48 }
49}
50else {
51 *get_fields = sub {
52 # Shut up a possible typo warning.
53 () = \%{$_[0].'::FIELDS'};
54 return \%{$_[0].'::FIELDS'};
55 }
5610s}
57
5810sif ($] < 5.008) {
59 *_module_to_filename = sub {
60 (my $fn = $_[0]) =~ s!::!/!g;
61 $fn .= '.pm';
62 return $fn;
63 }
64}
65else {
66
# spent 0s within base::__ANON__[C:/tmp64ng/perl/lib/base.pm:71] which was called 2 times, avg 0s/call: # 2 times (0s+0s) by base::import at line 98, avg 0s/call
*_module_to_filename = sub {
6720s20s (my $fn = $_[0]) =~ s!::!/!g;
# spent 0s making 2 calls to base::CORE:subst, avg 0s/call
6820s $fn .= '.pm';
6920s20s utf8::encode($fn);
# spent 0s making 2 calls to utf8::encode, avg 0s/call
7020s return $fn;
71 }
7210s}
73
74
75
# spent 0s within base::import which was called 2 times, avg 0s/call: # once (0s+0s) by ExtUtils::MakeMaker::Locale::BEGIN@6 at line 6 of ExtUtils/MakeMaker/Locale.pm # once (0s+0s) by JSON::PP::BEGIN@7 at line 7 of JSON/PP.pm
sub import {
7620s my $class = shift;
77
7820s return SUCCESS unless @_;
79
80 # List of base classes from which we will inherit %FIELDS.
8120s my $fields_base;
82
8320s my $inheritor = caller(0);
84
8520s my @bases;
8620s foreach my $base (@_) {
8720s if ( $inheritor eq $base ) {
88 warn "Class '$inheritor' tried to inherit from itself\n";
89 }
90
9120s20s next if grep $_->isa($base), ($inheritor, @bases);
# spent 0s making 2 calls to UNIVERSAL::isa, avg 0s/call
92
93 # Following blocks help isolate $SIG{__DIE__} changes
94 {
9540s my $sigdie;
96 {
9740s local $SIG{__DIE__};
9820s20s my $fn = _module_to_filename($base);
# spent 0s making 2 calls to base::__ANON__[base.pm:71], avg 0s/call
9940s eval { require $fn };
100 # Only ignore "Can't locate" errors from our eval require.
101 # Other fatal errors (syntax etc) must be reported.
102 #
103 # changing the check here is fragile - if the check
104 # here isn't catching every error you want, you should
105 # probably be using parent.pm, which doesn't try to
106 # guess whether require is needed or failed,
107 # see [perl #118561]
10820s20s die if $@ && $@ !~ /^Can't locate \Q$fn\E .*? at .* line [0-9]+(?:, <[^>]*> (?:line|chunk) [0-9]+)?\.\n\z/s
# spent 0s making 2 calls to base::CORE:match, avg 0s/call
109 || $@ =~ /Compilation failed in require at .* line [0-9]+(?:, <[^>]*> (?:line|chunk) [0-9]+)?\.\n\z/;
11020s unless (%{"$base\::"}) {
111 require Carp;
112 local $" = " ";
113 Carp::croak(<<ERROR);
114Base class package "$base" is empty.
115 (Perhaps you need to 'use' the module which defines that package first,
116 or make that module available in \@INC (\@INC contains: @INC).
117ERROR
118 }
11920s $sigdie = $SIG{__DIE__} || undef;
120 }
121 # Make sure a global $SIG{__DIE__} makes it out of the localization.
12220s $SIG{__DIE__} = $sigdie if defined $sigdie;
123 }
12420s push @bases, $base;
125
12620s40s if ( has_fields($base) || has_attr($base) ) {
# spent 0s making 2 calls to base::has_attr, avg 0s/call # spent 0s making 2 calls to base::has_fields, avg 0s/call
127 # No multiple fields inheritance *suck*
128 if ($fields_base) {
129 require Carp;
130 Carp::croak("Can't multiply inherit fields");
131 } else {
132 $fields_base = $base;
133 }
134 }
135 }
136 # Save this until the end so it's all or nothing if the above loop croaks.
13720s push @{"$inheritor\::ISA"}, @bases;
138
13920s if( defined $fields_base ) {
140 inherit_fields($inheritor, $fields_base);
141 }
142}
143
144
145sub inherit_fields {
146 my($derived, $base) = @_;
147
148 return SUCCESS unless $base;
149
150 my $battr = get_attr($base);
151 my $dattr = get_attr($derived);
152 my $dfields = get_fields($derived);
153 my $bfields = get_fields($base);
154
155 $dattr->[0] = @$battr;
156
157 if( keys %$dfields ) {
158 warn <<"END";
159$derived is inheriting from $base but already has its own fields!
160This will cause problems. Be sure you use base BEFORE declaring fields.
161END
162
163 }
164
165 # Iterate through the base's fields adding all the non-private
166 # ones to the derived class. Hang on to the original attribute
167 # (Public, Private, etc...) and add Inherited.
168 # This is all too complicated to do efficiently with add_fields().
169 while (my($k,$v) = each %$bfields) {
170 my $fno;
171 if ($fno = $dfields->{$k} and $fno != $v) {
172 require Carp;
173 Carp::croak ("Inherited fields can't override existing fields");
174 }
175
176 if( $battr->[$v] & PRIVATE ) {
177 $dattr->[$v] = PRIVATE | INHERITED;
178 }
179 else {
180 $dattr->[$v] = INHERITED | $battr->[$v];
181 $dfields->{$k} = $v;
182 }
183 }
184
185 foreach my $idx (1..$#{$battr}) {
186 next if defined $dattr->[$idx];
187 $dattr->[$idx] = $battr->[$idx] & INHERITED;
188 }
189}
190
191
19210s1;
193
194__END__
 
# spent 0s within base::CORE:match which was called 2 times, avg 0s/call: # 2 times (0s+0s) by base::import at line 108, avg 0s/call
sub base::CORE:match; # opcode
# spent 0s within base::CORE:subst which was called 2 times, avg 0s/call: # 2 times (0s+0s) by base::__ANON__[C:/tmp64ng/perl/lib/base.pm:71] at line 67, avg 0s/call
sub base::CORE:subst; # opcode
Report produced by the NYTProf 5.07 Perl profiler, developed by Tim Bunce and Adam Kaplan.