[Templates-cvs] cvs commit: TT3/lib/Template Factory.pm
cvs@template-toolkit.org
cvs@template-toolkit.org
Fri, 10 Dec 2004 10:44:38 +0000
cvs 04/12/10 10:44:38
Added: lib/Template Factory.pm
Log:
* moved Template::Modules to Template::Factory
Revision Changes Path
1.1 TT3/lib/Template/Factory.pm
Index: Factory.pm
===================================================================
#========================================================================
#
# Template::Factory
#
# DESCRIPTION
# Base class factory module for defining collections of other Perl
# modules. Subclasses can then implement more specific behaviours,
# such as loading on demand, instantiating a singleton or new object
# instance on each request, and so on.
#
# AUTHOR
# Andy Wardley <abw@wardley.org>
#
# COPYRIGHT
# Copyright (C) 1996-2004 Andy Wardley. All Rights Reserved.
#
# This module is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# REVISION
# $Id: Factory.pm,v 1.1 2004/12/10 10:44:38 abw Exp $
#
#========================================================================
package Template::Factory;
use strict;
use warnings;
use Template::Utils;
use Template::Base;
use base qw( Template::Base );
our $VERSION = sprintf("%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/);
our $DEBUG = 0 unless defined $DEBUG;
our $ERROR = '';
our $THROW = 'factory'; # name used for throwing errors
our $NAME = 'modules'; # name used as configuration parameter
our $UTILS = 'Template::Utils';
our $MODULES = { } unless defined $MODULES;
our $LOADED = { } unless defined $LOADED;
our $PATH = [ ];
sub init {
my ($self, $config) = @_;
my $class = ref $self || $self;
# use name provided in config hash, or defined in $NAME package
# var, as an identifier indicating further items of interest in
# the config. By default this is 'modules', so any extra modules
# are defined in config as C<modules => { ... }>, but this can
# be redefined by a subclass, e.g. C<plugins => { ... }>
my $name = $self->{ name }
= $config->{ name }
|| $self->pkgvar( NAME => $NAME );
# merge $MODULES and any other $name items defined in config
my $pkgmods = $self->pkgvar( MODULES => $MODULES );
my $cfgmods = $config->{ $name } || { };
my $modules = $self->{ modules } = {
%$pkgmods,
%$cfgmods,
};
# extract any $config items into separate hash arrays, based on
# the keys in $modules
$self->{ config } = $UTILS->hash_extract($config, [ keys %$modules ]);
return $self;
}
#------------------------------------------------------------------------
# fetch($context, $name)
#
# This method implements an access point for a Template::Context object
# to query it as a provider. We ignore the context reference passed as
# the first argument (although subclasses are free to do otherwise) and
# delegate to the module() method.
#------------------------------------------------------------------------
sub fetch {
my $self = shift;
my $context = shift;
return $self->module(@_);
}
#------------------------------------------------------------------------
# module($name)
#
# Returns the name of the module associated with $name, loading it if
# necessary.
#------------------------------------------------------------------------
sub module {
my ($self, $name) = @_;
$self->debug("module($name)\n") if $DEBUG;
my $modules = $self->modules() || return;
my $module = $modules->{ $name };
if ($module) {
return $module;
}
elsif (defined $module) {
# defined but false indicates module disabled
return $self->decline("module disabled: $name");
}
else {
# not found
return $self->decline("module not found: $name");
}
}
#------------------------------------------------------------------------
# modules()
#
# Return $self->{ modules } if called as an object method, or the
# $MODULES package variable if called as a class method. Either way
# you get a hash of modules.
#------------------------------------------------------------------------
sub modules {
my $self = shift;
return ref $self
? $self->{ modules }
: $self->pkgvar( MODULES => $MODULES );
}
#------------------------------------------------------------------------
# config($name)
#
# Provides access to configuration items destined for each module in the
# collection, as provided as parameters to the new() constructor.
#------------------------------------------------------------------------
sub config {
my $self = shift;
my $config = $self->{ config };
# return entire hash if no name argument provided
return $config unless @_;
# provide sub-hash for named item
my $name = shift;
return $config->{ $name }
|| $self->decline("no config for $name");
}
#------------------------------------------------------------------------
# name()
#
# Returns the factory name, provided as a constructor parameter or
# defined in the $NAME package variable.
#------------------------------------------------------------------------
sub name {
my $self = shift;
return ref $self
? $self->{ name }
: $self->pkgvar( NAME => $NAME );
}
1;
__END__
=head1 NAME
Template::Factory - base class factory for other Perl modules
=head1 SYNOPSIS
TODO: change Template::Modules to Template::Factory
Example 1 - using Template::Modules
my $modules = Template::Modules->new({
modules => {
foo => 'My::Foo::Module',
bar => 'My::Bar::Module',
baz => 'My::Baz::Module',
},
});
# loads module, returns 'My::Foo::Module' class name
my $foo = $modules->module('foo')
|| die $modules->error();
Example 2 - subclassing Template::Modules
package My::Modules;
use base 'Template::Modules';
our $MODULES = {
foo => 'My::Foo::Module',
bar => 'My::Bar::Module',
baz => 'My::Baz::Module',
};
package main;
# calling module() as a class method
my $foo = My::Modules->module('foo')
|| die My::Modules->error();
# create an object with more modules
my $modules = My::Modules->new({
modules => {
wiz => 'My::Wiz::Module',
waz => 'My::Waz::Module',
},
});
# foo module is defined automatically by subclass
my $foo = $modules->module('foo')
|| die $modules->error();
# wiz module provided in constructor parameters
my $wiz = $modules->module('wiz')
|| die $modules->error();
Example 3 - defining a search path
my $modules = Template::Modules->new({
path => 'My::Module Your::Module',
});
# looks for My::Module::Foo or Your::Module::Foo
my $foo = $modules->module('Foo')
|| die $modules->error();
Example 4 - defining a search path in a subclass
package My::Modules;
use base 'Template::Modules';
our $PATH = ['My::Module', 'Your::Module'];
package main;
# looks for My::Module::Foo or Your::Module::Foo
my $foo = My::Modules->module('Foo')
|| die My::Modules->error();
=head1 DESCRIPTION
This modules implements a base class factory for loading other Perl modules.
=head1 METHODS
=head2 new()
Constructor method (implemented by the Template::Base base class module) which
creates a new Template::Modules object.
The following options can be provided.
=head3 modules
A reference to a hash array mapping simple names to module names.
use Template::Modules;
my $modules = Template::Modules->new({
modules => {
foo => 'My::Foo::Module',
bar => 'My::Bar::Module',
baz => 'My::Baz::Module',
},
});
=head3 loaded
This item can be used to specify which modules have already been loaded or
don't need to be loaded when used. The following example shows how the
My::Foo::Module is already loaded via C<use>, and the My::Bar::Module is
defined inline. Neither of these need to loaded by the Template::Modules
object (and indeed, My::Bar::Module could not be loaded), so the C<loaded>
configuration item indicates this. The value should be a string of whitespace
delimited module identifiers (e.g. the keys in the C<modules> hash).
use Template::Modules;
use My::Foo::Module;
package My::Bar::Module;
# ...some code defining a class inline...
package main;
my $modules = Template::Modules->new({
modules => {
foo => 'My::Foo::Module',
bar => 'My::Bar::Module',
baz => 'My::Baz::Module',
},
loaded => 'foo bar',
});
# returns 'My::Foo::Module' without loading it
my $foo_mod = $modules->module('foo')
|| die $modules->error();
# same for 'My::Bar::Module'
my $bar_mod = $modules->module('bar')
|| die $modules->error();
# loads module and returns 'My::Baz::Module'
my $baz_mod = $modules->module('baz')
|| die $modules->error();
=head3 path
This item can be used to define a default search path for locating modules.
It can be provided as a reference to a list, or as a string containing
whitespace delimited module paths.
# either: reference to a list
my $modules = Template::Modules->new({
path => [ 'My::Module', 'Your::Module' ],
});
# or: whitespace-delimited string
my $modules = Template::Modules->new({
path => 'My::Module Your::Module',
});
# looks for My::Module::Foo::Bar or Your::Module::Foo::Bar
my $module = $modules->module('Foo::Bar')
|| die $modules->error();
The C<path> is only consulted if a module is not explicitly defined in the
C<modules> hash.
The C<path> can be set to 0 to indicate that no path searching should be
done. The base class Template::Modules module doesn't do any path searching
by default, so this has no effect. However, a module subclassed from
Template::Modules may defined a default path in a C<$PATH> package variable.
package My::Modules;
use base 'Template::Modules';
our $PATH = ['My::Module', 'Your::Module'];
package main;
my $modules = My::Modules->new();
# looks for 'My::Module::Foo::Bar' or 'Your::Module::Foo::Bar'
my $foo =$modules->module('Foo::Bar')
|| die $modules->error();
We can provide a new path parameter to override the default:
my $modules = My::Modules->new( path => 'Their::Module' );
# looks for 'Their::Module::Foo::Bar'
my $foo =$modules->module('Foo::Bar')
|| die $modules->error();
Or we can disable the path search altogether by providing a reference to
an empty list or a false value (e.g. 0).
my $modules = My::Modules->new( path => 0 );
# looks only for 'Foo::Bar'
my $foo =$modules->module('Foo::Bar')
|| die $modules->error();
=head2 module($name)
This method returns the full name of the Perl module associated with the name
passed as an argument. The module is loaded (if necessary) via an internal
call to the C<load()> method.
# load the module and fetch class name
my $foo = $modules->module('foo')
|| die $modules->error();
# create an object from the class name returned
my $object = $foo->new()
|| die $foo->error();
The module() method can also be called as a class method. This is typically
used when subclassing the module to define a custom set of modules in a
C<$MODULES> package variable.
package My::Modules;
use base 'Template::Modules';
our $MODULES = {
foo => 'My::Foo::Module',
bar => 'My::Bar::Module',
baz => 'My::Baz::Module',
};
package main;
my $foo = My::Modules->module('foo')
|| die My::Modules->error();
=head2 modules()
Returns a reference to a hash of the modules defined. When called as a class
method, it returns a reference to the C<$MODULES> package variable (which may
be defined in a subclass of Template::Modules, as shown in the previous example).
When called as an object method, it returns the internal C<modules> item containing
the combined contents of the C<$MODULES> package variable and any other modules
defined in the the parameters passed to the C<new()> constructor method.
=head2 load($name)
This method loads the module associated with the name passed as a
first argument, unless it has already been loaded, or was defined in
the C<loaded> parameter passed to the C<new()> constructor method.
It first looks for a module defined in the C<modules> hash. If there isn't
one, then it looks for the module in each namespace defined in the C<path>.
=head2 loaded()
Returns a reference to a hash array which indicates which modules have already
been loaded. The items in the hash array (for those that exist, i.e. have been
loaded) are identical to those in C<modules>.
=head2 path()
This method returns a reference to a list containing the pacakges defined
in the current path. It can also be called as a class method to return any
items defined in the C<$PATH> package variable.
=head1 AUTHOR
Andy Wardley E<lt>abw@wardley.orgE<gt>
=head1 VERSION
$Revision: 1.1 $
=head1 COPYRIGHT
Copyright (C) 1996-2004 Andy Wardley. All Rights Reserved.
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=cut
# Local Variables:
# mode: perl
# perl-indent-level: 4
# indent-tabs-mode: nil
# End:
#
# vim: expandtab shiftwidth=4: