File Coverage

lib/Template/Plugin.pm
Criterion Covered Total %
statement 10 36 27.7
branch 0 10 0.0
condition 0 4 0.0
subroutine 4 8 50.0
pod 2 5 40.0
total 16 63 25.4


line stmt bran cond sub pod time code
1             #============================================================= -*-Perl-*-
2             #
3             # Template::Plugin
4             #
5             # DESCRIPTION
6             #
7             # Module defining a base class for a plugin object which can be loaded
8             # and instantiated via the USE directive.
9             #
10             # AUTHOR
11             # Andy Wardley
12             #
13             # COPYRIGHT
14             # Copyright (C) 1996-2007 Andy Wardley. All Rights Reserved.
15             #
16             # This module is free software; you can redistribute it an/or
17             # modify it under the same terms as Perl itself.
18             #
19             #============================================================================
20              
21             package Template::Plugin;
22              
23 23     23   1870 use strict;
  23         47  
  23         777  
24 23     23   119 use warnings;
  23         47  
  23         629  
25 23     23   110 use base 'Template::Base';
  23         65  
  23         14233  
26              
27             our $VERSION = 2.70;
28             our $DEBUG = 0 unless defined $DEBUG;
29             our $ERROR = '';
30             our $AUTOLOAD;
31              
32              
33             #========================================================================
34             # ----- CLASS METHODS -----
35             #========================================================================
36              
37             #------------------------------------------------------------------------
38             # load()
39             #
40             # Class method called when the plugin module is first loaded. It
41             # returns the name of a class (by default, its own class) or a prototype
42             # object which will be used to instantiate new objects. The new()
43             # method is then called against the class name (class method) or
44             # prototype object (object method) to create a new instances of the
45             # object.
46             #------------------------------------------------------------------------
47              
48             sub load {
49 40     40 1 161 return $_[0];
50             }
51              
52              
53             #------------------------------------------------------------------------
54             # new($context, $delegate, @params)
55             #
56             # Object constructor which is called by the Template::Context to
57             # instantiate a new Plugin object. This base class constructor is
58             # used as a general mechanism to load and delegate to other Perl
59             # modules. The context is passed as the first parameter, followed by
60             # a reference to a delegate object or the name of the module which
61             # should be loaded and instantiated. Any additional parameters passed
62             # to the USE directive are forwarded to the new() constructor.
63             #
64             # A plugin object is returned which has an AUTOLOAD method to delegate
65             # requests to the underlying object.
66             #------------------------------------------------------------------------
67              
68             sub new {
69 0     0 1   my $class = shift;
70 0           bless {
71             }, $class;
72             }
73              
74             sub old_new {
75 0     0 0   my ($class, $context, $delclass, @params) = @_;
76 0           my ($delegate, $delmod);
77              
78 0 0         return $class->error("no context passed to $class constructor\n")
79             unless defined $context;
80              
81 0 0         if (ref $delclass) {
82             # $delclass contains a reference to a delegate object
83 0           $delegate = $delclass;
84             }
85             else {
86             # delclass is the name of a module to load and instantiate
87 0           ($delmod = $delclass) =~ s|::|/|g;
88              
89 0           eval {
90 0           require "$delmod.pm";
91 0   0       $delegate = $delclass->new(@params)
92             || die "failed to instantiate $delclass object\n";
93             };
94 0 0         return $class->error($@) if $@;
95             }
96              
97 0           bless {
98             _CONTEXT => $context,
99             _DELEGATE => $delegate,
100             _PARAMS => \@params,
101             }, $class;
102             }
103              
104              
105             #------------------------------------------------------------------------
106             # fail($error)
107             #
108             # Version 1 error reporting function, now replaced by error() inherited
109             # from Template::Base. Raises a "deprecated function" warning and then
110             # calls error().
111             #------------------------------------------------------------------------
112              
113             sub fail {
114 0     0 0   my $class = shift;
115 0           my ($pkg, $file, $line) = caller();
116 0           warn "Template::Plugin::fail() is deprecated at $file line $line. Please use error()\n";
117 0           $class->error(@_);
118             }
119              
120              
121             #========================================================================
122             # ----- OBJECT METHODS -----
123             #========================================================================
124              
125             #------------------------------------------------------------------------
126             # AUTOLOAD
127             #
128             # General catch-all method which delegates all calls to the _DELEGATE
129             # object.
130             #------------------------------------------------------------------------
131              
132             sub OLD_AUTOLOAD {
133 0     0 0   my $self = shift;
134 0           my $method = $AUTOLOAD;
135              
136 0           $method =~ s/.*:://;
137 0 0         return if $method eq 'DESTROY';
138              
139 0 0         if (ref $self eq 'HASH') {
140 0   0       my $delegate = $self->{ _DELEGATE } || return;
141 0           return $delegate->$method(@_);
142             }
143 0           my ($pkg, $file, $line) = caller();
144             # warn "no such '$method' method called on $self at $file line $line\n";
145 0           return undef;
146             }
147              
148              
149             1;
150              
151             __END__