From e62017220f259704c70a9144bb8225fe543da4e9 Mon Sep 17 00:00:00 2001 From: Don Armstrong Date: Sat, 20 Nov 2004 05:28:33 +0000 Subject: [PATCH] * 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 --- lib/Class/Modular.pm | 95 ++++++++++++++++++++++++++++++++++++-------- t/01_module.t | 22 ++++++---- 2 files changed, 92 insertions(+), 25 deletions(-) diff --git a/lib/Class/Modular.pm b/lib/Class/Modular.pm index 2eb0251..7835b12 100644 --- 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 +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 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 17ce5ec..3f2f33d 100644 --- 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'); -- 2.39.2