| Filename | /usr/lib/x86_64-linux-gnu/perl5/5.20/Template/Plugins.pm |
| Statements | Executed 202 statements in 3.75ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 4 | 1 | 1 | 5.15ms | 7.22ms | Template::Plugins::_load |
| 7 | 1 | 1 | 126µs | 7.37ms | Template::Plugins::fetch |
| 9 | 2 | 1 | 21µs | 21µs | Template::Plugins::CORE:subst (opcode) |
| 1 | 1 | 1 | 20µs | 32µs | Template::Plugins::BEGIN@26 |
| 1 | 1 | 1 | 19µs | 19µs | Template::Plugins::_init |
| 1 | 1 | 1 | 15µs | 15µs | Template::Plugins::CORE:regcomp (opcode) |
| 1 | 1 | 1 | 10µs | 31µs | Template::Plugins::BEGIN@29 |
| 1 | 1 | 1 | 10µs | 20µs | Template::Plugins::BEGIN@27 |
| 1 | 1 | 1 | 10µs | 64µs | Template::Plugins::BEGIN@28 |
| 1 | 1 | 1 | 2µs | 2µs | Template::Plugins::CORE:match (opcode) |
| 0 | 0 | 0 | 0s | 0s | Template::Plugins::__ANON__[:238] |
| 0 | 0 | 0 | 0s | 0s | Template::Plugins::_dump |
| 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 | 47µs | 2 | 44µs | # spent 32µs (20+12) within Template::Plugins::BEGIN@26 which was called:
# once (20µs+12µs) by Template::Config::load at line 26 # spent 32µs making 1 call to Template::Plugins::BEGIN@26
# spent 12µs making 1 call to strict::import |
| 27 | 2 | 42µs | 2 | 31µs | # spent 20µs (10+11) within Template::Plugins::BEGIN@27 which was called:
# once (10µs+11µs) by Template::Config::load at line 27 # spent 20µs making 1 call to Template::Plugins::BEGIN@27
# spent 11µs making 1 call to warnings::import |
| 28 | 2 | 86µs | 2 | 118µs | # spent 64µs (10+54) within Template::Plugins::BEGIN@28 which was called:
# once (10µs+54µs) by Template::Config::load at line 28 # spent 64µs making 1 call to Template::Plugins::BEGIN@28
# spent 54µs making 1 call to base::import |
| 29 | 2 | 1.05ms | 2 | 53µs | # spent 31µs (10+21) within Template::Plugins::BEGIN@29 which was called:
# once (10µs+21µs) by Template::Config::load at line 29 # spent 31µs making 1 call to Template::Plugins::BEGIN@29
# spent 21µs making 1 call to Exporter::import |
| 30 | |||||
| 31 | 1 | 600ns | our $VERSION = 2.77; | ||
| 32 | 1 | 400ns | our $DEBUG = 0 unless defined $DEBUG; | ||
| 33 | 1 | 300ns | our $PLUGIN_BASE = 'Template::Plugin'; | ||
| 34 | 1 | 17µ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 | # spent 7.37ms (126µs+7.25) within Template::Plugins::fetch which was called 7 times, avg 1.05ms/call:
# 7 times (126µs+7.25ms) by Template::Context::plugin at line 192 of Template/Context.pm, avg 1.05ms/call | ||||
| 89 | 7 | 3µs | my ($self, $name, $args, $context) = @_; | ||
| 90 | 7 | 2µs | my ($factory, $plugin, $error); | ||
| 91 | |||||
| 92 | $self->debug("fetch($name, ", | ||||
| 93 | defined $args ? ('[ ', join(', ', @$args), ' ]') : '<no args>', ', ', | ||||
| 94 | defined $context ? $context : '<no context>', | ||||
| 95 | 7 | 3µs | ')') 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 | 7 | 4µs | $args ||= [ ]; | ||
| 105 | 7 | 4µs | unshift @$args, $context; | ||
| 106 | |||||
| 107 | 7 | 13µs | $factory = $self->{ FACTORY }->{ $name } ||= do { | ||
| 108 | 4 | 11µs | 4 | 7.22ms | ($factory, $error) = $self->_load($name, $context); # spent 7.22ms making 4 calls to Template::Plugins::_load, avg 1.80ms/call |
| 109 | 4 | 800ns | return ($factory, $error) if $error; ## RETURN | ||
| 110 | 4 | 1µs | $factory; | ||
| 111 | }; | ||||
| 112 | |||||
| 113 | # call the new() method on the factory object or class name | ||||
| 114 | 7 | 3µs | eval { | ||
| 115 | 7 | 6µs | if (ref $factory eq 'CODE') { | ||
| 116 | defined( $plugin = &$factory(@$args) ) | ||||
| 117 | || die "$name plugin failed\n"; | ||||
| 118 | } | ||||
| 119 | else { | ||||
| 120 | 7 | 39µs | 7 | 30µs | defined( $plugin = $factory->new(@$args) ) # spent 22µs making 6 calls to Template::Plugin::new, avg 4µs/call
# spent 7µs making 1 call to Template::Plugin::String::new |
| 121 | || die "$name plugin failed: ", $factory->error(), "\n"; | ||||
| 122 | } | ||||
| 123 | }; | ||||
| 124 | 7 | 3µs | if ($error = $@) { | ||
| 125 | # chomp $error; | ||||
| 126 | return $self->{ TOLERANT } | ||||
| 127 | ? (undef, Template::Constants::STATUS_DECLINED) | ||||
| 128 | : ($error, Template::Constants::STATUS_ERROR); | ||||
| 129 | } | ||||
| 130 | |||||
| 131 | 7 | 22µs | return $plugin; | ||
| 132 | } | ||||
| 133 | |||||
| - - | |||||
| 136 | #======================================================================== | ||||
| 137 | # -- PRIVATE METHODS -- | ||||
| 138 | #======================================================================== | ||||
| 139 | |||||
| 140 | #------------------------------------------------------------------------ | ||||
| 141 | # _init(\%config) | ||||
| 142 | # | ||||
| 143 | # Private initialisation method. | ||||
| 144 | #------------------------------------------------------------------------ | ||||
| 145 | |||||
| 146 | # spent 19µs within Template::Plugins::_init which was called:
# once (19µs+0s) by Template::Base::new at line 65 of Template/Base.pm | ||||
| 147 | 1 | 500ns | my ($self, $params) = @_; | ||
| 148 | 1 | 1µs | my ($pbase, $plugins, $factory) = | ||
| 149 | @$params{ qw( PLUGIN_BASE PLUGINS PLUGIN_FACTORY ) }; | ||||
| 150 | |||||
| 151 | 1 | 400ns | $plugins ||= { }; | ||
| 152 | |||||
| 153 | # update PLUGIN_BASE to an array ref if necessary | ||||
| 154 | 1 | 200ns | $pbase = [ ] unless defined $pbase; | ||
| 155 | 1 | 800ns | $pbase = [ $pbase ] unless ref($pbase) eq 'ARRAY'; | ||
| 156 | |||||
| 157 | # add default plugin base (Template::Plugin) if set | ||||
| 158 | 1 | 700ns | push(@$pbase, $PLUGIN_BASE) if $PLUGIN_BASE; | ||
| 159 | |||||
| 160 | 1 | 4µs | $self->{ PLUGIN_BASE } = $pbase; | ||
| 161 | 1 | 8µs | $self->{ PLUGINS } = { %$STD_PLUGINS, %$plugins }; | ||
| 162 | 1 | 400ns | $self->{ TOLERANT } = $params->{ TOLERANT } || 0; | ||
| 163 | 1 | 400ns | $self->{ LOAD_PERL } = $params->{ LOAD_PERL } || 0; | ||
| 164 | 1 | 500ns | $self->{ FACTORY } = $factory || { }; | ||
| 165 | 1 | 800ns | $self->{ DEBUG } = ( $params->{ DEBUG } || 0 ) | ||
| 166 | & Template::Constants::DEBUG_PLUGINS; | ||||
| 167 | |||||
| 168 | 1 | 6µs | 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 | # spent 7.22ms (5.15+2.06) within Template::Plugins::_load which was called 4 times, avg 1.80ms/call:
# 4 times (5.15ms+2.06ms) by Template::Plugins::fetch at line 108, avg 1.80ms/call | ||||
| 182 | 4 | 2µs | my ($self, $name, $context) = @_; | ||
| 183 | 4 | 1µs | my ($factory, $module, $base, $pkg, $file, $ok, $error); | ||
| 184 | |||||
| 185 | 4 | 11µs | 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 | 4 | 24µs | 4 | 8µs | ($module = $name) =~ s/\./::/g; # spent 8µs making 4 calls to Template::Plugins::CORE:subst, avg 2µs/call |
| 198 | |||||
| 199 | 4 | 3µs | foreach $base (@{ $self->{ PLUGIN_BASE } }) { | ||
| 200 | 5 | 6µs | $pkg = $base . '::' . $module; | ||
| 201 | 5 | 24µs | 5 | 13µs | ($file = $pkg) =~ s|::|/|g; # spent 13µs making 5 calls to Template::Plugins::CORE:subst, avg 3µs/call |
| 202 | |||||
| 203 | $self->debug("loading $file.pm (PLUGIN_BASE)") | ||||
| 204 | 5 | 3µs | if $self->{ DEBUG }; | ||
| 205 | |||||
| 206 | 10 | 2.19ms | $ok = eval { require "$file.pm" }; | ||
| 207 | 5 | 7µs | last unless $@; | ||
| 208 | |||||
| 209 | 1 | 31µs | 2 | 18µs | $error .= "$@\n" # spent 15µs making 1 call to Template::Plugins::CORE:regcomp
# spent 2µs making 1 call to Template::Plugins::CORE:match |
| 210 | unless ($@ =~ /^Can\'t locate $file\.pm/); | ||||
| 211 | } | ||||
| 212 | } | ||||
| 213 | |||||
| 214 | 4 | 2µs | if ($ok) { | ||
| 215 | 4 | 5µs | $self->debug("calling $pkg->load()") if $self->{ DEBUG }; | ||
| 216 | |||||
| 217 | 8 | 30µs | 4 | 8µs | $factory = eval { $pkg->load($context) }; # spent 8µs making 4 calls to Template::Plugin::load, avg 2µs/call |
| 218 | 4 | 1µs | $error = ''; | ||
| 219 | 4 | 3µs | 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 | 4 | 1µs | if ($factory) { | ||
| 244 | 4 | 2µs | $self->debug("$name => $factory") if $self->{ DEBUG }; | ||
| 245 | 4 | 18µs | 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 | 6µs | 1; | ||
| 292 | |||||
| 293 | __END__ | ||||
# spent 2µs within Template::Plugins::CORE:match which was called:
# once (2µs+0s) by Template::Plugins::_load at line 209 | |||||
# spent 15µs within Template::Plugins::CORE:regcomp which was called:
# once (15µs+0s) by Template::Plugins::_load at line 209 | |||||
sub Template::Plugins::CORE:subst; # opcode |