Filename | /home/ss5/perl5/perlbrew/perls/perl-5.22.0/lib/site_perl/5.22.0/x86_64-linux/Class/MOP/Mixin/HasOverloads.pm |
Statements | Executed 21 statements in 639µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 585µs | 677µs | BEGIN@7 | Class::MOP::Mixin::HasOverloads::
1 | 1 | 1 | 448µs | 1.13ms | BEGIN@9 | Class::MOP::Mixin::HasOverloads::
1 | 1 | 1 | 10µs | 12µs | BEGIN@4 | Class::MOP::Mixin::HasOverloads::
1 | 1 | 1 | 7µs | 49µs | BEGIN@50 | Class::MOP::Mixin::HasOverloads::
1 | 1 | 1 | 5µs | 10µs | BEGIN@5 | Class::MOP::Mixin::HasOverloads::
1 | 1 | 1 | 5µs | 18µs | BEGIN@10 | Class::MOP::Mixin::HasOverloads::
1 | 1 | 1 | 4µs | 20µs | BEGIN@15 | Class::MOP::Mixin::HasOverloads::
1 | 1 | 1 | 4µs | 17µs | BEGIN@11 | Class::MOP::Mixin::HasOverloads::
1 | 1 | 1 | 2µs | 2µs | BEGIN@13 | Class::MOP::Mixin::HasOverloads::
0 | 0 | 0 | 0s | 0s | _overload_for | Class::MOP::Mixin::HasOverloads::
0 | 0 | 0 | 0s | 0s | _overload_info | Class::MOP::Mixin::HasOverloads::
0 | 0 | 0 | 0s | 0s | add_overloaded_operator | Class::MOP::Mixin::HasOverloads::
0 | 0 | 0 | 0s | 0s | get_all_overloaded_operators | Class::MOP::Mixin::HasOverloads::
0 | 0 | 0 | 0s | 0s | get_overload_fallback_value | Class::MOP::Mixin::HasOverloads::
0 | 0 | 0 | 0s | 0s | get_overload_list | Class::MOP::Mixin::HasOverloads::
0 | 0 | 0 | 0s | 0s | get_overloaded_operator | Class::MOP::Mixin::HasOverloads::
0 | 0 | 0 | 0s | 0s | has_overloaded_operator | Class::MOP::Mixin::HasOverloads::
0 | 0 | 0 | 0s | 0s | is_overloaded | Class::MOP::Mixin::HasOverloads::
0 | 0 | 0 | 0s | 0s | remove_overloaded_operator | Class::MOP::Mixin::HasOverloads::
0 | 0 | 0 | 0s | 0s | set_overload_fallback_value | Class::MOP::Mixin::HasOverloads::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Class::MOP::Mixin::HasOverloads; | ||||
2 | 1 | 300ns | our $VERSION = '2.1605'; | ||
3 | |||||
4 | 2 | 16µs | 2 | 14µs | # spent 12µs (10+2) within Class::MOP::Mixin::HasOverloads::BEGIN@4 which was called:
# once (10µs+2µs) by Class::MOP::BEGIN@17 at line 4 # spent 12µs making 1 call to Class::MOP::Mixin::HasOverloads::BEGIN@4
# spent 2µs making 1 call to strict::import |
5 | 2 | 16µs | 2 | 14µs | # spent 10µs (5+4) within Class::MOP::Mixin::HasOverloads::BEGIN@5 which was called:
# once (5µs+4µs) by Class::MOP::BEGIN@17 at line 5 # spent 10µs making 1 call to Class::MOP::Mixin::HasOverloads::BEGIN@5
# spent 4µs making 1 call to warnings::import |
6 | |||||
7 | 2 | 76µs | 1 | 677µs | # spent 677µs (585+92) within Class::MOP::Mixin::HasOverloads::BEGIN@7 which was called:
# once (585µs+92µs) by Class::MOP::BEGIN@17 at line 7 # spent 677µs making 1 call to Class::MOP::Mixin::HasOverloads::BEGIN@7 |
8 | |||||
9 | 3 | 83µs | 3 | 1.16ms | # spent 1.13ms (448µs+680µs) within Class::MOP::Mixin::HasOverloads::BEGIN@9 which was called:
# once (448µs+680µs) by Class::MOP::BEGIN@17 at line 9 # spent 1.13ms making 1 call to Class::MOP::Mixin::HasOverloads::BEGIN@9
# spent 22µs making 1 call to Exporter::import
# spent 6µs making 1 call to UNIVERSAL::VERSION |
10 | 2 | 17µs | 2 | 32µs | # spent 18µs (5+13) within Class::MOP::Mixin::HasOverloads::BEGIN@10 which was called:
# once (5µs+13µs) by Class::MOP::BEGIN@17 at line 10 # spent 18µs making 1 call to Class::MOP::Mixin::HasOverloads::BEGIN@10
# spent 13µs making 1 call to Exporter::import |
11 | 2 | 17µs | 2 | 30µs | # spent 17µs (4+13) within Class::MOP::Mixin::HasOverloads::BEGIN@11 which was called:
# once (4µs+13µs) by Class::MOP::BEGIN@17 at line 11 # spent 17µs making 1 call to Class::MOP::Mixin::HasOverloads::BEGIN@11
# spent 13µs making 1 call to Exporter::import |
12 | |||||
13 | 2 | 12µs | 1 | 2µs | # spent 2µs within Class::MOP::Mixin::HasOverloads::BEGIN@13 which was called:
# once (2µs+0s) by Class::MOP::BEGIN@17 at line 13 # spent 2µs making 1 call to Class::MOP::Mixin::HasOverloads::BEGIN@13 |
14 | |||||
15 | 2 | 129µs | 2 | 35µs | # spent 20µs (4+16) within Class::MOP::Mixin::HasOverloads::BEGIN@15 which was called:
# once (4µs+16µs) by Class::MOP::BEGIN@17 at line 15 # spent 20µs making 1 call to Class::MOP::Mixin::HasOverloads::BEGIN@15
# spent 16µs making 1 call to parent::import |
16 | |||||
17 | sub is_overloaded { | ||||
18 | my $self = shift; | ||||
19 | Devel::OverloadInfo::is_overloaded($self->name); | ||||
20 | } | ||||
21 | |||||
22 | sub get_overload_list { | ||||
23 | my $self = shift; | ||||
24 | |||||
25 | my $info = $self->_overload_info; | ||||
26 | return grep { $_ ne 'fallback' } keys %{$info} | ||||
27 | } | ||||
28 | |||||
29 | sub get_all_overloaded_operators { | ||||
30 | my $self = shift; | ||||
31 | return map { $self->_overload_for($_) } $self->get_overload_list; | ||||
32 | } | ||||
33 | |||||
34 | sub has_overloaded_operator { | ||||
35 | my $self = shift; | ||||
36 | my ($op) = @_; | ||||
37 | return defined $self->_overload_info->{$op}; | ||||
38 | } | ||||
39 | |||||
40 | sub _overload_map { | ||||
41 | $_[0]->{_overload_map} ||= {}; | ||||
42 | } | ||||
43 | |||||
44 | sub get_overloaded_operator { | ||||
45 | my $self = shift; | ||||
46 | my ($op) = @_; | ||||
47 | return $self->_overload_map->{$op} ||= $self->_overload_for($op); | ||||
48 | } | ||||
49 | |||||
50 | 2 | 270µs | 2 | 91µs | # spent 49µs (7+42) within Class::MOP::Mixin::HasOverloads::BEGIN@50 which was called:
# once (7µs+42µs) by Class::MOP::BEGIN@17 at line 50 # spent 49µs making 1 call to Class::MOP::Mixin::HasOverloads::BEGIN@50
# spent 42µs making 1 call to constant::import |
51 | |||||
52 | sub add_overloaded_operator { | ||||
53 | my $self = shift; | ||||
54 | my ( $op, $overload ) = @_; | ||||
55 | |||||
56 | my %p = ( associated_metaclass => $self ); | ||||
57 | if ( !ref $overload ) { | ||||
58 | %p = ( | ||||
59 | %p, | ||||
60 | operator => $op, | ||||
61 | method_name => $overload, | ||||
62 | associated_metaclass => $self, | ||||
63 | ); | ||||
64 | $p{method} = $self->get_method($overload) | ||||
65 | if $self->has_method($overload); | ||||
66 | $overload = Class::MOP::Overload->new(%p); | ||||
67 | } | ||||
68 | elsif ( !blessed $overload) { | ||||
69 | $overload = Class::MOP::Overload->new( | ||||
70 | operator => $op, | ||||
71 | coderef => $overload, | ||||
72 | coderef_name => sub_name($overload), | ||||
73 | coderef_package => stash_name($overload), | ||||
74 | %p, | ||||
75 | ); | ||||
76 | } | ||||
77 | |||||
78 | $overload->attach_to_class($self); | ||||
79 | $self->_overload_map->{$op} = $overload; | ||||
80 | |||||
81 | my %overload = ( | ||||
82 | $op => $overload->has_coderef | ||||
83 | ? $overload->coderef | ||||
84 | : $overload->method_name | ||||
85 | ); | ||||
86 | |||||
87 | # Perl 5.10 and earlier appear to have a bug where setting a new | ||||
88 | # overloading operator wipes out the fallback value unless we pass it each | ||||
89 | # time. | ||||
90 | if (_SET_FALLBACK_EACH_TIME) { | ||||
91 | $overload{fallback} = $self->get_overload_fallback_value; | ||||
92 | } | ||||
93 | |||||
94 | $self->name->overload::OVERLOAD(%overload); | ||||
95 | } | ||||
96 | |||||
97 | sub remove_overloaded_operator { | ||||
98 | my $self = shift; | ||||
99 | my ($op) = @_; | ||||
100 | |||||
101 | delete $self->_overload_map->{$op}; | ||||
102 | |||||
103 | # overload.pm provides no api for this - but the problem that makes this | ||||
104 | # necessary has been fixed in 5.18 | ||||
105 | $self->get_or_add_package_symbol('%OVERLOAD')->{dummy}++ | ||||
106 | if $] < 5.017000; | ||||
107 | |||||
108 | $self->remove_package_symbol('&(' . $op); | ||||
109 | } | ||||
110 | |||||
111 | sub get_overload_fallback_value { | ||||
112 | my $self = shift; | ||||
113 | return $self->_overload_info->{fallback}{value}; | ||||
114 | } | ||||
115 | |||||
116 | sub set_overload_fallback_value { | ||||
117 | my $self = shift; | ||||
118 | my $value = shift; | ||||
119 | |||||
120 | $self->name->overload::OVERLOAD( fallback => $value ); | ||||
121 | } | ||||
122 | |||||
123 | # We could cache this but we'd need some logic to clear it at all the right | ||||
124 | # times, which seems more tedious than it's worth. | ||||
125 | sub _overload_info { | ||||
126 | my $self = shift; | ||||
127 | return overload_info( $self->name ) || {}; | ||||
128 | } | ||||
129 | |||||
130 | sub _overload_for { | ||||
131 | my $self = shift; | ||||
132 | my $op = shift; | ||||
133 | |||||
134 | my $map = $self->_overload_map; | ||||
135 | return $map->{$op} if $map->{$op}; | ||||
136 | |||||
137 | my $info = $self->_overload_info->{$op}; | ||||
138 | return unless $info; | ||||
139 | |||||
140 | my %p = ( | ||||
141 | operator => $op, | ||||
142 | associated_metaclass => $self, | ||||
143 | ); | ||||
144 | |||||
145 | if ( $info->{code} && !$info->{method_name} ) { | ||||
146 | $p{coderef} = $info->{code}; | ||||
147 | @p{ 'coderef_package', 'coderef_name' } | ||||
148 | = $info->{code_name} =~ /(.+)::([^:]+)/; | ||||
149 | } | ||||
150 | else { | ||||
151 | $p{method_name} = $info->{method_name}; | ||||
152 | if ( $self->has_method( $p{method_name} ) ) { | ||||
153 | $p{method} = $self->get_method( $p{method_name} ); | ||||
154 | } | ||||
155 | } | ||||
156 | |||||
157 | return $map->{$op} = Class::MOP::Overload->new(%p); | ||||
158 | } | ||||
159 | |||||
160 | 1 | 3µs | 1; | ||
161 | |||||
162 | # ABSTRACT: Methods for metaclasses which have overloads | ||||
163 | |||||
164 | __END__ |