* We now follow the subclasses @METHOD and @SUB_MODULE arrays if they

   exist, so the most common instance doesn't need an _init and a
   _methods class
 * Updated documentation for the above
 * Updated SYNOPSIS for the above
 * Added is_loaded function to Class::Modular
 * 01_module.t now uses Test::More
   - use_ok('Class::Modular')
   - test the new @METHOD functionality
   - Add emacs modeline

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

diff --git a/lib/Class/Modular.pm b/lib/Class/Modular.pm
index 2eb025148f1326d0b438f3178085f6cad1e5a4a1..7835b1224fd1731f764c28ccc9964181a61815a2 100644 (file)
--- a/lib/Class/Modular.pm
+++ b/lib/Class/Modular.pm
@@ -16,11 +16,12 @@ Class::Modular -- Modular class generation superclass
 
      use base qw(Class::Modular);
 
-     sub new {
-         my $class = shift;
-          my $self = bless {}, ref($class) || $class;
-         $self->SUPER::_init(@_);
-         return $self;
+     use vars (@METHODS);
+     BEGIN{@METHODS=qw(blah)};
+
+     sub blah{
+         my $self = shift;
+         return 1;
      }
 
      [...]
@@ -41,7 +42,7 @@ Class::Modular -- Modular class generation superclass
 
      $foo = new Foo;
      $foo->load('Bar');
-     $foo->method_that_bar_provides;
+     $foo->blah && $foo->method_that_bar_provides;
 
 
 =head1 DESCRIPTION
@@ -87,18 +88,42 @@ our $AUTOLOAD;
 
 =head2 load
 
-     $db->load('FOO::Subclass');
+     $cm->load('Subclass');
+     # or
+     $cm->load('Subclass',$options);
 
-Loads the named subclass into this object if the named subclass has
+Loads the named Subclass into this object if the named Subclass has
 not been loaded.
 
-The options scalar is passed to $subclass::_methods when determining
-which methods should be added using _addmethods.
+If debugging is enabled, will warn about loading already loaded
+subclasses. Use C<$cm->is_loaded('Subclass')> to avoid these warnings.
 
-The subclasses _init method is called right after methods are loaded.
+=head3 Methods
 
-If debugging is enabled, will warn about loading already loaded
-subclasses.
+If the subclass has a C<_methods> function (or at least,
+UNIVERSAL::can thinks it does), C<_methods> is called to return a LIST
+of methods that the subclass wishes to handle. The L<Class::Modular>
+object and the options SCALAR are passed to the _methods function.
+
+If the subclass does not have a C<_methods> function, then the array
+C<@{"${subclass}::METHODS"}> is used to determine the methods that the
+subclass will handle.
+
+=head3 _init and required submodules
+
+If the subclass has a C<_init> function (or at least, UNIVERSAL::can
+thinks it does), C<_init> is called right after the module is
+loaded. The L<Class::Modular> object and the options SCALAR are passed
+to the _methods function. Typical uses for this call are to load other
+required submodules.
+
+As this is the most common thing to do in C<_init>, if a subclass
+doesn't have one, then the array C<@{"${subclass}::SUB_MODULES"}> is
+used to determine the subclass that need to be loaded:
+
+    for my $module (@{"${subclass}::SUB_MODULES"}) {
+        $self->is_loaded($module) || $self->load($module);
+    }
 
 =cut
 
@@ -116,17 +141,53 @@ sub load($$;$) {
               # for a non method is deprecated. Bite me.
               no warnings 'deprecated';
               eval "require $subclass" or die $@;
-              $self->_addmethods($subclass,&{"${subclass}::_methods"}($self,$options));
-              &{"${subclass}::_init"}($self);
+              # We should read @METHODS and @SUB_MODULES and just do
+              # the right thing if at all possible.
+              my $methods = can($subclass,"_methods");
+              if (defined $methods) {
+                   $self->_addmethods($subclass,&$methods($self,$options));
+              }
+              else {
+                   $self->_addmethods($subclass,@{"${subclass}::METHODS"})
+              }
+              my $init = can($subclass,"_init");
+              if (defined $init) {
+                   &$init($self,$options);
+              }
+              else {
+                   for my $module (@{"${subclass}::SUB_MODULES"}) {
+                        $self->is_loaded($module) || $self->load($module);
+                   }
+              }
          };
-         die $@ if $@ and $@ !~ /^Undefined function ${subclass}::_init at [^\n]*$/;
-         $self->{$cm}{_subclasses}{$subclass} = {};
+         die $@ if $@;
+         $self->{$cm}{_subclasses}{$subclass} ||= {};
      }
      else {
          carp "Not reloading subclass $subclass" if $DEBUG;
      }
 }
 
+=head2 is_loaded
+
+     if ($cm->is_loaded('Subclass')) {
+           # do something
+     }
+
+Tests to see if the named subclass is loaded.
+
+Returns 1 if the subclass has been loaded, 0 otherwise.
+
+=cut
+
+sub is_loaded($$){
+     my ($self,$subclass) = @_;
+
+     # An entry will exist in the _subclasses hashref only if 
+     return 1 if exists $self->{$cm}{_subclasses}{$subclass}
+         and defined $self->{$cm}{_subclasses}{$subclass};
+     return 0;
+}
 
 =head2 override
 

diff --git a/t/01_module.t b/t/01_module.t
index 17ce5ec528bde92b0130fe50d8a4e16f75bdf3d8..3f2f33d36f53302961caad53c5e1c464fae9e949 100644 (file)
--- a/t/01_module.t
+++ b/t/01_module.t
@@ -1,3 +1,4 @@
+# -*- mode: cperl;-*-
 # This file is part of Class::Modular and is released under the terms
 # of the GPL version 2, or any later version at your option. See the
 # file README and COPYING for more information.
@@ -5,10 +6,12 @@
 # $Id: $
 
 
-use Test::Simple tests => 9;
+use Test::More tests => 11;
 
 use UNIVERSAL;
 
+use_ok('Class::Modular');
+
 my $destroy_hit = 0;
 
 {
@@ -16,17 +19,17 @@ my $destroy_hit = 0;
      $INC{'Foo.pm'} = '1';
      package Foo;
 
+     use vars qw(@METHODS);
+     BEGIN {
+         @METHODS = qw(blah);
+     }
+
      use base qw(Class::Modular);
-     use constant METHODS => 'blah';
 
      sub blah {
          return 1;
      }
 
-     sub _methods {
-          return qw(blah);
-     }
-
      sub _destroy{
          $destroy_hit = 1;
      }
@@ -38,7 +41,6 @@ my $destroy_hit = 0;
      package Bar;
 
      use base qw(Class::Modular);
-     use constant METHODS => 'bleh';
 
      sub bleh {
          return 1;
@@ -58,7 +60,7 @@ my $foo = new Foo(qw(bar baz));
 ok(defined $foo and UNIVERSAL::isa($foo,'Class::Modular'), 'new() works');
 
 # 2: test load()
-ok(exists $foo->{__class_modular}{_subclasses}{Foo}, 'load() works');
+ok($foo->is_loaded('Foo'), 'load and is_loaded work');
 # 3: test AUTOLOAD
 ok($foo->blah, 'AUTOLOAD works');
 
@@ -86,3 +88,7 @@ eval {my $bar = new Bar();
       undef $bar;
  };
 ok($@ eq '','Non existant _destroy not a problem');
+
+# Check _methods way of defining methods
+my $bar = new Bar;
+ok($bar->bleh, '_methods function works to define methods');