Profile of overload.pm

Filename	/Users/ether/perl5/perlbrew/perls/36.0/lib/5.36.0/overload.pm
Statements	Executed 337 statements in 1.85ms

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
14	1	1	290µs	290µs	overload::::OVERLOADoverload::OVERLOAD
14	14	12	107µs	397µs	overload::::importoverload::import
1	1	1	32µs	36µs	overload::::BEGIN@3overload::BEGIN@3
1	1	1	14µs	111µs	overload::::BEGIN@145overload::BEGIN@145
1	1	1	10µs	21µs	overload::::BEGIN@85overload::BEGIN@85
1	1	1	9µs	14µs	overload::::BEGIN@115overload::BEGIN@115
1	1	1	6µs	32µs	overload::::BEGIN@5overload::BEGIN@5
1	1	1	5µs	13µs	overload::::BEGIN@4overload::BEGIN@4
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	2	37µs	2	40µs	# spent 36µs (32+4) within overload::BEGIN@3 which was called: # once (32µs+4µs) by Cpanel::JSON::XS::BEGIN@2334 at line 3 use strict; # spent 36µs making 1 call to overload::BEGIN@3 # spent 4µs making 1 call to strict::import
4	2	29µs	2	21µs	# spent 13µs (5+8) within overload::BEGIN@4 which was called: # once (5µs+8µs) by Cpanel::JSON::XS::BEGIN@2334 at line 4 no strict 'refs'; # spent 13µs making 1 call to overload::BEGIN@4 # spent 8µs making 1 call to strict::unimport
5	2	445µs	2	58µs	# spent 32µs (6+26) within overload::BEGIN@5 which was called: # once (6µs+26µs) by Cpanel::JSON::XS::BEGIN@2334 at line 5 no warnings 'experimental::builtin'; # spent 32µs making 1 call to overload::BEGIN@5 # spent 26µs making 1 call to warnings::unimport
6
7	1	1µs			our $VERSION = '1.35';
8
9	1	9µs			our %ops = (
10					with_assign => "+ - * / % ** << >> x .",
11					assign => "+= -= = /= %= *= <<= >>= x= .=",
12					num_comparison => "< <= > >= == !=",
13					'3way_comparison' => "<=> cmp",
14					str_comparison => "lt le gt ge eq ne",
15					binary => '& &= \| \|= ^ ^= &. &.= \|. \|.= ^. ^.=',
16					unary => "neg ! ~ ~.",
17					mutators => '++ --',
18					func => "atan2 cos sin exp abs log sqrt int",
19					conversion => 'bool "" 0+ qr',
20					iterators => '<>',
21					filetest => "-X",
22					dereferencing => '${} @{} %{} &{} *{}',
23					matching => '~~',
24					special => 'nomethod fallback =',
25					);
26
27	1	1µs			my %ops_seen;
28	1	75µs			@ops_seen{ map split(/ /), values %ops } = ();
29
30					sub nil {}
31
32					# spent 290µs within overload::OVERLOAD which was called 14 times, avg 21µs/call: # 14 times (290µs+0s) by overload::import at line 61, avg 21µs/call sub OVERLOAD {
33	14	2µs			my $package = shift;
34	14	29µs			my %arg = @_;
35	14	3µs			my $sub;
36	14	50µs			*{$package . "::(("} = \&nil; # Make it findable via fetchmethod.
37	14	76µs			for (keys %arg) {
38	43	29µs			if ($_ eq 'fallback') {
39	11	24µs			for my $sym (*{$package . "::()"}) {
40	11	4µs			*$sym = \&nil; # Make it findable via fetchmethod.
41	11	12µs			$$sym = $arg{$_};
42					}
43					} else {
44					warnings::warnif("overload arg '$_' is invalid")
45	32	18µs			unless exists $ops_seen{$_};
46	32	10µs			$sub = $arg{$_};
47	32	8µs			if (not ref $sub) {
48	1	2µs			$ {$package . "::(" . $_} = $sub;
49	1	1µs			$sub = \&nil;
50					}
51					#print STDERR "Setting '$ {'package'}::\cO$_' to \\&'$sub'.\n";
52	32	48µs			*{$package . "::(" . $_} = \&{ $sub };
53					}
54					}
55					}
56
57					# spent 397µs (107+290) within overload::import which was called 14 times, avg 28µs/call: # once (11µs+27µs) by Getopt::Long::CallBack::BEGIN@1573 at line 1574 of Getopt/Long.pm # once (11µs+26µs) by Path::Tiny::Error::BEGIN@2415 at line 2415 of Path/Tiny.pm # once (13µs+24µs) by Cpanel::JSON::XS::BEGIN@2334 at line 2342 of Cpanel/JSON/XS.pm # once (8µs+26µs) by JSON::Schema::Modern::Result::BEGIN@29 at line 33 of JSON/Schema/Modern/Result.pm # once (8µs+24µs) by Path::Tiny::BEGIN@29 at line 33 of Path/Tiny.pm # once (9µs+22µs) by YAML::PP::Preserve::Scalar::BEGIN@377 at line 381 of YAML/PP.pm # once (6µs+23µs) by JSON::PP::BEGIN@12 at line 10 of JSON/PP/Boolean.pm # once (7µs+22µs) by Mojo::Path::BEGIN@3 at line 3 of Mojo/Path.pm # once (6µs+20µs) by Mojo::Parameters::BEGIN@3 at line 3 of Mojo/Parameters.pm # once (6µs+18µs) by JSON::Schema::Modern::Error::BEGIN@24 at line 24 of JSON/Schema/Modern/Error.pm # once (5µs+16µs) by Mojo::URL::BEGIN@3 at line 3 of Mojo/URL.pm # once (6µs+15µs) by Pod::Simple::LinkSection::BEGIN@11 at line 17 of Pod/Simple/LinkSection.pm # once (7µs+13µs) by YAML::PP::Exception::BEGIN@7 at line 7 of YAML/PP/Exception.pm # once (4µs+14µs) by Cpanel::JSON::XS::BEGIN@2334 at line 2371 of Cpanel/JSON/XS.pm sub import {
58	14	25µs			my $package = (caller())[0];
59					# *{$package . "::OVERLOAD"} = \&OVERLOAD;
60	14	3µs			shift;
61	14	87µs	14	290µs	$package->overload::OVERLOAD(@_); # spent 290µs making 14 calls to overload::OVERLOAD, avg 21µs/call
62					}
63
64					sub unimport {
65					my $package = (caller())[0];
66					shift;
67					*{$package . "::(("} = \&nil;
68					for (@_) {
69					warnings::warnif("overload arg '$_' is invalid")
70					unless exists $ops_seen{$_};
71					delete $ {$package . "::"}{$_ eq 'fallback' ? '()' : "(" .$_};
72					}
73					}
74
75					sub Overloaded {
76					my $package = shift;
77					$package = ref $package if ref $package;
78					mycan ($package, '()') \|\| mycan ($package, '((');
79					}
80
81					sub ov_method {
82					my $globref = shift;
83					return undef unless $globref;
84					my $sub = \&{*$globref};
85	2	173µs	2	32µs	# spent 21µs (10+11) within overload::BEGIN@85 which was called: # once (10µs+11µs) by Cpanel::JSON::XS::BEGIN@2334 at line 85 no overloading; # spent 21µs making 1 call to overload::BEGIN@85 # spent 11µs making 1 call to overloading::unimport
86					return $sub if $sub != \&nil;
87					return shift->can($ {*$globref});
88					}
89
90					sub OverloadedStringify {
91					my $package = shift;
92					$package = ref $package if ref $package;
93					#$package->can('(""')
94					ov_method mycan($package, '(""'), $package
95					or ov_method mycan($package, '(0+'), $package
96					or ov_method mycan($package, '(bool'), $package
97					or ov_method mycan($package, '(nomethod'), $package;
98					}
99
100					sub Method {
101					my $package = shift;
102					if(ref $package) {
103					local $@;
104					local $!;
105					$package = builtin::blessed($package);
106					return undef if !defined $package;
107					}
108					#my $meth = $package->can('(' . shift);
109					ov_method mycan($package, '(' . shift), $package;
110					#return $meth if $meth ne \&nil;
111					#return $ {*{$meth}};
112					}
113
114					sub AddrRef {
115	2	159µs	2	19µs	# spent 14µs (9+5) within overload::BEGIN@115 which was called: # once (9µs+5µs) by Cpanel::JSON::XS::BEGIN@2334 at line 115 no overloading; # spent 14µs making 1 call to overload::BEGIN@115 # spent 5µs making 1 call to overloading::unimport
116					"$_[0]";
117					}
118
119	1	2µs			StrVal = AddrRef;
120
121					sub mycan { # Real can would leave stubs.
122					my ($package, $meth) = @_;
123
124					local $@;
125					local $!;
126					require mro;
127
128					my $mro = mro::get_linear_isa($package);
129					foreach my $p (@$mro) {
130					my $fqmeth = $p . q{::} . $meth;
131					return \*{$fqmeth} if defined &{$fqmeth};
132					}
133
134					return undef;
135					}
136
137	1	2µs			my %constants = (
138					'integer' => 0x1000, # HINT_NEW_INTEGER
139					'float' => 0x2000, # HINT_NEW_FLOAT
140					'binary' => 0x4000, # HINT_NEW_BINARY
141					'q' => 0x8000, # HINT_NEW_STRING
142					'qr' => 0x10000, # HINT_NEW_RE
143					);
144
145	2	477µs	2	208µs	# spent 111µs (14+97) within overload::BEGIN@145 which was called: # once (14µs+97µs) by Cpanel::JSON::XS::BEGIN@2334 at line 145 use warnings::register; # spent 111µs making 1 call to overload::BEGIN@145 # spent 97µs making 1 call to warnings::register::import
146					sub constant {
147					# Arguments: what, sub
148					while (@_) {
149					if (@_ == 1) {
150					warnings::warnif ("Odd number of arguments for overload::constant");
151					last;
152					}
153					elsif (!exists $constants {$_ [0]}) {
154					warnings::warnif ("'$_[0]' is not an overloadable type");
155					}
156					elsif (!ref $_ [1] \|\| "$_[1]" !~ /(^\|=)CODE$0x[0-9a-f]+$$/) {
157					# Can't use C<ref $_[1] eq "CODE"> above as code references can be
158					# blessed, and C<ref> would return the package the ref is blessed into.
159					if (warnings::enabled) {
160					$_ [1] = "undef" unless defined $_ [1];
161					warnings::warn ("'$_[1]' is not a code reference");
162					}
163					}
164					else {
165					$^H{$_[0]} = $_[1];
166					$^H \|= $constants{$_[0]};
167					}
168					shift, shift;
169					}
170					}
171
172					sub remove_constant {
173					# Arguments: what, sub
174					while (@_) {
175					delete $^H{$_[0]};
176					$^H &= ~ $constants{$_[0]};
177					shift, shift;
178					}
179					}
180
181	1	13µs			1;
182
183					__END__