local-lib5/lib/perl5/i486-linux-gnu-thread-multi/Template/Plugins.pm

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