1 # This file is part of Class::Modular and is released under the terms
2 # of the GPL version 2, or any later version at your option. See the
3 # file README and COPYING for more information.
4 # Copyright 2003, 2004 by Don Armstrong <don@donarmstrong.com>.
7 package Class::Modular;
11 Class::Modular -- Modular class generation superclass
17 use base qw(Class::Modular);
21 Class::Modular is a superclass for generating modular classes, where
22 methods can be added into the class from the perspective of the
23 object, rather than the perspective of the class.
25 That is, you can create a class which has a set of generic common
26 functions. Less generic functions can be included or overridden
27 without modifying the base classes. This allows for code to be more
28 modular, and reduces code duplication.
30 It fills the middle ground between traditional class based OOP and
31 classless OOP. L<Class::Mutator> and L<Sex> are similar to
32 Class::Modular but less manic.
39 use vars qw($VERSION $DEBUG $REVISION);
43 use Storable qw(dclone); # Used for deep copying objects
47 ($REVISION) = q$LastChangedRevision$ =~ /\$LastChangedRevision:\s+([^\s+])/;
48 $DEBUG = 0 unless defined $DEBUG;
57 $db->load('FOO::Subclass');
61 Loads the named subclass into this object if the named subclass has
64 The options scalar is passed to $subclass::_methods when determining
65 which methods should be added using _addmethods.
67 The subclasses _init method is called right after methods are loaded.
69 If debugging is enabled, will warn about loading already loaded
76 my ($self,$subclass,$options) = @_;
80 # check to see if the subclass has already been loaded.
82 if (not defined $self->{_subclasses}->{$subclass}){
85 eval "require $subclass" or die $@;
87 if (UNIVERSAL::can($subclass,'METHODS')) {
88 push @methods,&{"${subclass}::METHODS"};
90 elsif (UNIVERSAL::can($subclass,'METHODS')) {
91 push @methods,&{"${subclass}::_methods"};
93 $self->_addmethods($subclass,@methods);
94 my $initref = UNIVERSAL::can($subclass,'_init');
95 &$initref($self,$options) if defined $initref;
98 $self->{_subclasses}->{$subclass} = {};
101 carp "Not reloading subclass $subclass" if $DEBUG;
109 $obj->override('methodname', $code_ref)
113 Allows you to override utility functions that are called internally to
114 provide a different default function.
116 It's superficially similar to _addmethods, which is called by load,
117 but it deals with code references, and requires the method name to be
120 Methods overridden here are _NOT_ overrideable in _addmethods. This
121 may need to be changed.
126 my ($self, $method_name, $function_reference) = @_;
128 $self->{_methodhash}->{$method_name}->{reference} = $function_reference;
129 $self->{_methodhash}->{$method_name}->{overridden} = 1;
136 my $clone = $obj->clone
140 Produces a clone of the object with duplicates of all data and/or new
141 connections as appropriate.
143 Calls _clone on all loaded subclasses.
145 Warns if debugging is on for classes which don't have a _clone method.
146 Dies on other errors.
154 bless $clone, ref($self);
156 # copy data structures at this level
157 $clone->{_methodhash} = dclone($self->{_methodhash});
158 $clone->{_subclasses} = dclone($self->{_subclasses});
160 foreach my $subclass (keys %{$self->{_subclasses}}) {
161 # use eval to try and call the subclasses _clone method.
162 # Ignore no such function errors, but trap other types of
165 # XXX Switch to can instead.
168 &{"${subclass}::_clone"}($self,$clone);
171 # Die unless we've hit an undefined subroutine.
172 die $@ unless $@ =~ /Undefined\s*function\s*.*\:\:\_clone/;
173 warn "$subclass doesn't have a _clone method\n$@" if $DEBUG;
185 Class::Modular->can('METHOD');
189 Replaces UNIVERSAL's can method so that handled methods are reported
190 correctly. Calls UNIVERSAL::can in the places where we don't know
195 A coderef to the method if the method is supported, undef otherwise.
204 my ($self,$method,$vars) = @_;
206 if (ref $self and exists $self->{_methodhash}->{$method}) {
207 # If the method is defined, return a reference to the
209 return $self->{_methodhash}->{$method}->{reference};
212 # Otherwise, let UNIVERSAL::can deal with the method
214 return UNIVERSAL::can($self,$method);
222 $obj->handledby('methodname');
223 $obj->handledby('Class::Method::methodname');
227 Returns the subclass that handles this method.
240 my ($self,$method_name) = @_;
242 $method_name =~ s/.*\://;
244 if (exists $self->{_methodhash}->{$method_name}) {
245 return $self->{_methodhash}->{$method_name}->{subclass};
250 =head1 INTERNAL FUNCTIONS
252 The functions below are functions internal to Class::Modular. The
253 first two, new and _init should probably be overriden in any class
254 that inherits from Class::Modular, but they are provided just in case
255 you don't want to write a new and/or _init.
263 $obj = Foo::Bar->new();
267 Creates a new C<Foo::Bar> object.
269 Aditional arguments can be passed to this creator, and they are stored
270 in C<$self->{_creation_args}>. You can also override the new method in
271 your subclass. It's just provided here for completeness.
276 my ($class,@args) = @_;
278 # We shouldn't be called $me->new, but just in case
279 $class = ref($class) || $class;
298 Stores the arguments used at new so modules that are loaded later can
301 This function is called by default from new. Classes may only wish to
307 my ($self,@creation_args) = @_;
309 $self->{creation_args} = [@creation_args];
317 $self->_addmethods($subclass,&{"${subclass}::_methods"}($self,$options));
321 Given an array of methods, adds the methods into the _methodhash
324 Methods that have previously been overridden by override are _NOT_
325 overridden again. This may need to be adjusted in load.
329 sub _addmethods($@) {
330 my ($self,$subclass,@methods) = @_;
332 # stick the method into the table
333 # DLA: Make with the munchies!
335 foreach my $method (@methods) {
336 if (not $method =~ /^$subclass/) {
337 $method = $subclass.'::'.$method;
339 my ($method_name) = $method =~ /\:*([^\:]+)\s*$/;
340 if (exists $self->{_methodhash}->{$method_name}) {
341 if ($self->{_methodhash}->{$method_name}->{overridden}) {
342 carp "Not overriding already overriden method $method_name\n" if $DEBUG;
345 carp "Overriding $method_name $self->{_methodhash}->{$method_name}->{reference} with $method\n";
347 $self->{_methodhash}->{$method_name}->{reference} = $method;
348 $self->{_methodhash}->{$method_name}->{subclass} = $subclass;
361 Calls all subclass _destroy methods.
363 Subclasses need only implement a _destroy method if they have
364 references that need to be uncircularized, or things that should be
365 disconnected or closed.
373 foreach my $subclass (keys %{$self->{_subclasses}}) {
374 # use eval to try and call the subclasses _destroy method.
375 # Ignore no such function errors, but trap other types of
377 my $destroy_func = UNIVERSAL::can($subclass,'_destroy');
378 &$destroy_func($self) if defined $destroy_func;
387 The AUTOLOAD function is responsible for calling child methods which
388 have been installed into the current Class::Modular handle.
390 Subclasses that have a new function as well as an AUTOLOAD function
391 must call Class::Modular::AUTOLOAD and set $Class::Modular::AUTOLOAD
393 $Class::Modular::AUTOLOAD = $AUTOLOAD;
394 goto &Class::Modular::AUTOLOAD;
399 my $method = $AUTOLOAD;
405 if (not ref($self)) {
406 carp "Not a reference in AUTOLOAD.";
410 if (exists $self->{_methodhash}->{$method} and
411 defined $self->{_methodhash}->{$method}->{reference}) {
414 goto &{$self->{_methodhash}{$method}{reference}};
418 croak "Undefined function $AUTOLOAD";