* Move Class::Modular specific initialization to _init

[class_modular.git/.git] / Class / Modular / Modular.pm

diff --git a/Class/Modular/Modular.pm b/Class/Modular/Modular.pm
index 18cf89e652ae1cf2c13bbe15a6edacddb59510e3..7977e7e2ca44ccc0a88a6f37913d933bd2a15cf3 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.8 2003/12/09 02:00:10 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.8 $ =~ /\$Revision:\s+([^\s+])/;
      $DEBUG = 0 unless defined $DEBUG;
 }
 
@@ -82,12 +82,32 @@ sub new {
      my $self = {};
      bless $self, $class;
 
-     $self->{_creation_args} = [@args];
+     $self->_init(@args);
 
      return $self;
 }
 
 
+=head2 _init
+
+=head3 Usage
+
+     $self->_init(@args);
+
+=head3 Function
+
+Stores the arguments used at new so modules that are loaded later can
+read them
+
+=cut
+
+sub _init {
+     my ($self,@creation_args) = @_;
+
+     $self->{creation_args} = [@_];
+}
+
+
 =head2 load
 
  Title   : load
@@ -120,10 +140,11 @@ sub load($$;$) {
      if (not defined $self->{_subclasses}->{$subclass}){
          eval {
               no strict 'refs';
+              eval "require $subclass" or die $@;
               $self->_addmethods($subclass,&{"${subclass}::_methods"}($self,$options));
               &{"${subclass}::_init"}($self);
          };
-         warn $@ if $@;
+         die $@ if $@;
          $self->{_subclasses}->{$subclass} = {};
      }
      else {
@@ -155,7 +176,7 @@ sub _addmethods($@) {
 
      foreach my $method (@methods) {
          if (not $method =~ /^$subclass/) {
-              $method = $subclass.$method;
+              $method = $subclass.'::'.$method;
          }
          my ($method_name) = $method =~ /\:*([^\:]+)\s*$/;
          if (exists $self->{_methodhash}->{$method_name}) {
@@ -166,6 +187,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;
      }
 
 }
@@ -256,7 +278,8 @@ sub clone {
 =head3 Function
 
 Replaces UNIVERSAL's can method so that handled methods are reported
-correctly. Calls UNIVERSAL::can in the places where 
+correctly. Calls UNIVERSAL::can in the places where we don't know
+anything it doesn't.
 
 =head3 Returns
 
@@ -283,6 +306,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
 
@@ -350,12 +405,16 @@ sub AUTOLOAD{
         return;
      }
 
-     if (defined $self->{_methodhash}->{$method}->{reference}) {
+     if (exists $self->{_methodhash}->{$method} and
+        defined $self->{_methodhash}->{$method}->{reference}) {
          eval {
               no strict 'refs';
-              goto &$self->{_methodhash}->{$method}->{reference};
+              goto &{$self->{_methodhash}{$method}{reference}};
          }
      }
+     else {
+         croak "Undefined function $AUTOLOAD";
+     }
 }