File Coverage

lib/Template/Plugins.pm
Criterion Covered Total %
statement 79 101 78.2
branch 34 52 65.3
condition 18 23 78.2
subroutine 8 9 88.8
pod 1 1 100.0
total 140 186 75.2


line stmt bran cond sub pod time code
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
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              
24             package Template::Plugins;
25              
26 85     85   1243 use strict;
  85         95  
  85         2053  
27 85     85   259 use warnings;
  85         86  
  85         1978  
28 85     85   264 use base 'Template::Base';
  85         80  
  85         4880  
29 85     85   344 use Template::Constants;
  85         96  
  85         79071  
30              
31             our $VERSION = 2.77;
32             our $DEBUG = 0 unless defined $DEBUG;
33             our $PLUGIN_BASE = 'Template::Plugin';
34             our $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              
88             sub fetch {
89 210     210 1 253 my ($self, $name, $args, $context) = @_;
90 210         162 my ($factory, $plugin, $error);
91              
92             $self->debug("fetch($name, ",
93             defined $args ? ('[ ', join(', ', @$args), ' ]') : '', ', ',
94             defined $context ? $context : '',
95 210 0       371 ')') if $self->{ DEBUG };
    0          
    50          
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 210   100     439 $args ||= [ ];
105 210         310 unshift @$args, $context;
106              
107 210   100     512 $factory = $self->{ FACTORY }->{ $name } ||= do {
108 48         134 ($factory, $error) = $self->_load($name, $context);
109 48 100       136 return ($factory, $error) if $error; ## RETURN
110 45         110 $factory;
111             };
112              
113             # call the new() method on the factory object or class name
114 207         191 eval {
115 207 100       347 if (ref $factory eq 'CODE') {
116 2 50       5 defined( $plugin = &$factory(@$args) )
117             || die "$name plugin failed\n";
118             }
119             else {
120 205 50       597 defined( $plugin = $factory->new(@$args) )
121             || die "$name plugin failed: ", $factory->error(), "\n";
122             }
123             };
124 207 100       1268 if ($error = $@) {
125             # chomp $error;
126             return $self->{ TOLERANT }
127 3 50       16 ? (undef, Template::Constants::STATUS_DECLINED)
128             : ($error, Template::Constants::STATUS_ERROR);
129             }
130              
131 204         355 return $plugin;
132             }
133              
134              
135              
136             #========================================================================
137             # -- PRIVATE METHODS --
138             #========================================================================
139              
140             #------------------------------------------------------------------------
141             # _init(\%config)
142             #
143             # Private initialisation method.
144             #------------------------------------------------------------------------
145              
146             sub _init {
147 159     159   215 my ($self, $params) = @_;
148             my ($pbase, $plugins, $factory) =
149 159         326 @$params{ qw( PLUGIN_BASE PLUGINS PLUGIN_FACTORY ) };
150              
151 159   100     557 $plugins ||= { };
152              
153             # update PLUGIN_BASE to an array ref if necessary
154 159 100       403 $pbase = [ ] unless defined $pbase;
155 159 100       406 $pbase = [ $pbase ] unless ref($pbase) eq 'ARRAY';
156            
157             # add default plugin base (Template::Plugin) if set
158 159 100       381 push(@$pbase, $PLUGIN_BASE) if $PLUGIN_BASE;
159              
160 159         388 $self->{ PLUGIN_BASE } = $pbase;
161 159         1628 $self->{ PLUGINS } = { %$STD_PLUGINS, %$plugins };
162 159   50     729 $self->{ TOLERANT } = $params->{ TOLERANT } || 0;
163 159   100     498 $self->{ LOAD_PERL } = $params->{ LOAD_PERL } || 0;
164 159   100     532 $self->{ FACTORY } = $factory || { };
165 159   100     520 $self->{ DEBUG } = ( $params->{ DEBUG } || 0 )
166             & Template::Constants::DEBUG_PLUGINS;
167              
168 159         1087 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              
181             sub _load {
182 48     48   59 my ($self, $name, $context) = @_;
183 48         54 my ($factory, $module, $base, $pkg, $file, $ok, $error);
184              
185 48 100 100     275 if ($module = $self->{ PLUGINS }->{ $name } || $self->{ PLUGINS }->{ lc $name }) {
186             # plugin module name is explicitly stated in PLUGIN_NAME
187 36         38 $pkg = $module;
188 36         147 ($file = $module) =~ s|::|/|g;
189 36         63 $file =~ s|::|/|g;
190             $self->debug("loading $module.pm (PLUGIN_NAME)")
191 36 50       81 if $self->{ DEBUG };
192 36         45 $ok = eval { require "$file.pm" };
  36         6443  
193 36         57 $error = $@;
194             }
195             else {
196             # try each of the PLUGIN_BASE values to build module name
197 12         24 ($module = $name) =~ s/\./::/g;
198            
199 12         14 foreach $base (@{ $self->{ PLUGIN_BASE } }) {
  12         33  
200 13         33 $pkg = $base . '::' . $module;
201 13         49 ($file = $pkg) =~ s|::|/|g;
202            
203             $self->debug("loading $file.pm (PLUGIN_BASE)")
204 13 50       33 if $self->{ DEBUG };
205            
206 13         18 $ok = eval { require "$file.pm" };
  13         3349  
207 13 100       391 last unless $@;
208            
209 5 50       107 $error .= "$@\n"
210             unless ($@ =~ /^Can\'t locate $file\.pm/);
211             }
212             }
213            
214 48 100       872 if ($ok) {
    100          
215 44 50       121 $self->debug("calling $pkg->load()") if $self->{ DEBUG };
216              
217 44         53 $factory = eval { $pkg->load($context) };
  44         278  
218 44         65 $error = '';
219 44 50 33     286 if ($@ || ! $factory) {
220 0   0     0 $error = $@ || 'load() returned a false value';
221             }
222             }
223             elsif ($self->{ LOAD_PERL }) {
224             # fallback - is it a regular Perl module?
225 1         6 ($file = $module) =~ s|::|/|g;
226 1         2 eval { require "$file.pm" };
  1         605  
227 1 50       8 if ($@) {
228 0         0 $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 2     2   3 shift;
237 2         7 $module->new(@_);
238 1         4 };
239 1         2 $error = '';
240             }
241             }
242            
243 48 100       93 if ($factory) {
    50          
244 45 50       104 $self->debug("$name => $factory") if $self->{ DEBUG };
245 45         115 return $factory;
246             }
247             elsif ($error) {
248             return $self->{ TOLERANT }
249 0 0       0 ? (undef, Template::Constants::STATUS_DECLINED)
250             : ($error, Template::Constants::STATUS_ERROR);
251             }
252             else {
253 3         10 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              
265             sub _dump {
266 0     0     my $self = shift;
267 0           my $output = "[Template::Plugins] {\n";
268 0           my $format = " %-16s => %s\n";
269 0           my $key;
270              
271 0           foreach $key (qw( TOLERANT LOAD_PERL )) {
272 0           $output .= sprintf($format, $key, $self->{ $key });
273             }
274              
275 0           local $" = ', ';
276 0           my $fkeys = join(", ", keys %{$self->{ FACTORY }});
  0            
277 0           my $plugins = $self->{ PLUGINS };
278             $plugins = join('', map {
279 0           sprintf(" $format", $_, $plugins->{ $_ });
  0            
280             } keys %$plugins);
281 0           $plugins = "{\n$plugins }";
282            
283 0           $output .= sprintf($format, 'PLUGIN_BASE', "[ @{ $self->{ PLUGIN_BASE } } ]");
  0            
284 0           $output .= sprintf($format, 'PLUGINS', $plugins);
285 0           $output .= sprintf($format, 'FACTORY', $fkeys);
286 0           $output .= '}';
287 0           return $output;
288             }
289              
290              
291             1;
292              
293             __END__