X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FModule.pm;h=091b8ef05f80eb6fbfa9e6eb030b7f059462b310;hp=8dedd7e530f5a9822618b5692275b0575d146743;hb=08f7a8dbc5e48fcece4396a500d37bb2c6e45b74;hpb=8536d351614f3b40a7fba3847438fb4803b2559b

diff --git a/lib/Mouse/Meta/Module.pm b/lib/Mouse/Meta/Module.pm
index 8dedd7e..091b8ef 100755
--- a/lib/Mouse/Meta/Module.pm
+++ b/lib/Mouse/Meta/Module.pm
@@ -2,9 +2,9 @@ package Mouse::Meta::Module;
 use strict;
 use warnings;
 
-use Mouse::Util qw/get_code_info/;
-use Scalar::Util qw/blessed/;
-use Carp ();
+use Mouse::Util qw/get_code_info not_supported load_class/;
+use Scalar::Util qw/blessed weaken/;
+
 
 {
     my %METACLASS_CACHE;
@@ -20,13 +20,13 @@ use Carp ();
         my($class, $package_name, @args) = @_;
 
         ($package_name && !ref($package_name))
-            || confess("You must pass a package name and it cannot be blessed");
+            || $class->throw_error("You must pass a package name and it cannot be blessed");
 
         return $METACLASS_CACHE{$package_name}
             ||= $class->_new(package => $package_name, @args);
     }
 
-    sub Mouse::class_of{
+    sub class_of{
         my($class_or_instance) = @_;
         return undef unless defined $class_or_instance;
         return $METACLASS_CACHE{ blessed($class_or_instance) || $class_or_instance };
@@ -45,6 +45,8 @@ use Carp ();
 
 }
 
+sub meta{ Mouse::Meta::Class->initialize(ref $_[0] || $_[0]) }
+
 sub _new{ Carp::croak("Mouse::Meta::Module is an abstract class") }
 
 sub name { $_[0]->{package} }
@@ -67,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};
@@ -78,10 +81,10 @@ sub add_method {
     my($self, $name, $code) = @_;
 
     if(!defined $name){
-        confess "You must pass a defined name";
+        $self->throw_error("You must pass a defined name");
     }
     if(ref($code) ne 'CODE'){
-        confess "You must pass a CODE reference";
+        not_supported 'add_method for a method object';
     }
 
     $self->_method_map->{$name}++; # Moose stores meta object here.
@@ -111,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 {
@@ -123,7 +140,7 @@ sub get_method_list {
 sub throw_error{
     my($class, $message, %args) = @_;
 
-    local $Carp::CarpLevel  = $Carp::CarpLevel + ($args{depth} || 1);
+    local $Carp::CarpLevel  = $Carp::CarpLevel + 1 + ($args{depth} || 0);
     local $Carp::MaxArgNums = 20; # default is 8, usually we use named args which gets messier though
 
     if(exists $args{longmess} && !$args{longmess}){ # intentionaly longmess => 0