This file is indexed.

/usr/lib/perl5/Template/Plugin.pm is in libtemplate-perl 2.22-0.1build2.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
#============================================================= -*-Perl-*-
#
# Template::Plugin
#
# DESCRIPTION
#
#   Module defining a base class for a plugin object which can be loaded
#   and instantiated via the USE directive.
#
# AUTHOR
#   Andy Wardley   <abw@wardley.org>
#
# COPYRIGHT
#   Copyright (C) 1996-2007 Andy Wardley.  All Rights Reserved.
#
#   This module is free software; you can redistribute it an/or
#   modify it under the same terms as Perl itself.
#
#============================================================================

package Template::Plugin;

use strict;
use warnings;
use base 'Template::Base';

our $VERSION = 2.70;
our $DEBUG   = 0 unless defined $DEBUG;
our $ERROR   = '';
our $AUTOLOAD;


#========================================================================
#                      -----  CLASS METHODS -----
#========================================================================

#------------------------------------------------------------------------
# load()
#
# Class method called when the plugin module is first loaded.  It 
# returns the name of a class (by default, its own class) or a prototype
# object which will be used to instantiate new objects.  The new() 
# method is then called against the class name (class method) or 
# prototype object (object method) to create a new instances of the 
# object.
#------------------------------------------------------------------------

sub load {
    return $_[0];
}


#------------------------------------------------------------------------
# new($context, $delegate, @params)
#
# Object constructor which is called by the Template::Context to 
# instantiate a new Plugin object.  This base class constructor is 
# used as a general mechanism to load and delegate to other Perl 
# modules.  The context is passed as the first parameter, followed by
# a reference to a delegate object or the name of the module which 
# should be loaded and instantiated.  Any additional parameters passed 
# to the USE directive are forwarded to the new() constructor.
# 
# A plugin object is returned which has an AUTOLOAD method to delegate 
# requests to the underlying object.
#------------------------------------------------------------------------

sub new {
    my $class = shift;
    bless {
    }, $class;
}

sub old_new {
    my ($class, $context, $delclass, @params) = @_;
    my ($delegate, $delmod);

    return $class->error("no context passed to $class constructor\n")
        unless defined $context;

    if (ref $delclass) {
        # $delclass contains a reference to a delegate object
        $delegate = $delclass;
    }
    else {
        # delclass is the name of a module to load and instantiate
        ($delmod = $delclass) =~ s|::|/|g;

        eval {
            require "$delmod.pm";
            $delegate = $delclass->new(@params)
                || die "failed to instantiate $delclass object\n";
        };
        return $class->error($@) if $@;
    }

    bless {
        _CONTEXT  => $context, 
        _DELEGATE => $delegate,
        _PARAMS   => \@params,
    }, $class;
}


#------------------------------------------------------------------------
# fail($error)
# 
# Version 1 error reporting function, now replaced by error() inherited
# from Template::Base.  Raises a "deprecated function" warning and then
# calls error().
#------------------------------------------------------------------------

sub fail {
    my $class = shift;
    my ($pkg, $file, $line) = caller();
    warn "Template::Plugin::fail() is deprecated at $file line $line.  Please use error()\n";
    $class->error(@_);
}


#========================================================================
#                      -----  OBJECT METHODS -----
#========================================================================

#------------------------------------------------------------------------
# AUTOLOAD
#
# General catch-all method which delegates all calls to the _DELEGATE 
# object.  
#------------------------------------------------------------------------

sub OLD_AUTOLOAD {
    my $self     = shift;
    my $method   = $AUTOLOAD;

    $method =~ s/.*:://;
    return if $method eq 'DESTROY';

    if (ref $self eq 'HASH') {
        my $delegate = $self->{ _DELEGATE } || return;
        return $delegate->$method(@_);
    }
    my ($pkg, $file, $line) = caller();
#    warn "no such '$method' method called on $self at $file line $line\n";
    return undef;
}


1;

__END__

=head1 NAME

Template::Plugin - Base class for Template Toolkit plugins

=head1 SYNOPSIS

    package MyOrg::Template::Plugin::MyPlugin;
    use base qw( Template::Plugin );
    use Template::Plugin;
    use MyModule;
    
    sub new {
        my $class   = shift;
        my $context = shift;
        bless {
            ...
        }, $class;
    }

=head1 DESCRIPTION

A "plugin" for the Template Toolkit is simply a Perl module which 
exists in a known package location (e.g. C<Template::Plugin::*>) and 
conforms to a regular standard, allowing it to be loaded and used 
automatically.

The C<Template::Plugin> module defines a base class from which other 
plugin modules can be derived.  A plugin does not have to be derived
from Template::Plugin but should at least conform to its object-oriented
interface.

It is recommended that you create plugins in your own package namespace
to avoid conflict with toolkit plugins.  e.g. 

    package MyOrg::Template::Plugin::FooBar;

Use the L<PLUGIN_BASE|Template::Manual::Config#PLUGIN_BASE> option to specify
the namespace that you use. e.g.

    use Template;
    my $template = Template->new({ 
        PLUGIN_BASE => 'MyOrg::Template::Plugin',
    });

=head1 METHODS

The following methods form the basic interface between the Template
Toolkit and plugin modules.

=head2 load($context)

This method is called by the Template Toolkit when the plugin module
is first loaded.  It is called as a package method and thus implicitly
receives the package name as the first parameter.  A reference to the
L<Template::Context> object loading the plugin is also passed.  The
default behaviour for the C<load()> method is to simply return the class
name.  The calling context then uses this class name to call the C<new()>
package method.

    package MyPlugin;
    
    sub load {               # called as MyPlugin->load($context)
        my ($class, $context) = @_;
        return $class;       # returns 'MyPlugin'
    }

=head2 new($context, @params)

This method is called to instantiate a new plugin object for the C<USE>
directive. It is called as a package method against the class name returned by
L<load()>. A reference to the L<Template::Context> object creating the plugin
is passed, along with any additional parameters specified in the C<USE>
directive.

    sub new {                # called as MyPlugin->new($context)
        my ($class, $context, @params) = @_;
        bless {
            _CONTEXT => $context,
        }, $class;           # returns blessed MyPlugin object
    }

=head2 error($error)

This method, inherited from the L<Template::Base> module, is used for 
reporting and returning errors.   It can be called as a package method
to set/return the C<$ERROR> package variable, or as an object method to 
set/return the object C<_ERROR> member.  When called with an argument, it
sets the relevant variable and returns C<undef.>  When called without an
argument, it returns the value of the variable.

    package MyPlugin;
    use base 'Template::Plugin';
    
    sub new {
        my ($class, $context, $dsn) = @_;
        
        return $class->error('No data source specified')
            unless $dsn;
        
        bless {
            _DSN => $dsn,
        }, $class;
    }

    package main;
    
    my $something = MyPlugin->new()
        || die MyPlugin->error(), "\n";
        
    $something->do_something()
        || die $something->error(), "\n";

=head1 DEEPER MAGIC

The L<Template::Context> object that handles the loading and use of plugins
calls the L<new()> and L<error()> methods against the package name returned by
the L<load()> method. In pseudo-code terms looks something like this:

    $class  = MyPlugin->load($context);       # returns 'MyPlugin'
    
    $object = $class->new($context, @params)  # MyPlugin->new(...)
        || die $class->error();               # MyPlugin->error()

The L<load()> method may alterately return a blessed reference to an
object instance.  In this case, L<new()> and L<error()> are then called as
I<object> methods against that prototype instance.

    package YourPlugin;
    
    sub load {
        my ($class, $context) = @_;
        bless {
            _CONTEXT => $context,
        }, $class;
    }
    
    sub new {
        my ($self, $context, @params) = @_;
        return $self;
    }

In this example, we have implemented a 'Singleton' plugin.  One object 
gets created when L<load()> is called and this simply returns itself for
each call to L<new().>   

Another implementation might require individual objects to be created
for every call to L<new(),> but with each object sharing a reference to
some other object to maintain cached data, database handles, etc.
This pseudo-code example demonstrates the principle.

    package MyServer;
    
    sub load {
        my ($class, $context) = @_;
        bless {
            _CONTEXT => $context,
            _CACHE   => { },
        }, $class;
    }
    
    sub new {
        my ($self, $context, @params) = @_;
        MyClient->new($self, @params);
    }
    
    sub add_to_cache   { ... }
    
    sub get_from_cache { ... }

    package MyClient;
    
    sub new {
        my ($class, $server, $blah) = @_;
        bless {
            _SERVER => $server,
            _BLAH   => $blah,
        }, $class;
    }
    
    sub get {
        my $self = shift;
        $self->{ _SERVER }->get_from_cache(@_);
    }
    
    sub put {
        my $self = shift;
        $self->{ _SERVER }->add_to_cache(@_);
    }

When the plugin is loaded, a C<MyServer> instance is created. The L<new()>
method is called against this object which instantiates and returns a C<MyClient>
object, primed to communicate with the creating C<MyServer>.

=head1 AUTHOR

Andy Wardley E<lt>abw@wardley.orgE<gt> L<http://wardley.org/>

=head1 COPYRIGHT

Copyright (C) 1996-2007 Andy Wardley.  All Rights Reserved.

This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 SEE ALSO

L<Template>, L<Template::Plugins>, L<Template::Context>

=cut

# Local Variables:
# mode: perl
# perl-indent-level: 4
# indent-tabs-mode: nil
# End:
#
# vim: expandtab shiftwidth=4: