* add subclass argument to _add_methods

 * Fix Symbolic reference call appropriately
 * Various other bonehead mistakes cleared up for Blootbot2

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

diff --git a/Class/Modular/Modular.pm b/Class/Modular/Modular.pm
index 58025bfe66a820416bb25b728ab077eb30f88154..f7ca9f17e6e62038152c078f15bb12124514ff5e 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.3 2003/09/13 05:46:53 don Exp $
+# $Id: Modular.pm,v 1.4 2003/10/24 04:48:51 don Exp $
 
 package Class::Modular;
 
@@ -55,7 +55,7 @@ use Carp;
 use Data::Copy qw(deep_copy); # Used for deep copying objects
 
 BEGIN{
-     ($VERSION) = q$Revision: 1.3 $ =~ /\$Revision:\s+([^\s+])/;
+     ($VERSION) = q$Revision: 1.4 $ =~ /\$Revision:\s+([^\s+])/;
      $DEBUG = 0 unless defined $DEBUG;
 }
 
@@ -122,8 +122,8 @@ sub load($$;$) {
      if (not defined $self->{_subclasses}->{$subclass}){
          eval {
               no strict 'refs';
-              $self->_addmethods($subclass::_methods($self,$options));
-              $subclass::_init($self);
+              $self->_addmethods($subclass,&{"${subclass}::_methods"}($self,$options));
+              &{"${subclass}::_init"}($self);
          };
          warn $@ if $@;
          $self->{_subclasses}->{$subclass} = {};
@@ -150,18 +150,21 @@ sub load($$;$) {
 =cut
 
 sub _addmethods($@) {
-     my ($self,@methods) = @_;
+     my ($self,$subclass,@methods) = @_;
 
      # stick the method into the table
      # DLA: Make with the munchies!
 
      foreach my $method (@methods) {
-         my ($method_name) = $method =~ /\:*([^\:]+)$/;
-         if ($self->{_methodhash}->{$method_name}->{overridden}) {
-              carp "Not overriding already overriden method $method_name\n" if $DEBUG;
-              next;
+         if (not $method =~ /^$subclass/) {
+              $method = $subclass.$method;
          }
+         my ($method_name) = $method =~ /\:*([^\:]+)\s*$/;
          if (exists $self->{_methodhash}->{$method_name}) {
+              if ($self->{_methodhash}->{$method_name}->{overridden}) {
+                   carp "Not overriding already overriden method $method_name\n" if $DEBUG;
+                   next;
+              }
               carp "Overriding $method_name $self->{_methodhash}->{$method_name}->{reference} with $method\n";
          }
          $self->{_methodhash}->{$method_name}->{reference} = $method;
@@ -231,7 +234,7 @@ sub clone {
          # errors.
 
          eval {
-              no strict refs;
+              no strict 'refs';
               &$subclass::_clone($self,$clone);
          };
          if ($@) {
@@ -268,8 +271,8 @@ sub DESTROY{
          # Ignore no such function errors, but trap other types of
          # errors.
          eval {
-              no strict refs;
-              &$subclass::_destroy($self,$clone);
+              no strict 'refs';
+              &$subclass::_destroy($self);
          };
          if ($@) {
               # Die unless we've hit an undefined subroutine.