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 80     80   1054 use strict;
  80         154  
  80         3255  
27 80     80   516 use warnings;
  80         261  
  80         2954  
28 80     80   433 use base 'Template::Base';
  80         139  
  80         11543  
29 80     80   504 use Template::Constants;
  80         149  
  80         123617  
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 492 my ($self, $name, $args, $context) = @_;
90 210         351 my ($factory, $plugin, $error);
91              
92             $self->debug("fetch($name, ",
93             defined $args ? ('[ ', join(', ', @$args), ' ]') : '', ', ',
94             defined $context ? $context : '',
95 210 0       935 ')') 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     850 $args ||= [ ];
105 210         502 unshift @$args, $context;
106              
107 210   100     1298 $factory = $self->{ FACTORY }->{ $name } ||= do {
108 48         328 ($factory, $error) = $self->_load($name, $context);
109 48 100       173 return ($factory, $error) if $error; ## RETURN
110 45         197 $factory;
111             };
112              
113             # call the new() method on the factory object or class name
114 207         408 eval {
115 207 100       652 if (ref $factory eq 'CODE') {
116 2 50       10 defined( $plugin = &$factory(@$args) )
117             || die "$name plugin failed\n";
118             }
119             else {
120 205 50       1312 defined( $plugin = $factory->new(@$args) )
121             || die "$name plugin failed: ", $factory->error(), "\n";
122             }
123             };
124 207 100       3049 if ($error = $@) {
125             # chomp $error;
126             return $self->{ TOLERANT }
127 3 50       45 ? (undef, Template::Constants::STATUS_DECLINED)
128             : ($error, Template::Constants::STATUS_ERROR);
129             }
130              
131 204         722 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 149     149   346 my ($self, $params) = @_;
148 149         529 my ($pbase, $plugins, $factory) =
149             @$params{ qw( PLUGIN_BASE PLUGINS PLUGIN_FACTORY ) };
150              
151 149   100     822 $plugins ||= { };
152              
153             # update PLUGIN_BASE to an array ref if necessary
154 149 100       562 $pbase = [ ] unless defined $pbase;
155 149 100       590 $pbase = [ $pbase ] unless ref($pbase) eq 'ARRAY';
156            
157             # add default plugin base (Template::Plugin) if set
158 149 100       573 push(@$pbase, $PLUGIN_BASE) if $PLUGIN_BASE;
159              
160 149         718 $self->{ PLUGIN_BASE } = $pbase;
161 149         3342 $self->{ PLUGINS } = { %$STD_PLUGINS, %$plugins };
162 149   50     1113 $self->{ TOLERANT } = $params->{ TOLERANT } || 0;
163 149   100     1050 $self->{ LOAD_PERL } = $params->{ LOAD_PERL } || 0;
164 149   100     774 $self->{ FACTORY } = $factory || { };
165 149   100     818 $self->{ DEBUG } = ( $params->{ DEBUG } || 0 )
166             & Template::Constants::DEBUG_PLUGINS;
167              
168 149         1886 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   110 my ($self, $name, $context) = @_;
183 48         86 my ($factory, $module, $base, $pkg, $file, $ok, $error);
184              
185 48 100 100     502 if ($module = $self->{ PLUGINS }->{ $name } || $self->{ PLUGINS }->{ lc $name }) {
186             # plugin module name is explicitly stated in PLUGIN_NAME
187 36         80 $pkg = $module;
188 36         242 ($file = $module) =~ s|::|/|g;
189 36         112 $file =~ s|::|/|g;
190             $self->debug("loading $module.pm (PLUGIN_NAME)")
191 36 50       255 if $self->{ DEBUG };
192 36         77 $ok = eval { require "$file.pm" };
  36         12252  
193 36         120 $error = $@;
194             }
195             else {
196             # try each of the PLUGIN_BASE values to build module name
197 12         51 ($module = $name) =~ s/\./::/g;
198            
199 12         20 foreach $base (@{ $self->{ PLUGIN_BASE } }) {
  12         45  
200 13         51 $pkg = $base . '::' . $module;
201 13         73 ($file = $pkg) =~ s|::|/|g;
202            
203             $self->debug("loading $file.pm (PLUGIN_BASE)")
204 13 50       62 if $self->{ DEBUG };
205            
206 13         23 $ok = eval { require "$file.pm" };
  13         17757  
207 13 100       559 last unless $@;
208            
209 5 50       158 $error .= "$@\n"
210             unless ($@ =~ /^Can\'t locate $file\.pm/);
211             }
212             }
213            
214 48 100       296 if ($ok) {
    100          
215 44 50       279 $self->debug("calling $pkg->load()") if $self->{ DEBUG };
216              
217 44         95 $factory = eval { $pkg->load($context) };
  44         460  
218 44         173 $error = '';
219 44 50 33     461 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         7 ($file = $module) =~ s|::|/|g;
226 1         3 eval { require "$file.pm" };
  1         761  
227 1 50       13 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   6 shift;
237 2         24 $module->new(@_);
238 1         6917 };
239 1         9 $error = '';
240             }
241             }
242            
243 48 100       185 if ($factory) {
    50          
244 45 50       231 $self->debug("$name => $factory") if $self->{ DEBUG };
245 45         219 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         15 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 0           $plugins = join('', map {
279 0           sprintf(" $format", $_, $plugins->{ $_ });
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__