← Index
NYTProf Performance Profile   « block view • line view • sub view »
For mentat.storage.mongo.pl
  Run on Tue Jun 24 10:04:38 2014
Reported on Tue Jun 24 10:05:09 2014

Filename/usr/share/perl/5.14/overload.pm
StatementsExecuted 844 statements in 1.65ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1211876µs881µsoverload::::OVERLOADoverload::OVERLOAD
2732291µs369µsoverload::::constantoverload::constant
121212110µs991µsoverload::::importoverload::import
482184µs84µsoverload::::CORE:matchoverload::CORE:match (opcode)
22133µs40µsoverload::::AddrRefoverload::AddrRef
11114µs83µsoverload::::BEGIN@147overload::BEGIN@147
0000s0soverload::::Methodoverload::Method
0000s0soverload::::Overloadedoverload::Overloaded
0000s0soverload::::OverloadedStringifyoverload::OverloadedStringify
0000s0soverload::::mycanoverload::mycan
0000s0soverload::::niloverload::nil
0000s0soverload::::ov_methodoverload::ov_method
0000s0soverload::::remove_constantoverload::remove_constant
0000s0soverload::::unimportoverload::unimport
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package overload;
2
31500nsour $VERSION = '1.13';
4
5sub nil {}
6
7
# spent 881µs (876+5) within overload::OVERLOAD which was called 12 times, avg 73µs/call: # 12 times (876µs+5µs) by overload::import at line 34, avg 73µs/call
sub OVERLOAD {
896622µs $package = shift;
9 my %arg = @_;
10 my ($sub, $fb);
11128µs $ {$package . "::OVERLOAD"}{dummy}++; # Register with magic by touching.
12124µs $fb = ${$package . "::()"}; # preserve old fallback value RT#68196
13124µs *{$package . "::()"} = \&nil; # Make it findable via fetchmethod.
14 for (keys %arg) {
15292196µs if ($_ eq 'fallback') {
16 $fb = $arg{$_};
17 } else {
18 $sub = $arg{$_};
192432µs126µs if (not ref $sub and $sub !~ /::/) {
# spent 6µs making 12 calls to overload::CORE:match, avg 458ns/call
20124µs $ {$package . "::(" . $_} = $sub;
21 $sub = \&nil;
22 }
23 #print STDERR "Setting `$ {'package'}::\cO$_' to \\&`$sub'.\n";
2413830µs *{$package . "::(" . $_} = \&{ $sub };
25 }
26 }
27123µs ${$package . "::()"} = $fb; # Make it findable too (fallback only).
28}
29
30
# spent 991µs (110+881) within overload::import which was called 12 times, avg 83µs/call: # once (9µs+510µs) by Math::BigInt::BEGIN@44 at line 153 of Math/BigInt.pm # once (7µs+94µs) by DateTime::BEGIN@58 at line 59 of DateTime.pm # once (7µs+58µs) by DateTime::Duration::BEGIN@14 at line 15 of DateTime/Duration.pm # once (11µs+35µs) by Moose::Meta::Role::Method::Required::BEGIN@14 at line 15 of Moose/Meta/Role/Method/Required.pm # once (10µs+32µs) by Moose::Meta::TypeConstraint::BEGIN@14 at line 17 of Moose/Meta/TypeConstraint.pm # once (16µs+20µs) by JSON::PP::Boolean::BEGIN@3 at line 14 of (eval 50)[JSON.pm:353] # once (9µs+26µs) by MongoDB::OID::BEGIN@72 at line 72 of MongoDB/OID.pm # once (9µs+25µs) by boolean::BEGIN@10 at line 12 of boolean.pm # once (9µs+24µs) by JSON::XS::Boolean::BEGIN@1478 at line 1481 of JSON/XS.pm # once (8µs+23µs) by JSON::XS::Boolean::BEGIN@3 at line 14 of (eval 49)[JSON.pm:353] # once (6µs+20µs) by Class::MOP::Method::BEGIN@21 at line 21 of Class/MOP/Method.pm # once (8µs+15µs) by bigint::BEGIN@11 at line 11 of bigint.pm
sub import {
3136107µs $package = (caller())[0];
32 # *{$package . "::OVERLOAD"} = \&OVERLOAD;
33 shift;
3412881µs $package->overload::OVERLOAD(@_);
# spent 881µs making 12 calls to overload::OVERLOAD, avg 73µs/call
35}
36
37sub unimport {
38 $package = (caller())[0];
39 ${$package . "::OVERLOAD"}{dummy}++; # Upgrade the table
40 shift;
41 for (@_) {
42 if ($_ eq 'fallback') {
43 undef $ {$package . "::()"};
44 } else {
45 delete $ {$package . "::"}{"(" . $_};
46 }
47 }
48}
49
50sub Overloaded {
51 my $package = shift;
52 $package = ref $package if ref $package;
53 $package->can('()');
54}
55
56sub ov_method {
57 my $globref = shift;
58 return undef unless $globref;
59 my $sub = \&{*$globref};
60 require Scalar::Util;
61 return $sub
62 if Scalar::Util::refaddr($sub) != Scalar::Util::refaddr(\&nil);
63 return shift->can($ {*$globref});
64}
65
66sub OverloadedStringify {
67 my $package = shift;
68 $package = ref $package if ref $package;
69 #$package->can('(""')
70 ov_method mycan($package, '(""'), $package
71 or ov_method mycan($package, '(0+'), $package
72 or ov_method mycan($package, '(bool'), $package
73 or ov_method mycan($package, '(nomethod'), $package;
74}
75
76sub Method {
77 my $package = shift;
78 if(ref $package) {
79 local $@;
80 local $!;
81 require Scalar::Util;
82 $package = Scalar::Util::blessed($package);
83 return undef if !defined $package;
84 }
85 #my $meth = $package->can('(' . shift);
86 ov_method mycan($package, '(' . shift), $package;
87 #return $meth if $meth ne \&nil;
88 #return $ {*{$meth}};
89}
90
91
# spent 40µs (33+6) within overload::AddrRef which was called 2 times, avg 20µs/call: # once (24µs+4µs) by boolean::BEGIN@31 at line 44 of boolean.pm # once (9µs+2µs) by boolean::BEGIN@31 at line 45 of boolean.pm
sub AddrRef {
922040µs my $package = ref $_[0];
93 return "$_[0]" unless $package;
94
95 local $@;
96 local $!;
97 require Scalar::Util;
9822µs my $class = Scalar::Util::blessed($_[0]);
# spent 2µs making 2 calls to Scalar::Util::blessed, avg 800ns/call
99 my $class_prefix = defined($class) ? "$class=" : "";
10022µs my $type = Scalar::Util::reftype($_[0]);
# spent 2µs making 2 calls to Scalar::Util::reftype, avg 750ns/call
10123µs my $addr = Scalar::Util::refaddr($_[0]);
# spent 3µs making 2 calls to Scalar::Util::refaddr, avg 2µs/call
102 return sprintf("%s%s(0x%x)", $class_prefix, $type, $addr);
103}
104
10511µs*StrVal = *AddrRef;
106
107sub mycan { # Real can would leave stubs.
108 my ($package, $meth) = @_;
109
110 local $@;
111 local $!;
112 require mro;
113
114 my $mro = mro::get_linear_isa($package);
115 foreach my $p (@$mro) {
116 my $fqmeth = $p . q{::} . $meth;
117 return \*{$fqmeth} if defined &{$fqmeth};
118 }
119
120 return undef;
121}
122
12312µs%constants = (
124 'integer' => 0x1000, # HINT_NEW_INTEGER
125 'float' => 0x2000, # HINT_NEW_FLOAT
126 'binary' => 0x4000, # HINT_NEW_BINARY
127 'q' => 0x8000, # HINT_NEW_STRING
128 'qr' => 0x10000, # HINT_NEW_RE
129 );
130
13115µs%ops = ( with_assign => "+ - * / % ** << >> x .",
132 assign => "+= -= *= /= %= **= <<= >>= x= .=",
133 num_comparison => "< <= > >= == !=",
134 '3way_comparison'=> "<=> cmp",
135 str_comparison => "lt le gt ge eq ne",
136 binary => '& &= | |= ^ ^=',
137 unary => "neg ! ~",
138 mutators => '++ --',
139 func => "atan2 cos sin exp abs log sqrt int",
140 conversion => 'bool "" 0+ qr',
141 iterators => '<>',
142 filetest => "-X",
143 dereferencing => '${} @{} %{} &{} *{}',
144 matching => '~~',
145 special => 'nomethod fallback =');
146
1472194µs2152µs
# spent 83µs (14+69) within overload::BEGIN@147 which was called: # once (14µs+69µs) by Value::Convertor::BEGIN@55 at line 147
use warnings::register;
# spent 83µs making 1 call to overload::BEGIN@147 # spent 69µs making 1 call to warnings::register::import
148
# spent 369µs (291+78) within overload::constant which was called 27 times, avg 14µs/call: # 9 times (147µs+42µs) by Math::BigInt::import at line 2703 of Math/BigInt.pm, avg 21µs/call # 9 times (81µs+24µs) by bigint::import at line 262 of bigint.pm, avg 12µs/call # 9 times (62µs+12µs) by bigint::import at line 264 of bigint.pm, avg 8µs/call
sub constant {
149 # Arguments: what, sub
1502755µs while (@_) {
151144331µs3678µs if (@_ == 1) {
# spent 78µs making 36 calls to overload::CORE:match, avg 2µs/call
152 warnings::warnif ("Odd number of arguments for overload::constant");
153 last;
154 }
155 elsif (!exists $constants {$_ [0]}) {
156 warnings::warnif ("`$_[0]' is not an overloadable type");
157 }
158 elsif (!ref $_ [1] || "$_[1]" !~ /(^|=)CODE\(0x[0-9a-f]+\)$/) {
159 # Can't use C<ref $_[1] eq "CODE"> above as code references can be
160 # blessed, and C<ref> would return the package the ref is blessed into.
161 if (warnings::enabled) {
162 $_ [1] = "undef" unless defined $_ [1];
163 warnings::warn ("`$_[1]' is not a code reference");
164 }
165 }
166 else {
167 $^H{$_[0]} = $_[1];
168 $^H |= $constants{$_[0]};
169 }
170 shift, shift;
171 }
172}
173
174sub remove_constant {
175 # Arguments: what, sub
176 while (@_) {
177 delete $^H{$_[0]};
178 $^H &= ~ $constants{$_[0]};
179 shift, shift;
180 }
181}
182
18317µs1;
184
185__END__
 
# spent 84µs within overload::CORE:match which was called 48 times, avg 2µs/call: # 36 times (78µs+0s) by overload::constant at line 151, avg 2µs/call # 12 times (6µs+0s) by overload::OVERLOAD at line 19, avg 458ns/call
sub overload::CORE:match; # opcode