Profile of overload.pm

Filename	/usr/share/perl/5.10/overload.pm
Statements	Executed 631 statements in 2.32ms

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
22	1	1	1.31ms	1.33ms	overload::::OVERLOADoverload::OVERLOAD
22	22	21	450µs	1.78ms	overload::::importoverload::import
1	1	1	38µs	227µs	overload::::BEGIN@139overload::BEGIN@139
17	1	1	16µs	16µ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	2µs			our $VERSION = '1.07';
4
5					sub nil {}
6
7					# spent 1.33ms (1.31+16µs) within overload::OVERLOAD which was called 22 times, avg 60µs/call: # 22 times (1.31ms+16µs) by overload::import at line 33, avg 60µs/call sub OVERLOAD {
8	22	13µs			$package = shift;
9	22	117µs			my %arg = @_;
10	22	21µs			my ($sub, $fb);
11	22	187µs			$ {$package . "::OVERLOAD"}{dummy}++; # Register with magic by touching.
12	22	117µs			*{$package . "::()"} = \&nil; # Make it findable via fetchmethod.
13	22	93µs			for (keys %arg) {
14	99	136µs			if ($_ eq 'fallback') {
15					$fb = $arg{$_};
16					} else {
17	90	54µs			$sub = $arg{$_};
18	90	124µs	17	16µs	if (not ref $sub and $sub !~ /::/) { # spent 16µs making 17 calls to overload::CORE:match, avg 929ns/call
19	17	54µs			$ {$package . "::(" . $_} = $sub;
20	17	14µs			$sub = \&nil;
21					}
22					#print STDERR "Setting `$ {'package'}::\cO$_' to \\&`$sub'.\n";
23	90	277µs			*{$package . "::(" . $_} = \&{ $sub };
24					}
25					}
26	22	298µs			${$package . "::()"} = $fb; # Make it findable too (fallback only).
27					}
28
29					# spent 1.78ms (450µs+1.33) within overload::import which was called 22 times, avg 81µs/call: # once (19µs+238µs) by Math::BigInt::BEGIN@44 at line 153 of Math/BigInt.pm # once (111µs+42µs) by ZOOM::Exception::BEGIN@194 at line 194 of ZOOM.pm # once (25µs+128µs) by XML::LibXML::Error::BEGIN@15 at line 22 of XML/LibXML/Error.pm # once (17µs+96µs) by DateTime::BEGIN@52 at line 53 of DateTime.pm # once (13µs+92µs) by DateTime::Duration::BEGIN@14 at line 15 of DateTime/Duration.pm # once (28µs+58µs) by Fh::BEGIN@3739 at line 3739 of CGI.pm # once (20µs+64µs) by XML::SAX::Exception::BEGIN@5 at line 5 of XML/SAX/Exception.pm # once (23µs+57µs) by CGI::Cookie::BEGIN@20 at line 20 of CGI/Cookie.pm # once (19µs+53µs) by YAML::Tag::BEGIN@8 at line 8 of YAML/Tag.pm # once (18µs+54µs) by XML::LibXML::Literal::BEGIN@19 at line 19 of XML/LibXML/Literal.pm # once (14µs+52µs) by Template::Exception::BEGIN@27 at line 27 of Template/Exception.pm # once (14µs+51µs) by Set::Infinite::Basic::BEGIN@27 at line 27 of Set/Infinite/Basic.pm # once (14µs+51µs) by MIME::Type::BEGIN@18 at line 18 of MIME/Type.pm # once (18µs+45µs) by JSON::PP::Boolean::BEGIN@1339 at line 1343 of JSON/PP.pm # once (15µs+47µs) by XML::LibXML::Boolean::BEGIN@21 at line 21 of XML/LibXML/Boolean.pm # once (17µs+40µs) by URI::BEGIN@24 at line 27 of URI.pm # once (15µs+35µs) by JSON::XS::Boolean::BEGIN@3 at line 14 of (eval 31)[JSON.pm:319] # once (15µs+33µs) by Set::Infinite::BEGIN@21 at line 21 of Set/Infinite.pm # once (8µs+29µs) by XML::LibXML::Number::BEGIN@19 at line 19 of XML/LibXML/Number.pm # once (9µs+24µs) by XML::LibXML::NodeList::BEGIN@20 at line 20 of XML/LibXML/NodeList.pm # once (10µs+24µs) by JSON::PP::Boolean::BEGIN@3 at line 14 of (eval 32)[JSON.pm:319] # once (7µs+13µs) by JSON::PP::BEGIN@8 at line 8 of JSON/PP.pm sub import {
30	22	70µs			$package = (caller())[0];
31					# *{$package . "::OVERLOAD"} = \&OVERLOAD;
32	22	17µs			shift;
33	22	250µs	22	1.33ms	$package->overload::OVERLOAD(@_); # spent 1.33ms making 22 calls to overload::OVERLOAD, avg 60µ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	3µ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	6µ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	12µ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	441µs	2	416µs	# spent 227µs (38+189) within overload::BEGIN@139 which was called: # once (38µs+189µs) by ZOOM::Exception::BEGIN@194 at line 139 use warnings::register; # spent 227µs making 1 call to overload::BEGIN@139 # spent 189µ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	13µs			1;
176
177					__END__

					# spent 16µs within overload::CORE:match which was called 17 times, avg 929ns/call: # 17 times (16µs+0s) by overload::OVERLOAD at line 18, avg 929ns/call sub overload::CORE:match; # opcode