-# This module is part of DA, Don Armstrong's Modules, and is released
-# 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.8 2003/12/09 02:00:10 don Exp $
+# 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.
+# Copyright 2003, 2004 by Don Armstrong <don@donarmstrong.com>.
+# $Id$
package Class::Modular;
=head1 SYNOPSIS
-package Foo::Bar;
-
-@ISA = qw(Class::Modular);
+ package Foo::Bar;
+ use base qw(Class::Modular);
=head1 DESCRIPTION
without modifying the base classes. This allows for code to be more
modular, and reduces code duplication.
-=over
-
-=item new
-
-new is responsible for blessing and creating a new database superclass.
-
-=item load
-
-load is responsible for loading database plugins
-
-=back
-
+It fills the middle ground between traditional class based OOP and
+classless OOP. L<Class::Mutator> and L<Sex> are similar to
+Class::Modular but less manic.
=head1 FUNCTIONS
=cut
use strict;
-use vars qw($VERSION $DEBUG);
+use vars qw($VERSION $DEBUG $REVISION);
use Carp;
-use Data::Copy qw(deep_copy); # Used for deep copying objects
+use Storable qw(dclone); # Used for deep copying objects
BEGIN{
- ($VERSION) = q$Revision: 1.8 $ =~ /\$Revision:\s+([^\s+])/;
+ $VERSION = '0.1';
+ ($REVISION) = q$LastChangedRevision$ =~ /\$LastChangedRevision:\s+([^\s+])/;
$DEBUG = 0 unless defined $DEBUG;
}
our $AUTOLOAD;
-=head2 new
-
- Title : new
- Usage : $obj = Foo::Bar->new();
- Function: Creates a new Foo::Bar object
- Returns : A new Foo::Bar object
- Args : none.
-
- Aditional arguments can be passed to this creator, and they are
- stored in $self->{_creation_args}. You can also override the new
- method in your subclass. It's just provided here for completeness.
-
-=cut
-
-sub new {
- my ($class,@args) = @_;
-
- # We shouldn't be called $me->new, but just in case
- $class = ref($class) || $class;
-
- my $self = {};
- bless $self, $class;
-
- $self->_init(@args);
-
- return $self;
-}
-
-
-=head2 _init
+=head2 load
=head3 Usage
- $self->_init(@args);
+ $db->load('FOO::Subclass');
=head3 Function
-Stores the arguments used at new so modules that are loaded later can
-read them
-
-=cut
-
-sub _init {
- my ($self,@creation_args) = @_;
-
- $self->{creation_args} = [@_];
-}
-
-
-=head2 load
-
- Title : load
- Usage : $db->load('FOO::Subclass');
- Function: loads a Class::Modular subclass
- Returns : nothing
- Args : SCALAR subclass SCALAR options
-
- Loads the named subclass into this object if the named subclass has
- not been loaded.
+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.
+The options scalar is passed to $subclass::_methods when determining
+which methods should be added using _addmethods.
- The subclasses _init method is called right after methods are loaded.
+The subclasses _init method is called right after methods are loaded.
- If debugging is enabled, will warn about loading already loaded
- subclasses.
+If debugging is enabled, will warn about loading already loaded
+subclasses.
=cut
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);
};
}
}
-=head2 _addmethods
-
- Title : _addmethods
- Usage : $self->_addmethods()
- Function: Adds the passed methods into the function table
- Returns :
- Args : ARRAY of methods
-
- Given an array of methods, adds the methods into the _methodhash
- calling table.
-
- Methods that have previously been overridden by override are _NOT_
- overridden again. This may need to be adjusted in load.
-
-=cut
-
-sub _addmethods($@) {
- my ($self,$subclass,@methods) = @_;
-
- # stick the method into the table
- # DLA: Make with the munchies!
-
- foreach my $method (@methods) {
- 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;
- $self->{_methodhash}->{$method_name}->{subclass} = $subclass;
- }
+=head2 override
-}
+=head3 Usage
-=head2 override
+ $obj->override('methodname', $code_ref)
- Title : override
- Usage : $obj->override('methodname', $code_ref)
- Function: Overrides the method methodname and calls $code_ref instead.
- Returns : TRUE on success, FALSE on failure.
- Args : SCALAR method name
- CODEREF function reference
+=head3 Function
- Allows you to override utility functions that are called internally
- to provide a different default function.
+Allows you to override utility functions that are called internally to
+provide a different default function.
- It's superficially similar to _addmethods, which is called by load,
- but it deals with code references, and requires the method name to be
- known.
+It's superficially similar to _addmethods, which is called by load,
+but it deals with code references, and requires the method name to be
+known.
- Methods overridden here are _NOT_ overrideable in _addmethods. This
- may need to be changed.
+Methods overridden here are _NOT_ overrideable in _addmethods. This
+may need to be changed.
=cut
=head2 clone
- Title : clone
- Usage : my $clone = $obj->clone
- Function: Produces a clone of the Class::Modular object
- Returns :
- Args :
+=head3 Usage
+
+ my $clone = $obj->clone
- Produces a clone of the object with duplicates of all data and/or new
- connections as appropriate.
+=head3 Function
+
+Produces a clone of the object with duplicates of all data and/or new
+connections as appropriate.
- Calls _clone on all loaded subclasses.
+Calls _clone on all loaded subclasses.
- Warns if debugging is on for classes which don't have a _clone
- method. Dies on other errors.
+Warns if debugging is on for classes which don't have a _clone method.
+Dies on other errors.
=cut
bless $clone, ref($self);
# copy data structures at this level
- $clone->{_methodhash} = deep_copy($self->{_methodhash});
- $clone->{_subclasses} = deep_copy($self->{_subclasses});
+ $clone->{_methodhash} = dclone($self->{_methodhash});
+ $clone->{_subclasses} = dclone($self->{_subclasses});
foreach my $subclass (keys %{$self->{_subclasses}}) {
# use eval to try and call the subclasses _clone method.
return undef;
}
+=head1 INTERNAL FUNCTIONS
+
+The functions below are functions internal to Class::Modular. The
+first two, new and _init should probably be overriden in any class
+that inherits from Class::Modular, but they are provided just in case
+you don't want to write a new and/or _init.
+
+=cut
+
+=head2 new
+
+=head3 Usage
+
+ $obj = Foo::Bar->new();
+
+=head3 Function
+
+Creates a new C<Foo::Bar> object.
+
+Aditional arguments can be passed to this creator, and they are stored
+in C<$self->{_creation_args}>. You can also override the new method in
+your subclass. It's just provided here for completeness.
+
+=cut
+
+sub new {
+ my ($class,@args) = @_;
+
+ # We shouldn't be called $me->new, but just in case
+ $class = ref($class) || $class;
+
+ my $self = {};
+ bless $self, $class;
+
+ $self->_init(@args);
+
+ return $self;
+}
+
+
+=head2 _init
+
+=head3 Usage
+
+ $self->_init(@args);
+
+=head3 Function
+
+Stores the arguments used at new so modules that are loaded later can
+read them
+
+This function is called by default from new. Classes may only wish to
+override _init.
+
+=cut
+
+sub _init {
+ my ($self,@creation_args) = @_;
+
+ $self->{creation_args} = [@_];
+}
+
=head2 DESTROY
=cut
+=head2 _addmethods
+
+=head3 Usage
+
+ $self->_addmethods($subclass,&{"${subclass}::_methods"}($self,$options));
+
+=head3 Function
+
+Given an array of methods, adds the methods into the _methodhash
+calling table.
+
+Methods that have previously been overridden by override are _NOT_
+overridden again. This may need to be adjusted in load.
+
+=cut
+
+sub _addmethods($@) {
+ my ($self,$subclass,@methods) = @_;
+
+ # stick the method into the table
+ # DLA: Make with the munchies!
+
+ foreach my $method (@methods) {
+ 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;
+ $self->{_methodhash}->{$method_name}->{subclass} = $subclass;
+ }
+
+}
+
+
+
sub DESTROY{
my $self = shift;
foreach my $subclass (keys %{$self->{_subclasses}}) {
=head2 AUTOLOAD
- Title : AUTOLOAD
- Usage : Called by perl
- Function: Calls child methods which have been installed into this handle
- Returns : N/A
- Args : N/A
+=head3 Function
The AUTOLOAD function is responsible for calling child methods which
have been installed into the current Class::Modular handle.