From 83b59919d24a066fecf2048bc802f6211dbf6886 Mon Sep 17 00:00:00 2001
From: Don Armstrong <don@donarmstrong.com>
Date: Tue, 17 Feb 2004 04:59:37 +0000
Subject: [PATCH]  * Use METHODS as well as _methods in load  * Fix _clone
 calling  * Move DESTROY documentation  * Fix destroy calling

git-svn-id: file:///srv/don_svn/class_modular/trunk@18 96c6a18b-02ce-0310-9fca-9eb62c757ba6
---
 lib/Class/Modular.pm | 62 ++++++++++++++++++++++----------------------
 1 file changed, 31 insertions(+), 31 deletions(-)

diff --git a/lib/Class/Modular.pm b/lib/Class/Modular.pm
index 8fef35c..f66c520 100644
--- a/lib/Class/Modular.pm
+++ b/lib/Class/Modular.pm
@@ -83,9 +83,16 @@ sub load($$;$) {
 	  eval {
 	       no strict 'refs';
 	       eval "require $subclass" or die $@;
-	       # Use subclass::METHODS if it exists [use constants METHODS => qw(foo)]
-	       $self->_addmethods($subclass,&{"${subclass}::_methods"}($self,$options));
-	       &{"${subclass}::_init"}($self);
+	       my @methods = ();
+	       if (UNIVERSAL::can($subclass,'METHODS')) {
+		    push @methods,&{"${subclass}::METHODS"};
+	       }
+	       elsif (UNIVERSAL::can($subclass,'METHODS')) {
+		    push @methods,&{"${subclass}::_methods"};
+	       }
+	       $self->_addmethods($subclass,@methods);
+	       my $initref = UNIVERSAL::can($subclass,'_init');
+	       &$initref($self,$options) if defined $initref;
 	  };
 	  die $@ if $@;
 	  $self->{_subclasses}->{$subclass} = {};
@@ -158,11 +165,11 @@ sub clone {
 	  # XXX Switch to can instead.
 	  eval {
 	       no strict 'refs';
-	       &$subclass::_clone($self,$clone);
+	       &{"${subclass}::_clone"}($self,$clone);
 	  };
 	  if ($@) {
 	       # Die unless we've hit an undefined subroutine.
-	       die $@ unless $@ =~ /Undefined\s*subroutine\s*\&.*\:\:\_clone/;
+	       die $@ unless $@ =~ /Undefined\s*function\s*.*\:\:\_clone/;
 	       warn "$subclass doesn't have a _clone method\n$@" if $DEBUG;
 	  }
 
@@ -299,26 +306,10 @@ override _init.
 sub _init {
      my ($self,@creation_args) = @_;
 
-     $self->{creation_args} = [@_];
+     $self->{creation_args} = [@creation_args];
 }
 
 
-=head2 DESTROY
-
-=head3 Usage
-
-Called by perl.
-
-=head3 Function
-
-Calls all subclass _destroy methods.
-
-Subclasses need only implement a _destroy method if they have
-references that need to be uncircularized, or things that should be
-disconnected or closed.
-
-=cut
-
 =head2 _addmethods
 
 =head3 Usage
@@ -359,6 +350,22 @@ sub _addmethods($@) {
 
 }
 
+=head2 DESTROY
+
+=head3 Usage
+
+Called by perl.
+
+=head3 Function
+
+Calls all subclass _destroy methods.
+
+Subclasses need only implement a _destroy method if they have
+references that need to be uncircularized, or things that should be
+disconnected or closed.
+
+=cut
+
 
 
 sub DESTROY{
@@ -367,15 +374,8 @@ sub DESTROY{
 	  # use eval to try and call the subclasses _destroy method.
 	  # Ignore no such function errors, but trap other types of
 	  # errors.
-	  eval {
-	       no strict 'refs';
-	       &$subclass::_destroy($self);
-	  };
-	  if ($@) {
-	       # Die unless we've hit an undefined subroutine.
-	       die $@ unless $@ =~ /Undefined\s*subroutine\s*\&.*\:\:\_clone/;
-	       warn "$subclass doesn't have a _clone method\n$@" if $DEBUG;
-	  }
+	  my $destroy_func = UNIVERSAL::can($subclass,'_destroy');
+	  &$destroy_func($self) if defined $destroy_func;
      }
 }
 
-- 
2.39.2