X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FModule.pm;h=6e4179b765c238c7a348701e564816b045ee73e7;hb=ad022aac12ce95ee336af9dde0758ae98037f3ab;hp=fa99e17a5f800d8e82204e9df33c62b9306fd7b7;hpb=fce211ae5c3943a1b041b9c0985c4daf189fb8a8;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Meta/Module.pm b/lib/Mouse/Meta/Module.pm index fa99e17..6e4179b 100755 --- a/lib/Mouse/Meta/Module.pm +++ b/lib/Mouse/Meta/Module.pm @@ -2,8 +2,8 @@ package Mouse::Meta::Module; use strict; use warnings; -use Mouse::Util qw/get_code_info not_supported/; -use Scalar::Util qw/blessed/; +use Mouse::Util qw/get_code_info not_supported load_class/; +use Scalar::Util qw/blessed weaken/; { @@ -69,6 +69,7 @@ sub get_attribute_map { $_[0]->{attributes} } sub has_attribute { exists $_[0]->{attributes}->{$_[1]} } sub get_attribute { $_[0]->{attributes}->{$_[1]} } sub get_attribute_list{ keys %{$_[0]->{attributes}} } +sub remove_attribute { delete $_[0]->{attributes}->{$_[1]} } sub namespace{ my $name = $_[0]->{package}; @@ -113,7 +114,21 @@ sub has_method { } sub get_method{ - Carp::croak("get_method() is not yet implemented"); + my($self, $method_name) = @_; + + if($self->has_method($method_name)){ + my $method_metaclass = $self->method_metaclass; + load_class($method_metaclass); + + my $package = $self->name; + return $method_metaclass->new( + body => $package->can($method_name), + name => $method_name, + package => $package, + ); + } + + return undef; } sub get_method_list {