X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FMethod.pm;h=c6aa879ddf92bf1629a3a4550939cd5c0324fa51;hb=86eb0b5e6f0c2d89a6c86516e7bccbf9c7daba1f;hp=cbe349aa561c20ed0de1f0cd45478587c77da64f;hpb=1820fffecb0bd1da64edc16ecde534178b841d14;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Meta/Method.pm b/lib/Mouse/Meta/Method.pm index cbe349a..c6aa879 100755 --- a/lib/Mouse/Meta/Method.pm +++ b/lib/Mouse/Meta/Method.pm @@ -1,35 +1,70 @@ package Mouse::Meta::Method; -use strict; -use warnings; - -use Mouse::Util qw(:meta); +use Mouse::Util qw(:meta); # enables strict and warnings +use Scalar::Util (); use overload - '&{}' => 'body', + '==' => '_equal', + 'eq' => '_equal', + '&{}' => sub{ $_[0]->body }, fallback => 1, ; -sub new{ +sub wrap{ + my $class = shift; + + return $class->_new(@_); +} + +sub _new{ my($class, %args) = @_; + my $self = bless \%args, $class; - return bless \%args, $class; + if($class ne __PACKAGE__){ + $self->meta->_initialize_object($self, \%args); + } + return $self; } -sub body { $_[0]->{body} } -sub name { $_[0]->{name} } -sub package_name{ $_[0]->{package} } +sub body { $_[0]->{body} } +sub name { $_[0]->{name} } +sub package_name { $_[0]->{package} } +sub associated_metaclass { $_[0]->{associated_metaclass} } +sub fully_qualified_name { + my($self) = @_; + return $self->package_name . '::' . $self->name; +} -1; +# for Moose compat +sub _equal { + my($l, $r) = @_; + + return Scalar::Util::blessed($r) + && $l->body == $r->body + && $l->name eq $r->name + && $l->package_name eq $r->package_name; +} +1; __END__ =head1 NAME Mouse::Meta::Method - A Mouse Method metaclass +=head1 VERSION + +This document describes Mouse version 0.70 + +=head1 DESCRIPTION + +This class is a meta object protocol for Mouse methods, +which is a subset of Moose::Meta:::Method. + =head1 SEE ALSO L +L + =cut