From: Stevan Little <stevan.little@iinteractive.com>
Date: Wed, 25 Jan 2006 04:58:50 +0000 (+0000)
Subject: getting closer with the method thing
X-Git-Tag: 0_02~22
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c9b8b7f9e1177bd6917a1139fd5834dd1f09a6c7;p=gitmo%2FClass-MOP.git

getting closer with the method thing
---

diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index 277a212..79b267c 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -97,6 +97,7 @@ sub add_method {
     my $full_method_name = ($self->name . '::' . $method_name);    
         
     no strict 'refs';
+    no warnings 'redefine';
     *{$full_method_name} = subname $full_method_name => $method;
 }
 
@@ -107,7 +108,7 @@ sub add_method {
     my $_find_subroutine_name         = sub { eval { svref_2object($_[0])->GV->NAME        } };
 
     sub has_method {
-        my ($self, $method_name, $method) = @_;
+        my ($self, $method_name) = @_;
         (defined $method_name && $method_name)
             || confess "You must define a method name";    
     
@@ -123,14 +124,36 @@ sub add_method {
 }
 
 sub get_method {
-    my ($self, $method_name, $method) = @_;
+    my ($self, $method_name) = @_;
     (defined $method_name && $method_name)
         || confess "You must define a method name";
 
     no strict 'refs';    
     return \&{$self->name . '::' . $method_name} 
         if $self->has_method($method_name);   
-    return; # <--- make sure to return undef
+    return; # <- make sure to return undef
+}
+
+sub remove_method {
+    my ($self, $method_name) = @_;
+    (defined $method_name && $method_name)
+        || confess "You must define a method name";
+    
+    my $removed_method = $self->get_method($method_name);    
+    
+    no strict 'refs';
+    delete ${$self->name . '::'}{$method_name}
+        if defined $removed_method;
+        
+    return $removed_method;
+}
+
+sub get_method_list {
+    my $self = shift;
+    no strict 'refs';
+    grep { 
+        defined &{$self->name . '::' . $_} && $self->has_method($_) 
+    } %{$self->name . '::'};
 }
 
 1;
diff --git a/t/003_methods.t b/t/003_methods.t
index 06b4f37..24dde7a 100644
--- a/t/003_methods.t
+++ b/t/003_methods.t
@@ -5,6 +5,7 @@ use warnings;
 
 use Test::More no_plan => 1;
 use Test::Exception;
+use Test::Deep;
 
 BEGIN {
     use_ok('Class::MOP');   
@@ -77,10 +78,34 @@ ok(!$Foo->has_method('boom'), '... !Foo->has_method(boom) (defined in main:: usi
 ok(!$Foo->has_method('not_a_real_method'), '... !Foo->has_method(not_a_real_method) (does not exist)');
 is($Foo->get_method('not_a_real_method'), undef, '... Foo->get_method(not_a_real_method) == undef');
 
+is_deeply(
+    [ sort $Foo->get_method_list ],
+    [ qw(FOO_CONSTANT bang bar baz blah bling evaled_foo floob foo) ],
+    '... got the right method list for Foo');
+
+is($Foo->remove_method('foo'), $foo, '... removed the foo method');
+ok(!$Foo->has_method('foo'), '... !Foo->has_method(foo) we just removed it');
+dies_ok { Foo->foo } '... cannot call Foo->foo because it is not there';
+
+is_deeply(
+    [ sort $Foo->get_method_list ],
+    [ qw(FOO_CONSTANT bang bar baz blah bling evaled_foo floob) ],
+    '... got the right method list for Foo');
+
+ok($Foo->remove_method('FOO_CONSTANT'), '... removed the FOO_CONSTANT method');
+ok(!$Foo->has_method('FOO_CONSTANT'), '... !Foo->has_method(FOO_CONSTANT) we just removed it');
+dies_ok { Foo->FOO_CONSTANT } '... cannot call Foo->FOO_CONSTANT because it is not there';
+
+is_deeply(
+    [ sort $Foo->get_method_list ],
+    [ qw(bang bar baz blah bling evaled_foo floob) ],
+    '... got the right method list for Foo');
+
 # ... test our class creator 
 
 my $Bar = Class::MOP::Class->create(
             'Bar' => '0.10' => (
+                superclasses => [ 'Foo' ],
                 methods => {
                     foo => sub { 'Bar::foo' },
                     bar => sub { 'Bar::bar' },                    
@@ -100,3 +125,8 @@ lives_ok {
 
 ok($Bar->has_method('foo'), '... Bar-> (still) has_method(foo)');
 is(Bar->foo, 'Bar::foo v2', '... Bar->foo == "Bar::foo v2"');
+
+is_deeply(
+    [ sort $Bar->get_method_list ],
+    [ qw(bar foo) ],
+    '... got the right method list for Bar');