lib/Mouse/Meta/Method.pm

   1 package Mouse::Meta::Method;
   2 use Mouse::Util qw(:meta); # enables strict and warnings
   3 use Scalar::Util ();
   4
   5 use overload
   6     '=='  => '_equal',
   7     'eq'  => '_equal',
   8     '&{}' => sub{ $_[0]->body },
   9     fallback => 1,
  10 ;
  11
  12 sub wrap {
  13     my $class = shift;
  14     unshift @_, 'body' if @_ % 2 != 0;
  15     return $class->_new(@_);
  16 }
  17
  18 sub _new{
  19     my($class, %args) = @_;
  20     my $self = bless \%args, $class;
  21
  22     if($class ne __PACKAGE__){
  23         $self->meta->_initialize_object($self, \%args);
  24     }
  25     return $self;
  26 }
  27
  28 sub body                 { $_[0]->{body}    }
  29 sub name                 { $_[0]->{name}    }
  30 sub package_name         { $_[0]->{package} }
  31 sub associated_metaclass { $_[0]->{associated_metaclass} }
  32
  33 sub fully_qualified_name {
  34     my($self) = @_;
  35     return $self->package_name . '::' . $self->name;
  36 }
  37
  38 # for Moose compat
  39 sub _equal {
  40     my($l, $r) = @_;
  41
  42     return Scalar::Util::blessed($r)
  43             && $l->body         == $r->body
  44             && $l->name         eq $r->name
  45             && $l->package_name eq $r->package_name;
  46 }
  47
  48 1;
  49 __END__
  50
  51 =head1 NAME
  52
  53 Mouse::Meta::Method - A Mouse Method metaclass
  54
  55 =head1 VERSION
  56
  57 This document describes Mouse version 0.95
  58
  59 =head1 DESCRIPTION
  60
  61 This class is a meta object protocol for Mouse methods,
  62 which is a subset of Moose::Meta:::Method.
  63
  64 =head1 SEE ALSO
  65
  66 L<Moose::Meta::Method>
  67
  68 L<Class::MOP::Method>
  69
  70 =cut