* Added handled_by support (returns subclass name)

git-svn-id: file:///srv/don_svn/class_modular/trunk@6 96c6a18b-02ce-0310-9fca-9eb62c757ba6

diff --git a/Class/Modular/Modular.pm b/Class/Modular/Modular.pm
index 18cf89e652ae1cf2c13bbe15a6edacddb59510e3..c77b7b6bb36d4c2faf4ff74261c333af77408575 100644 (file)
--- a/Class/Modular/Modular.pm
+++ b/Class/Modular/Modular.pm
@@ -2,7 +2,7 @@
 # under the terms of the GPL version 2, or any later version. See the
 # file README and COPYING for more information. Copyright 2003 by Don
 # Armstrong <don@donarmstrong.com>.
-# $Id: Modular.pm,v 1.5 2003/10/25 02:15:04 don Exp $
+# $Id: Modular.pm,v 1.6 2003/10/25 03:01:35 don Exp $
 
 package Class::Modular;
 
@@ -53,7 +53,7 @@ use Carp;
 use Data::Copy qw(deep_copy); # Used for deep copying objects
 
 BEGIN{
-     ($VERSION) = q$Revision: 1.5 $ =~ /\$Revision:\s+([^\s+])/;
+     ($VERSION) = q$Revision: 1.6 $ =~ /\$Revision:\s+([^\s+])/;
      $DEBUG = 0 unless defined $DEBUG;
 }
 
@@ -166,6 +166,7 @@ sub _addmethods($@) {
               carp "Overriding $method_name $self->{_methodhash}->{$method_name}->{reference} with $method\n";
          }
          $self->{_methodhash}->{$method_name}->{reference} = $method;
+         $self->{_methodhash}->{$method_name}->{subclass} = $subclass;
      }
 
 }
@@ -283,6 +284,38 @@ sub can{
      }
 }
 
+=head2 handledby
+
+=head3 Usage
+
+     $obj->handledby('methodname');
+     $obj->handledby('Class::Method::methodname');
+
+=head3 Function
+
+Returns the subclass that handles this method.
+
+=head3 Returns
+
+SCALAR subclass name
+
+=head3 Args
+
+SCALAR method name
+
+=cut
+
+sub handledby{
+     my ($self,$method_name) = @_;
+
+     $method_name =~ s/.*\://;
+
+     if (exists $self->{_methodhash}->{$method_name}) {
+         return $self->{_methodhash}->{$method_name}->{subclass};
+     }
+     return undef;
+}
+
 
 =head2 DESTROY