Filename | /usr/lib/x86_64-linux-gnu/perl5/5.28/Template/Plugins.pm |
Statements | Executed 4981106 statements in 17.0s |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
383161 | 1 | 1 | 15.8s | 15.8s | _init | Template::Plugins::
1 | 1 | 1 | 14µs | 18µs | BEGIN@26 | Template::Plugins::
1 | 1 | 1 | 9µs | 32µs | BEGIN@29 | Template::Plugins::
1 | 1 | 1 | 8µs | 77µs | BEGIN@28 | Template::Plugins::
1 | 1 | 1 | 8µs | 37µs | BEGIN@27 | Template::Plugins::
0 | 0 | 0 | 0s | 0s | __ANON__[:238] | Template::Plugins::
0 | 0 | 0 | 0s | 0s | _dump | Template::Plugins::
0 | 0 | 0 | 0s | 0s | _load | Template::Plugins::
0 | 0 | 0 | 0s | 0s | fetch | Template::Plugins::
Line | State ments |
Time on line |
Calls | Time in subs |
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 <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 | |||||
24 | package Template::Plugins; | ||||
25 | |||||
26 | 2 | 26µs | 2 | 22µs | # spent 18µs (14+4) within Template::Plugins::BEGIN@26 which was called:
# once (14µs+4µs) by Template::Config::load at line 26 # spent 18µs making 1 call to Template::Plugins::BEGIN@26
# spent 4µs making 1 call to strict::import |
27 | 2 | 25µs | 2 | 66µs | # spent 37µs (8+29) within Template::Plugins::BEGIN@27 which was called:
# once (8µs+29µs) by Template::Config::load at line 27 # spent 37µs making 1 call to Template::Plugins::BEGIN@27
# spent 29µs making 1 call to warnings::import |
28 | 2 | 26µs | 2 | 146µs | # spent 77µs (8+69) within Template::Plugins::BEGIN@28 which was called:
# once (8µs+69µs) by Template::Config::load at line 28 # spent 77µs making 1 call to Template::Plugins::BEGIN@28
# spent 69µs making 1 call to base::import |
29 | 2 | 1.03ms | 2 | 54µs | # spent 32µs (9+23) within Template::Plugins::BEGIN@29 which was called:
# once (9µs+23µs) by Template::Config::load at line 29 # spent 32µs making 1 call to Template::Plugins::BEGIN@29
# spent 23µs making 1 call to Exporter::import |
30 | |||||
31 | 1 | 400ns | our $VERSION = 2.77; | ||
32 | 1 | 300ns | our $DEBUG = 0 unless defined $DEBUG; | ||
33 | 1 | 300ns | our $PLUGIN_BASE = 'Template::Plugin'; | ||
34 | 1 | 12µs | 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 | 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 | |||||
- - | |||||
136 | #======================================================================== | ||||
137 | # -- PRIVATE METHODS -- | ||||
138 | #======================================================================== | ||||
139 | |||||
140 | #------------------------------------------------------------------------ | ||||
141 | # _init(\%config) | ||||
142 | # | ||||
143 | # Private initialisation method. | ||||
144 | #------------------------------------------------------------------------ | ||||
145 | |||||
146 | # spent 15.8s within Template::Plugins::_init which was called 383161 times, avg 41µs/call:
# 383161 times (15.8s+0s) by Template::Base::new at line 65 of Template/Base.pm, avg 41µs/call | ||||
147 | 383161 | 241ms | my ($self, $params) = @_; | ||
148 | my ($pbase, $plugins, $factory) = | ||||
149 | 383161 | 814ms | @$params{ qw( PLUGIN_BASE PLUGINS PLUGIN_FACTORY ) }; | ||
150 | |||||
151 | 383161 | 347ms | $plugins ||= { }; | ||
152 | |||||
153 | # update PLUGIN_BASE to an array ref if necessary | ||||
154 | 383161 | 275ms | $pbase = [ ] unless defined $pbase; | ||
155 | 383161 | 351ms | $pbase = [ $pbase ] unless ref($pbase) eq 'ARRAY'; | ||
156 | |||||
157 | # add default plugin base (Template::Plugin) if set | ||||
158 | 383161 | 576ms | push(@$pbase, $PLUGIN_BASE) if $PLUGIN_BASE; | ||
159 | |||||
160 | 383161 | 413ms | $self->{ PLUGIN_BASE } = $pbase; | ||
161 | 383161 | 9.79s | $self->{ PLUGINS } = { %$STD_PLUGINS, %$plugins }; | ||
162 | 383161 | 431ms | $self->{ TOLERANT } = $params->{ TOLERANT } || 0; | ||
163 | 383161 | 522ms | $self->{ LOAD_PERL } = $params->{ LOAD_PERL } || 0; | ||
164 | 383161 | 676ms | $self->{ FACTORY } = $factory || { }; | ||
165 | 383161 | 423ms | $self->{ DEBUG } = ( $params->{ DEBUG } || 0 ) | ||
166 | & Template::Constants::DEBUG_PLUGINS; | ||||
167 | |||||
168 | 383161 | 2.10s | return $self; | ||
169 | } | ||||
170 | |||||
- - | |||||
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 | 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 | |||||
265 | sub _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 | |||||
291 | 1 | 8µs | 1; | ||
292 | |||||
293 | __END__ |