1#============================================================= -*-Perl-*-
2#
3# Template::Plugins
4#
5# DESCRIPTION
6#   Plugin provider which handles the loading of plugin modules and
7#   instantiation of plugin objects.
8#
9# AUTHORS
10#   Andy Wardley <abw@wardley.org>
11#
12# COPYRIGHT
13#   Copyright (C) 1996-2006 Andy Wardley.  All Rights Reserved.
14#   Copyright (C) 1998-2000 Canon Research Centre Europe Ltd.
15#
16#   This module is free software; you can redistribute it and/or
17#   modify it under the same terms as Perl itself.
18#
19# REVISION
20#   $Id$
21#
22#============================================================================
23
24package Template::Plugins;
25
26use strict;
27use warnings;
28use base 'Template::Base';
29use Template::Constants;
30
31our $VERSION = 2.77;
32our $DEBUG   = 0 unless defined $DEBUG;
33our $PLUGIN_BASE = 'Template::Plugin';
34our $STD_PLUGINS = {
35    'assert'     => 'Template::Plugin::Assert',
36    'cgi'        => 'Template::Plugin::CGI',
37    'datafile'   => 'Template::Plugin::Datafile',
38    'date'       => 'Template::Plugin::Date',
39    'debug'      => 'Template::Plugin::Debug',
40    'directory'  => 'Template::Plugin::Directory',
41    'dbi'        => 'Template::Plugin::DBI',
42    'dumper'     => 'Template::Plugin::Dumper',
43    'file'       => 'Template::Plugin::File',
44    'format'     => 'Template::Plugin::Format',
45    'html'       => 'Template::Plugin::HTML',
46    'image'      => 'Template::Plugin::Image',
47    'iterator'   => 'Template::Plugin::Iterator',
48    'latex'      => 'Template::Plugin::Latex',
49    'pod'        => 'Template::Plugin::Pod',
50    'scalar'     => 'Template::Plugin::Scalar',
51    'table'      => 'Template::Plugin::Table',
52    'url'        => 'Template::Plugin::URL',
53    'view'       => 'Template::Plugin::View',
54    'wrap'       => 'Template::Plugin::Wrap',
55    'xml'        => 'Template::Plugin::XML',
56    'xmlstyle'   => 'Template::Plugin::XML::Style',
57};
58
59
60#========================================================================
61#                         -- PUBLIC METHODS --
62#========================================================================
63
64#------------------------------------------------------------------------
65# fetch($name, \@args, $context)
66#
67# General purpose method for requesting instantiation of a plugin
68# object.  The name of the plugin is passed as the first parameter.
69# The internal FACTORY lookup table is consulted to retrieve the
70# appropriate factory object or class name.  If undefined, the _load()
71# method is called to attempt to load the module and return a factory
72# class/object which is then cached for subsequent use.  A reference
73# to the calling context should be passed as the third parameter.
74# This is passed to the _load() class method.  The new() method is
75# then called against the factory class name or prototype object to
76# instantiate a new plugin object, passing any arguments specified by
77# list reference as the second parameter.  e.g. where $factory is the
78# class name 'MyClass', the new() method is called as a class method,
79# $factory->new(...), equivalent to MyClass->new(...) .  Where
80# $factory is a prototype object, the new() method is called as an
81# object method, $myobject->new(...).  This latter approach allows
82# plugins to act as Singletons, cache shared data, etc.
83#
84# Returns a reference to a plugin, (undef, STATUS_DECLINE) to decline
85# the request or ($error, STATUS_ERROR) on error.
86#------------------------------------------------------------------------
87
88sub fetch {
89    my ($self, $name, $args, $context) = @_;
90    my ($factory, $plugin, $error);
91
92    $self->debug("fetch($name, ",
93                 defined $args ? ('[ ', join(', ', @$args), ' ]') : '<no args>', ', ',
94                 defined $context ? $context : '<no context>',
95                 ')') if $self->{ DEBUG };
96
97    # NOTE:
98    # the $context ref gets passed as the first parameter to all regular
99    # plugins, but not to those loaded via LOAD_PERL;  to hack around
100    # this until we have a better implementation, we pass the $args
101    # reference to _load() and let it unshift the first args in the
102    # LOAD_PERL case
103
104    $args ||= [ ];
105    unshift @$args, $context;
106
107    $factory = $self->{ FACTORY }->{ $name } ||= do {
108        ($factory, $error) = $self->_load($name, $context);
109        return ($factory, $error) if $error;			## RETURN
110        $factory;
111    };
112
113    # call the new() method on the factory object or class name
114    eval {
115        if (ref $factory eq 'CODE') {
116            defined( $plugin = &$factory(@$args) )
117                || die "$name plugin failed\n";
118        }
119        else {
120            defined( $plugin = $factory->new(@$args) )
121                || die "$name plugin failed: ", $factory->error(), "\n";
122        }
123    };
124    if ($error = $@) {
125#	chomp $error;
126        return $self->{ TOLERANT }
127	       ? (undef,  Template::Constants::STATUS_DECLINED)
128	       : ($error, Template::Constants::STATUS_ERROR);
129    }
130
131    return $plugin;
132}
133
134
135
136#========================================================================
137#                        -- PRIVATE METHODS --
138#========================================================================
139
140#------------------------------------------------------------------------
141# _init(\%config)
142#
143# Private initialisation method.
144#------------------------------------------------------------------------
145
146sub _init {
147    my ($self, $params) = @_;
148    my ($pbase, $plugins, $factory) =
149        @$params{ qw( PLUGIN_BASE PLUGINS PLUGIN_FACTORY ) };
150
151    $plugins ||= { };
152
153    # update PLUGIN_BASE to an array ref if necessary
154    $pbase = [ ] unless defined $pbase;
155    $pbase = [ $pbase ] unless ref($pbase) eq 'ARRAY';
156
157    # add default plugin base (Template::Plugin) if set
158    push(@$pbase, $PLUGIN_BASE) if $PLUGIN_BASE;
159
160    $self->{ PLUGIN_BASE } = $pbase;
161    $self->{ PLUGINS     } = { %$STD_PLUGINS, %$plugins };
162    $self->{ TOLERANT    } = $params->{ TOLERANT }  || 0;
163    $self->{ LOAD_PERL   } = $params->{ LOAD_PERL } || 0;
164    $self->{ FACTORY     } = $factory || { };
165    $self->{ DEBUG       } = ( $params->{ DEBUG } || 0 )
166                             & Template::Constants::DEBUG_PLUGINS;
167
168    return $self;
169}
170
171
172
173#------------------------------------------------------------------------
174# _load($name, $context)
175#
176# Private method which attempts to load a plugin module and determine the
177# correct factory name or object by calling the load() class method in
178# the loaded module.
179#------------------------------------------------------------------------
180
181sub _load {
182    my ($self, $name, $context) = @_;
183    my ($factory, $module, $base, $pkg, $file, $ok, $error);
184
185    if ($module = $self->{ PLUGINS }->{ $name } || $self->{ PLUGINS }->{ lc $name }) {
186        # plugin module name is explicitly stated in PLUGIN_NAME
187        $pkg = $module;
188        ($file = $module) =~ s|::|/|g;
189        $file =~ s|::|/|g;
190        $self->debug("loading $module.pm (PLUGIN_NAME)")
191            if $self->{ DEBUG };
192        $ok = eval { require "$file.pm" };
193        $error = $@;
194    }
195    else {
196        # try each of the PLUGIN_BASE values to build module name
197        ($module = $name) =~ s/\./::/g;
198
199        foreach $base (@{ $self->{ PLUGIN_BASE } }) {
200            $pkg = $base . '::' . $module;
201            ($file = $pkg) =~ s|::|/|g;
202
203            $self->debug("loading $file.pm (PLUGIN_BASE)")
204                if $self->{ DEBUG };
205
206            $ok = eval { require "$file.pm" };
207            last unless $@;
208
209            $error .= "$@\n"
210                unless ($@ =~ /^Can\'t locate $file\.pm/);
211        }
212    }
213
214    if ($ok) {
215        $self->debug("calling $pkg->load()") if $self->{ DEBUG };
216
217	$factory = eval { $pkg->load($context) };
218        $error   = '';
219        if ($@ || ! $factory) {
220            $error = $@ || 'load() returned a false value';
221        }
222    }
223    elsif ($self->{ LOAD_PERL }) {
224        # fallback - is it a regular Perl module?
225        ($file = $module) =~ s|::|/|g;
226        eval { require "$file.pm" };
227        if ($@) {
228            $error = $@;
229        }
230        else {
231            # this is a regular Perl module so the new() constructor
232            # isn't expecting a $context reference as the first argument;
233            # so we construct a closure which removes it before calling
234            # $module->new(@_);
235            $factory = sub {
236                shift;
237                $module->new(@_);
238            };
239            $error   = '';
240        }
241    }
242
243    if ($factory) {
244        $self->debug("$name => $factory") if $self->{ DEBUG };
245        return $factory;
246    }
247    elsif ($error) {
248        return $self->{ TOLERANT }
249	    ? (undef,  Template::Constants::STATUS_DECLINED)
250            : ($error, Template::Constants::STATUS_ERROR);
251    }
252    else {
253        return (undef, Template::Constants::STATUS_DECLINED);
254    }
255}
256
257
258#------------------------------------------------------------------------
259# _dump()
260#
261# Debug method which constructs and returns text representing the current
262# state of the object.
263#------------------------------------------------------------------------
264
265sub _dump {
266    my $self = shift;
267    my $output = "[Template::Plugins] {\n";
268    my $format = "    %-16s => %s\n";
269    my $key;
270
271    foreach $key (qw( TOLERANT LOAD_PERL )) {
272        $output .= sprintf($format, $key, $self->{ $key });
273    }
274
275    local $" = ', ';
276    my $fkeys = join(", ", keys %{$self->{ FACTORY }});
277    my $plugins = $self->{ PLUGINS };
278    $plugins = join('', map {
279        sprintf("    $format", $_, $plugins->{ $_ });
280    } keys %$plugins);
281    $plugins = "{\n$plugins    }";
282
283    $output .= sprintf($format, 'PLUGIN_BASE', "[ @{ $self->{ PLUGIN_BASE } } ]");
284    $output .= sprintf($format, 'PLUGINS', $plugins);
285    $output .= sprintf($format, 'FACTORY', $fkeys);
286    $output .= '}';
287    return $output;
288}
289
290
2911;
292
293__END__
294
295=head1 NAME
296
297Template::Plugins - Plugin provider module
298
299=head1 SYNOPSIS
300
301    use Template::Plugins;
302
303    $plugin_provider = Template::Plugins->new(\%options);
304
305    ($plugin, $error) = $plugin_provider->fetch($name, @args);
306
307=head1 DESCRIPTION
308
309The C<Template::Plugins> module defines a provider class which can be used
310to load and instantiate Template Toolkit plugin modules.
311
312=head1 METHODS
313
314=head2 new(\%params)
315
316Constructor method which instantiates and returns a reference to a
317C<Template::Plugins> object.  A reference to a hash array of configuration
318items may be passed as a parameter.  These are described below.
319
320Note that the L<Template> front-end module creates a C<Template::Plugins>
321provider, passing all configuration items.  Thus, the examples shown
322below in the form:
323
324    $plugprov = Template::Plugins->new({
325        PLUGIN_BASE => 'MyTemplate::Plugin',
326        LOAD_PERL   => 1,
327        ...
328    });
329
330can also be used via the L<Template> module as:
331
332    $ttengine = Template->new({
333        PLUGIN_BASE => 'MyTemplate::Plugin',
334        LOAD_PERL   => 1,
335        ...
336    });
337
338as well as the more explicit form of:
339
340    $plugprov = Template::Plugins->new({
341        PLUGIN_BASE => 'MyTemplate::Plugin',
342        LOAD_PERL   => 1,
343        ...
344    });
345
346    $ttengine = Template->new({
347        LOAD_PLUGINS => [ $plugprov ],
348    });
349
350=head2 fetch($name, @args)
351
352Called to request that a plugin of a given name be provided. The relevant
353module is first loaded (if necessary) and the
354L<load()|Template::Plugin#load()> class method called to return the factory
355class name (usually the same package name) or a factory object (a prototype).
356The L<new()|Template::Plugin#new()> method is then called as a class or object
357method against the factory, passing all remaining parameters.
358
359Returns a reference to a new plugin object or C<($error, STATUS_ERROR)>
360on error.  May also return C<(undef, STATUS_DECLINED)> to decline to
361serve the request.  If C<TOLERANT> is set then all errors will be
362returned as declines.
363
364=head1 CONFIGURATION OPTIONS
365
366The following list summarises the configuration options that can be provided
367to the C<Template::Plugins> L<new()> constructor.  Please consult
368L<Template::Manual::Config> for further details and examples of each
369configuration option in use.
370
371=head2 PLUGINS
372
373The L<PLUGINS|Template::Manual::Config#PLUGINS> option can be used to provide
374a reference to a hash array that maps plugin names to Perl module names.
375
376    my $plugins = Template::Plugins->new({
377        PLUGINS => {
378            cgi => 'MyOrg::Template::Plugin::CGI',
379            foo => 'MyOrg::Template::Plugin::Foo',
380            bar => 'MyOrg::Template::Plugin::Bar',
381        },
382    });
383
384=head2 PLUGIN_BASE
385
386If a plugin is not defined in the L<PLUGINS|Template::Manual::Config#PLUGINS>
387hash then the L<PLUGIN_BASE|Template::Manual::Config#PLUGIN_BASE> is used to
388attempt to construct a correct Perl module name which can be successfully
389loaded.
390
391    # single value PLUGIN_BASE
392    my $plugins = Template::Plugins->new({
393        PLUGIN_BASE => 'MyOrg::Template::Plugin',
394    });
395
396    # multiple value PLUGIN_BASE
397    my $plugins = Template::Plugins->new({
398        PLUGIN_BASE => [   'MyOrg::Template::Plugin',
399                           'YourOrg::Template::Plugin'  ],
400    });
401
402=head2 LOAD_PERL
403
404The L<LOAD_PERL|Template::Manual::Config#LOAD_PERL> option can be set to allow
405you to load regular Perl modules (i.e. those that don't reside in the
406C<Template::Plugin> or another user-defined namespace) as plugins.
407
408If a plugin cannot be loaded using the
409L<PLUGINS|Template::Manual::Config#PLUGINS> or
410L<PLUGIN_BASE|Template::Manual::Config#PLUGIN_BASE> approaches then,
411if the L<LOAD_PERL|Template::Manual::Config#LOAD_PERL> is set, the
412provider will make a final attempt to load the module without prepending any
413prefix to the module path.
414
415Unlike regular plugins, modules loaded using L<LOAD_PERL|Template::Manual::Config#LOAD_PERL>
416do not receive a L<Template::Context> reference as the first argument to the
417C<new()> constructor method.
418
419=head2 TOLERANT
420
421The L<TOLERANT|Template::Manual::Config#TOLERANT> flag can be set to indicate
422that the C<Template::Plugins> module should ignore any errors encountered while
423loading a plugin and instead return C<STATUS_DECLINED>.
424
425=head2 DEBUG
426
427The L<DEBUG|Template::Manual::Config#DEBUG> option can be used to enable
428debugging messages for the C<Template::Plugins> module by setting it to
429include the C<DEBUG_PLUGINS> value.
430
431    use Template::Constants qw( :debug );
432
433    my $template = Template->new({
434        DEBUG => DEBUG_FILTERS | DEBUG_PLUGINS,
435    });
436
437=head1 TEMPLATE TOOLKIT PLUGINS
438
439Please see L<Template::Manual::Plugins> For a complete list of all the plugin
440modules distributed with the Template Toolkit.
441
442=head1 AUTHOR
443
444Andy Wardley E<lt>abw@wardley.orgE<gt> L<http://wardley.org/>
445
446=head1 COPYRIGHT
447
448Copyright (C) 1996-2007 Andy Wardley.  All Rights Reserved.
449
450This module is free software; you can redistribute it and/or
451modify it under the same terms as Perl itself.
452
453=head1 SEE ALSO
454
455L<Template::Manual::Plugins>, L<Template::Plugin>, L<Template::Context>, L<Template>.
456
457=cut
458
459# Local Variables:
460# mode: perl
461# perl-indent-level: 4
462# indent-tabs-mode: nil
463# End:
464#
465# vim: expandtab shiftwidth=4:
466