Commit | Line | Data |
2683d371 |
1 | |
2 | package Class::MOP::Method::Overload; |
3 | |
4 | use strict; |
5 | use warnings; |
6 | |
7 | use Carp 'confess'; |
8 | |
9 | use base 'Class::MOP::Method'; |
10 | |
11 | sub wrap { |
12 | my $class = shift; |
13 | my (@args) = @_; |
14 | unshift @args, 'body' if @args % 2 == 1; |
15 | my %params = @args; |
16 | |
644d6eaa |
17 | confess "operator is required" |
18 | unless exists $params{operator}; |
2683d371 |
19 | |
20 | return $class->SUPER::wrap( |
644d6eaa |
21 | name => "($params{operator}", |
2683d371 |
22 | %params, |
23 | ); |
24 | } |
25 | |
26 | sub _new { |
27 | my $class = shift; |
28 | return Class::MOP::Class->initialize($class)->new_object(@_) |
29 | if $class ne __PACKAGE__; |
30 | |
31 | my $params = @_ == 1 ? $_[0] : {@_}; |
32 | |
33 | return bless { |
34 | # inherited from Class::MOP::Method |
35 | 'body' => $params->{body}, |
36 | 'associated_metaclass' => $params->{associated_metaclass}, |
37 | 'package_name' => $params->{package_name}, |
38 | 'name' => $params->{name}, |
39 | 'original_method' => $params->{original_method}, |
40 | |
41 | # defined in this class |
644d6eaa |
42 | 'operator' => $params->{operator}, |
2683d371 |
43 | } => $class; |
44 | } |
45 | |
46 | 1; |