X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FMethod.pm;h=5d3fdda65511187d47a7f46a9e49892cb4a8bed7;hb=29b12beade3d94ce04739d0c7c77316f528af9b2;hp=9c0b5e3477fed978ed4006b3dfcc5222abb66d04;hpb=53875581c2449e237cc1135b8c2cf1674a874aed;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Meta/Method.pm b/lib/Mouse/Meta/Method.pm index 9c0b5e3..5d3fdda 100755 --- a/lib/Mouse/Meta/Method.pm +++ b/lib/Mouse/Meta/Method.pm @@ -1,25 +1,50 @@ package Mouse::Meta::Method; -use strict; -use warnings; - -use Mouse::Util qw(:meta); +use Mouse::Util qw(:meta); # enables strict and warnings use overload - '&{}' => 'body', + '&{}' => sub{ $_[0]->body }, fallback => 1, ; -sub new{ - my($class, %args) = @_; +sub wrap{ + my $class = shift; - return bless \%args, $class; + return $class->_new(@_); } -sub body { $_[0]->{body} } -sub name { $_[0]->{name} } -sub package_name{ $_[0]->{package} } +sub _new{ + my $class = shift; + return $class->meta->new_object(@_) + if $class ne __PACKAGE__; + return bless {@_}, $class; +} -1; +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 = shift; + return $self->package_name . '::' . $self->name; +} + +1; __END__ + +=head1 NAME + +Mouse::Meta::Method - A Mouse Method metaclass + +=head1 VERSION + +This document describes Mouse version 0.40_01 + +=head1 SEE ALSO + +L + +L + +=cut