← Index
NYTProf Performance Profile   « line view »
For rbm/rbm
  Run on Wed Feb 12 20:36:06 2020
Reported on Wed Feb 12 21:42:27 2020

Filename/usr/lib/x86_64-linux-gnu/perl5/5.28/Template/Plugins.pm
StatementsExecuted 4880044 statements in 14.5s
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
3753871113.3s13.3sTemplate::Plugins::::_initTemplate::Plugins::_init
11115µs19µsTemplate::Plugins::::BEGIN@26Template::Plugins::BEGIN@26
1118µs40µsTemplate::Plugins::::BEGIN@27Template::Plugins::BEGIN@27
1117µs31µsTemplate::Plugins::::BEGIN@29Template::Plugins::BEGIN@29
1117µs79µsTemplate::Plugins::::BEGIN@28Template::Plugins::BEGIN@28
0000s0sTemplate::Plugins::::__ANON__[:238]Template::Plugins::__ANON__[:238]
0000s0sTemplate::Plugins::::_dumpTemplate::Plugins::_dump
0000s0sTemplate::Plugins::::_loadTemplate::Plugins::_load
0000s0sTemplate::Plugins::::fetchTemplate::Plugins::fetch
Call graph for these subroutines as a Graphviz dot language file.
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
24package Template::Plugins;
25
26226µs223µs
# spent 19µs (15+4) within Template::Plugins::BEGIN@26 which was called: # once (15µs+4µs) by Template::Config::load at line 26
use strict;
# spent 19µs making 1 call to Template::Plugins::BEGIN@26 # spent 4µs making 1 call to strict::import
27224µs272µs
# spent 40µs (8+32) within Template::Plugins::BEGIN@27 which was called: # once (8µs+32µs) by Template::Config::load at line 27
use warnings;
# spent 40µs making 1 call to Template::Plugins::BEGIN@27 # spent 32µs making 1 call to warnings::import
28226µs2152µs
# spent 79µs (7+73) within Template::Plugins::BEGIN@28 which was called: # once (7µs+73µs) by Template::Config::load at line 28
use base 'Template::Base';
# spent 79µs making 1 call to Template::Plugins::BEGIN@28 # spent 73µs making 1 call to base::import
2921.02ms254µs
# spent 31µs (7+24) within Template::Plugins::BEGIN@29 which was called: # once (7µs+24µs) by Template::Config::load at line 29
use Template::Constants;
# spent 31µs making 1 call to Template::Plugins::BEGIN@29 # spent 24µs making 1 call to Exporter::import
30
311300nsour $VERSION = 2.77;
321200nsour $DEBUG = 0 unless defined $DEBUG;
331200nsour $PLUGIN_BASE = 'Template::Plugin';
34112µsour $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
- -
136#========================================================================
137# -- PRIVATE METHODS --
138#========================================================================
139
140#------------------------------------------------------------------------
141# _init(\%config)
142#
143# Private initialisation method.
144#------------------------------------------------------------------------
145
146
# spent 13.3s within Template::Plugins::_init which was called 375387 times, avg 35µs/call: # 375387 times (13.3s+0s) by Template::Base::new at line 65 of Template/Base.pm, avg 35µs/call
sub _init {
147375387158ms my ($self, $params) = @_;
148 my ($pbase, $plugins, $factory) =
149375387704ms @$params{ qw( PLUGIN_BASE PLUGINS PLUGIN_FACTORY ) };
150
151375387339ms $plugins ||= { };
152
153 # update PLUGIN_BASE to an array ref if necessary
154375387192ms $pbase = [ ] unless defined $pbase;
155375387311ms $pbase = [ $pbase ] unless ref($pbase) eq 'ARRAY';
156
157 # add default plugin base (Template::Plugin) if set
158375387506ms push(@$pbase, $PLUGIN_BASE) if $PLUGIN_BASE;
159
160375387461ms $self->{ PLUGIN_BASE } = $pbase;
1613753877.96s $self->{ PLUGINS } = { %$STD_PLUGINS, %$plugins };
162375387314ms $self->{ TOLERANT } = $params->{ TOLERANT } || 0;
163375387640ms $self->{ LOAD_PERL } = $params->{ LOAD_PERL } || 0;
164375387426ms $self->{ FACTORY } = $factory || { };
165375387379ms $self->{ DEBUG } = ( $params->{ DEBUG } || 0 )
166 & Template::Constants::DEBUG_PLUGINS;
167
1683753872.13s 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
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
29118µs1;
292
293__END__
Report produced by the NYTProf 6.06 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.