| 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 | Class::MOP::Mixin::HasOverloads::BEGIN@7 |
| 1 | 1 | 1 | 448µs | 1.13ms | Class::MOP::Mixin::HasOverloads::BEGIN@9 |
| 1 | 1 | 1 | 10µs | 12µs | Class::MOP::Mixin::HasOverloads::BEGIN@4 |
| 1 | 1 | 1 | 7µs | 49µs | Class::MOP::Mixin::HasOverloads::BEGIN@50 |
| 1 | 1 | 1 | 5µs | 10µs | Class::MOP::Mixin::HasOverloads::BEGIN@5 |
| 1 | 1 | 1 | 5µs | 18µs | Class::MOP::Mixin::HasOverloads::BEGIN@10 |
| 1 | 1 | 1 | 4µs | 20µs | Class::MOP::Mixin::HasOverloads::BEGIN@15 |
| 1 | 1 | 1 | 4µs | 17µs | Class::MOP::Mixin::HasOverloads::BEGIN@11 |
| 1 | 1 | 1 | 2µs | 2µs | Class::MOP::Mixin::HasOverloads::BEGIN@13 |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Mixin::HasOverloads::_overload_for |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Mixin::HasOverloads::_overload_info |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Mixin::HasOverloads::add_overloaded_operator |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Mixin::HasOverloads::get_all_overloaded_operators |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Mixin::HasOverloads::get_overload_fallback_value |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Mixin::HasOverloads::get_overload_list |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Mixin::HasOverloads::get_overloaded_operator |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Mixin::HasOverloads::has_overloaded_operator |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Mixin::HasOverloads::is_overloaded |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Mixin::HasOverloads::remove_overloaded_operator |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Mixin::HasOverloads::set_overload_fallback_value |
| 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__ |