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