From: Don Armstrong <don@donarmstrong.com>
Date: Fri, 24 Oct 2003 04:48:51 +0000 (+0000)
Subject:  * add subclass argument to _add_methods
X-Git-Url: https://git.donarmstrong.com/?p=class_modular.git%2F.git;a=commitdiff_plain;h=224fcb6757bfb0a16212c5e4f28725b33b970e68

 * 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 58025bf..f7ca9f1 100644
--- 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.