lib/Class/MOP/Method/Overload.pm

   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
  17     confess "operator is required"
  18         unless exists $params{operator};
  19
  20     return $class->SUPER::wrap(
  21         name => "($params{operator}",
  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
  42         'operator'             => $params->{operator},
  43     } => $class;
  44 }
  45
  46 1;