* 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

diff --git a/lib/Class/Modular.pm b/lib/Class/Modular.pm
index 8fef35cc42e1aa927174bcbe487854a422e30ed2..f66c520e1260836179d58274d21207ad02b39adc 100644 (file)
--- 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;
      }
 }