Profile of overload.pm

Filename	/usr/share/perl/5.10/overload.pm
Statements	Executed 124 statements in 790µs

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
6	1	1	302µs	304µs	overload::::OVERLOADoverload::OVERLOAD
6	6	6	90µs	394µs	overload::::importoverload::import
1	1	1	22µs	192µs	overload::::BEGIN@139overload::BEGIN@139
1	1	1	2µs	2µs	overload::::CORE:matchoverload::CORE:match (opcode)
0	0	0	0s	0s	overload::::AddrRefoverload::AddrRef
0	0	0	0s	0s	overload::::Methodoverload::Method
0	0	0	0s	0s	overload::::Overloadedoverload::Overloaded
0	0	0	0s	0s	overload::::OverloadedStringifyoverload::OverloadedStringify
0	0	0	0s	0s	overload::::constantoverload::constant
0	0	0	0s	0s	overload::::mycanoverload::mycan
0	0	0	0s	0s	overload::::niloverload::nil
0	0	0	0s	0s	overload::::ov_methodoverload::ov_method
0	0	0	0s	0s	overload::::remove_constantoverload::remove_constant
0	0	0	0s	0s	overload::::unimportoverload::unimport

Call graph for these subroutines as a Graphviz dot language file.

Line	State ments	Time on line	Calls	Time in subs	Code
1					package overload;
2
3	1	1µs			our $VERSION = '1.07';
4
5					sub nil {}
6
7					# spent 304µs (302+2) within overload::OVERLOAD which was called 6 times, avg 51µs/call: # 6 times (302µs+2µs) by overload::import at line 33, avg 51µs/call sub OVERLOAD {
8	42	161µs			$package = shift;
9					my %arg = @_;
10					my ($sub, $fb);
11					$ {$package . "::OVERLOAD"}{dummy}++; # Register with magic by touching.
12					*{$package . "::()"} = \&nil; # Make it findable via fetchmethod.
13					for (keys %arg) {
14	54	149µs			if ($_ eq 'fallback') {
15					$fb = $arg{$_};
16					} else {
17					$sub = $arg{$_};
18	2	6µs	1	2µs	if (not ref $sub and $sub !~ /::/) { # spent 2µs making 1 call to overload::CORE:match
19					$ {$package . "::(" . $_} = $sub;
20					$sub = \&nil;
21					}
22					#print STDERR "Setting `$ {'package'}::\cO$_' to \\&`$sub'.\n";
23					*{$package . "::(" . $_} = \&{ $sub };
24					}
25					}
26					${$package . "::()"} = $fb; # Make it findable too (fallback only).
27					}
28
29					# spent 394µs (90+304) within overload::import which was called 6 times, avg 66µs/call: # once (17µs+62µs) by XML::LibXML::Error::BEGIN@15 at line 22 of XML/LibXML/Error.pm # once (17µs+57µs) by XML::SAX::Exception::BEGIN@5 at line 5 of XML/SAX/Exception.pm # once (16µs+48µs) by XML::LibXML::Literal::BEGIN@19 at line 19 of XML/LibXML/Literal.pm # once (12µs+49µs) by XML::LibXML::Number::BEGIN@19 at line 19 of XML/LibXML/Number.pm # once (15µs+43µs) by XML::LibXML::NodeList::BEGIN@20 at line 20 of XML/LibXML/NodeList.pm # once (13µs+45µs) by XML::LibXML::Boolean::BEGIN@21 at line 21 of XML/LibXML/Boolean.pm sub import {
30	18	85µs			$package = (caller())[0];
31					# *{$package . "::OVERLOAD"} = \&OVERLOAD;
32					shift;
33			6	304µs	$package->overload::OVERLOAD(@_); # spent 304µs making 6 calls to overload::OVERLOAD, avg 51µs/call
34					}
35
36					sub unimport {
37					$package = (caller())[0];
38					${$package . "::OVERLOAD"}{dummy}++; # Upgrade the table
39					shift;
40					for (@_) {
41					if ($_ eq 'fallback') {
42					undef $ {$package . "::()"};
43					} else {
44					delete $ {$package . "::"}{"(" . $_};
45					}
46					}
47					}
48
49					sub Overloaded {
50					my $package = shift;
51					$package = ref $package if ref $package;
52					$package->can('()');
53					}
54
55					sub ov_method {
56					my $globref = shift;
57					return undef unless $globref;
58					my $sub = \&{*$globref};
59					return $sub if $sub ne \&nil;
60					return shift->can($ {*$globref});
61					}
62
63					sub OverloadedStringify {
64					my $package = shift;
65					$package = ref $package if ref $package;
66					#$package->can('(""')
67					ov_method mycan($package, '(""'), $package
68					or ov_method mycan($package, '(0+'), $package
69					or ov_method mycan($package, '(bool'), $package
70					or ov_method mycan($package, '(nomethod'), $package;
71					}
72
73					sub Method {
74					my $package = shift;
75					if(ref $package) {
76					local $@;
77					local $!;
78					require Scalar::Util;
79					$package = Scalar::Util::blessed($package);
80					return undef if !defined $package;
81					}
82					#my $meth = $package->can('(' . shift);
83					ov_method mycan($package, '(' . shift), $package;
84					#return $meth if $meth ne \&nil;
85					#return $ {*{$meth}};
86					}
87
88					sub AddrRef {
89					my $package = ref $_[0];
90					return "$_[0]" unless $package;
91
92					local $@;
93					local $!;
94					require Scalar::Util;
95					my $class = Scalar::Util::blessed($_[0]);
96					my $class_prefix = defined($class) ? "$class=" : "";
97					my $type = Scalar::Util::reftype($_[0]);
98					my $addr = Scalar::Util::refaddr($_[0]);
99					return sprintf("$class_prefix$type(0x%x)", $addr);
100					}
101
102	1	7µs			StrVal = AddrRef;
103
104					sub mycan { # Real can would leave stubs.
105					my ($package, $meth) = @_;
106
107					my $mro = mro::get_linear_isa($package);
108					foreach my $p (@$mro) {
109					my $fqmeth = $p . q{::} . $meth;
110					return \*{$fqmeth} if defined &{$fqmeth};
111					}
112
113					return undef;
114					}
115
116	1	4µs			%constants = (
117					'integer' => 0x1000, # HINT_NEW_INTEGER
118					'float' => 0x2000, # HINT_NEW_FLOAT
119					'binary' => 0x4000, # HINT_NEW_BINARY
120					'q' => 0x8000, # HINT_NEW_STRING
121					'qr' => 0x10000, # HINT_NEW_RE
122					);
123
124	1	9µs			%ops = ( with_assign => "+ - * / % ** << >> x .",
125					assign => "+= -= = /= %= *= <<= >>= x= .=",
126					num_comparison => "< <= > >= == !=",
127					'3way_comparison'=> "<=> cmp",
128					str_comparison => "lt le gt ge eq ne",
129					binary => '& &= \| \|= ^ ^=',
130					unary => "neg ! ~",
131					mutators => '++ --',
132					func => "atan2 cos sin exp abs log sqrt int",
133					conversion => 'bool "" 0+',
134					iterators => '<>',
135					dereferencing => '${} @{} %{} &{} *{}',
136					matching => '~~',
137					special => 'nomethod fallback =');
138
139	3	357µs	2	362µs	# spent 192µs (22+170) within overload::BEGIN@139 which was called: # once (22µs+170µs) by XML::LibXML::Error::BEGIN@15 at line 139 use warnings::register; # spent 192µs making 1 call to overload::BEGIN@139 # spent 170µs making 1 call to warnings::register::import
140					sub constant {
141					# Arguments: what, sub
142					while (@_) {
143					if (@_ == 1) {
144					warnings::warnif ("Odd number of arguments for overload::constant");
145					last;
146					}
147					elsif (!exists $constants {$_ [0]}) {
148					warnings::warnif ("`$_[0]' is not an overloadable type");
149					}
150					elsif (!ref $_ [1] \|\| "$_[1]" !~ /(^\|=)CODE$0x[0-9a-f]+$$/) {
151					# Can't use C<ref $_[1] eq "CODE"> above as code references can be
152					# blessed, and C<ref> would return the package the ref is blessed into.
153					if (warnings::enabled) {
154					$_ [1] = "undef" unless defined $_ [1];
155					warnings::warn ("`$_[1]' is not a code reference");
156					}
157					}
158					else {
159					$^H{$_[0]} = $_[1];
160					$^H \|= $constants{$_[0]};
161					}
162					shift, shift;
163					}
164					}
165
166					sub remove_constant {
167					# Arguments: what, sub
168					while (@_) {
169					delete $^H{$_[0]};
170					$^H &= ~ $constants{$_[0]};
171					shift, shift;
172					}
173					}
174
175	1	11µs			1;
176
177					__END__

					# spent 2µs within overload::CORE:match which was called: # once (2µs+0s) by overload::OVERLOAD at line 18 sub overload::CORE:match; # opcode