Profile of base.pm

Filename	/usr/lib64/perl5/5.16.0/base.pm
Statements	Executed 417 statements in 11.0ms

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
15	15	14	19.7ms	106ms	base::::importbase::import (recurses: max depth 1, inclusive time 434µs)
15	1	1	368µs	368µs	base::::has_fieldsbase::has_fields
15	1	1	261µs	261µs	base::::has_attrbase::has_attr
1	1	1	81µs	162µs	base::::BEGIN@3base::BEGIN@3
1	1	1	47µs	187µs	base::::BEGIN@4base::BEGIN@4
0	0	0	0s	0s	base::::__ANON__[:48]base::__ANON__[:48]
0	0	0	0s	0s	base::::__ANON__[:55]base::__ANON__[:55]
0	0	0	0s	0s	base::::get_attrbase::get_attr
0	0	0	0s	0s	base::::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
1					package base;
2
3	2	156µs	2	243µs	# spent 162µs (81+81) within base::BEGIN@3 which was called: # once (81µs+81µs) by OCBNET::Spritesets::Sprite::BEGIN@15 at line 3 use strict 'vars'; # spent 162µs making 1 call to base::BEGIN@3 # spent 81µs making 1 call to strict::import
4	2	4.34ms	2	327µs	# spent 187µs (47+140) within base::BEGIN@4 which was called: # once (47µs+140µs) by OCBNET::Spritesets::Sprite::BEGIN@15 at line 4 use vars qw($VERSION); # spent 187µs making 1 call to base::BEGIN@4 # spent 140µs making 1 call to vars::import
5	1	4µs			$VERSION = '2.18';
6	1	69µs			$VERSION = eval $VERSION; # spent 10µs executing statements in string eval
7
8					# constant.pm is slow
9					sub SUCCESS () { 1 }
10
11					sub PUBLIC () { 2**0 }
12					sub PRIVATE () { 2**1 }
13					sub INHERITED () { 2**2 }
14					sub PROTECTED () { 2**3 }
15
16
17	1	6µs			my $Fattr = \%fields::attr;
18
19					# spent 368µs within base::has_fields which was called 15 times, avg 25µs/call: # 15 times (368µs+0s) by base::import at line 101, avg 25µs/call sub has_fields {
20	15	54µs			my($base) = shift;
21	15	113µs			my $fglob = ${"$base\::"}{FIELDS};
22	15	321µs			return( ($fglob && 'GLOB' eq ref($fglob) && *$fglob{HASH}) ? 1 : 0 );
23					}
24
25					# spent 261µs within base::has_attr which was called 15 times, avg 17µs/call: # 15 times (261µs+0s) by base::import at line 101, avg 17µs/call sub has_attr {
26	15	36µs			my($proto) = shift;
27	15	40µs			my($class) = ref $proto \|\| $proto;
28	15	261µs			return exists $Fattr->{$class};
29					}
30
31					sub get_attr {
32					$Fattr->{$_[0]} = [1] unless $Fattr->{$_[0]};
33					return $Fattr->{$_[0]};
34					}
35
36	1	7µs			if ($] < 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					}
50					else {
51					*get_fields = sub {
52					# Shut up a possible typo warning.
53					() = \%{$_[0].'::FIELDS'};
54					return \%{$_[0].'::FIELDS'};
55					}
56	1	15µs			}
57
58					# spent 106ms (19.7+86.2) within base::import which was called 15 times, avg 7.06ms/call: # once (3.25ms+44.7ms) by RTP::IO::AtomicFile::BEGIN@16 at line 16 of webmerge/scripts/modules/RTP/IO/AtomicFile.pm # once (6.44ms+40.1ms) by OCBNET::Spritesets::CSS::Parser::BEGIN@30 at line 30 of webmerge/scripts/modules/OCBNET/Spritesets/CSS/Parser.pm # once (5.66ms+1.17ms) by OCBNET::Spritesets::Canvas::BEGIN@25 at line 25 of webmerge/scripts/modules/OCBNET/Spritesets/Canvas.pm # once (534µs+106µs) by File::Temp::BEGIN@162 at line 162 of File/Temp.pm # once (523µs+61µs) by XML::LibXML::SAX::BEGIN@20 at line 20 of XML/LibXML/SAX.pm # once (374µs+71µs) by OCBNET::Spritesets::Sprite::BEGIN@15 at line 15 of webmerge/scripts/modules/OCBNET/Spritesets/Sprite.pm # once (380µs+57µs) by OCBNET::Spritesets::Fit::BEGIN@17 at line 17 of webmerge/scripts/modules/OCBNET/Spritesets/Fit.pm # once (354µs+53µs) by Encode::Alias::BEGIN@8 at line 8 of Encode/Alias.pm # once (351µs+54µs) by OCBNET::Spritesets::Stack::BEGIN@17 at line 17 of webmerge/scripts/modules/OCBNET/Spritesets/Stack.pm # once (345µs+53µs) by OCBNET::Spritesets::Edge::BEGIN@18 at line 18 of webmerge/scripts/modules/OCBNET/Spritesets/Edge.pm # once (342µs+53µs) by OCBNET::Spritesets::Corner::BEGIN@16 at line 16 of webmerge/scripts/modules/OCBNET/Spritesets/Corner.pm # once (333µs+51µs) by Encode::BEGIN@13 at line 13 of Encode.pm # once (313µs+51µs) by JSON::BEGIN@6 at line 6 of JSON.pm # once (92µs+10µs) by File::Temp::BEGIN@173 at line 173 of File/Temp.pm # once (378µs+-378µs) by OCBNET::Spritesets::Container::BEGIN@16 at line 16 of webmerge/scripts/modules/OCBNET/Spritesets/Container.pm sub import {
59	15	46µs			my $class = shift;
60
61	15	34µs			return SUCCESS unless @_;
62
63					# List of base classes from which we will inherit %FIELDS.
64	15	12µs			my $fields_base;
65
66	15	76µs			my $inheritor = caller(0);
67
68	15	20µs			my @bases;
69	15	89µs			foreach my $base (@_) {
70	16	30µs			if ( $inheritor eq $base ) {
71					warn "Class '$inheritor' tried to inherit from itself\n";
72					}
73
74	16	1.07ms	17	226µs	next if grep $_->isa($base), ($inheritor, @bases); # spent 226µs making 17 calls to UNIVERSAL::isa, avg 13µs/call
75
76					# Following blocks help isolate $SIG{__DIE__} changes
77					{
78	30	53µs			my $sigdie;
79					{
80	30	243µs			local $SIG{__DIE__};
81	15	1.67ms			eval "require $base"; # spent 503µs executing statements in 4 string evals (merged) # spent 483µs executing statements in string eval # spent 385µs executing statements in string eval # spent 34µs executing statements in 3 string evals (merged) # spent 21µs executing statements in 2 string evals (merged) # spent 15µs executing statements in string eval # spent 12µs executing statements in string eval # spent 12µs executing statements in string eval # spent 10µs executing statements in string eval
82					# Only ignore "Can't locate" errors from our eval require.
83					# Other fatal errors (syntax etc) must be reported.
84	15	16µs			die if $@ && $@ !~ /^Can't locate .*? at \(eval /;
85	15	251µs			unless (%{"$base\::"}) {
86					require Carp;
87					local $" = " ";
88					Carp::croak(<<ERROR);
89					Base class package "$base" is empty.
90					(Perhaps you need to 'use' the module which defines that package first,
91					or make that module available in \@INC (\@INC contains: @INC).
92					ERROR
93					}
94	15	245µs			$sigdie = $SIG{__DIE__} \|\| undef;
95					}
96					# Make sure a global $SIG{__DIE__} makes it out of the localization.
97	15	35µs			$SIG{__DIE__} = $sigdie if defined $sigdie;
98					}
99	15	69µs			push @bases, $base;
100
101	15	405µs	30	628µs	if ( has_fields($base) \|\| has_attr($base) ) { # spent 368µs making 15 calls to base::has_fields, avg 25µs/call # spent 261µs making 15 calls to base::has_attr, avg 17µs/call
102					# No multiple fields inheritance suck
103					if ($fields_base) {
104					require Carp;
105					Carp::croak("Can't multiply inherit fields");
106					} else {
107					$fields_base = $base;
108					}
109					}
110					}
111					# Save this until the end so it's all or nothing if the above loop croaks.
112	15	733µs			push @{"$inheritor\::ISA"}, @bases;
113
114	15	457µs			if( defined $fields_base ) {
115					inherit_fields($inheritor, $fields_base);
116					}
117					}
118
119
120					sub inherit_fields {
121					my($derived, $base) = @_;
122
123					return SUCCESS unless $base;
124
125					my $battr = get_attr($base);
126					my $dattr = get_attr($derived);
127					my $dfields = get_fields($derived);
128					my $bfields = get_fields($base);
129
130					$dattr->[0] = @$battr;
131
132					if( keys %$dfields ) {
133					warn <<"END";
134					$derived is inheriting from $base but already has its own fields!
135					This will cause problems. Be sure you use base BEFORE declaring fields.
136					END
137
138					}
139
140					# Iterate through the base's fields adding all the non-private
141					# ones to the derived class. Hang on to the original attribute
142					# (Public, Private, etc...) and add Inherited.
143					# This is all too complicated to do efficiently with add_fields().
144					while (my($k,$v) = each %$bfields) {
145					my $fno;
146					if ($fno = $dfields->{$k} and $fno != $v) {
147					require Carp;
148					Carp::croak ("Inherited fields can't override existing fields");
149					}
150
151					if( $battr->[$v] & PRIVATE ) {
152					$dattr->[$v] = PRIVATE \| INHERITED;
153					}
154					else {
155					$dattr->[$v] = INHERITED \| $battr->[$v];
156					$dfields->{$k} = $v;
157					}
158					}
159
160					foreach my $idx (1..$#{$battr}) {
161					next if defined $dattr->[$idx];
162					$dattr->[$idx] = $battr->[$idx] & INHERITED;
163					}
164					}
165
166
167	1	19µs			1;
168
169					__END__