X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FMethod.pm;h=a60ea25aa1d0e3366244c58be5f9cfe9168d41c8;hb=66e3df7a8d3d839b53f6fc3af8f4bad6fc27fefe;hp=561051a2f8fb35e5271be8985d19c7217e7b9e21;hpb=1e5823974a557bd35b4aa4a5c1d1aecf1e5483d2;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Meta/Method.pm b/lib/Mouse/Meta/Method.pm old mode 100755 new mode 100644 index 561051a..a60ea25 --- a/lib/Mouse/Meta/Method.pm +++ b/lib/Mouse/Meta/Method.pm @@ -1,23 +1,28 @@ package Mouse::Meta::Method; use Mouse::Util qw(:meta); # enables strict and warnings +use Scalar::Util (); use overload + '==' => '_equal', + 'eq' => '_equal', '&{}' => sub{ $_[0]->body }, fallback => 1, ; -sub wrap{ +sub wrap { my $class = shift; - + unshift @_, 'body' if @_ % 2 != 0; return $class->_new(@_); } sub _new{ - my $class = shift; - return $class->meta->new_object(@_) - if $class ne __PACKAGE__; + my($class, %args) = @_; + my $self = bless \%args, $class; - return bless {@_}, $class; + if($class ne __PACKAGE__){ + $self->meta->_initialize_object($self, \%args); + } + return $self; } sub body { $_[0]->{body} } @@ -26,10 +31,20 @@ sub package_name { $_[0]->{package} } sub associated_metaclass { $_[0]->{associated_metaclass} } sub fully_qualified_name { - my $self = shift; + my($self) = @_; return $self->package_name . '::' . $self->name; } +# 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__ @@ -39,7 +54,12 @@ Mouse::Meta::Method - A Mouse Method metaclass =head1 VERSION -This document describes Mouse version 0.40_06 +This document describes Mouse version 0.88 + +=head1 DESCRIPTION + +This class is a meta object protocol for Mouse methods, +which is a subset of Moose::Meta:::Method. =head1 SEE ALSO