Filename | /usr/lib/x86_64-linux-gnu/perl5/5.20/Template/Plugin.pm |
Statements | Executed 27 statements in 682µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
6 | 1 | 1 | 22µs | 22µs | new | Template::Plugin::
1 | 1 | 1 | 17µs | 24µs | BEGIN@23 | Template::Plugin::
1 | 1 | 1 | 10µs | 58µs | BEGIN@25 | Template::Plugin::
1 | 1 | 1 | 9µs | 14µs | BEGIN@24 | Template::Plugin::
4 | 1 | 1 | 8µs | 8µs | load | Template::Plugin::
0 | 0 | 0 | 0s | 0s | OLD_AUTOLOAD | Template::Plugin::
0 | 0 | 0 | 0s | 0s | fail | Template::Plugin::
0 | 0 | 0 | 0s | 0s | old_new | Template::Plugin::
Line | State ments |
Time on line |
Calls | Time in subs |
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 <abw@wardley.org> | ||||
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 | 2 | 40µs | 2 | 31µs | # spent 24µs (17+7) within Template::Plugin::BEGIN@23 which was called:
# once (17µs+7µs) by base::import at line 23 # spent 24µs making 1 call to Template::Plugin::BEGIN@23
# spent 7µs making 1 call to strict::import |
24 | 2 | 38µs | 2 | 18µs | # spent 14µs (9+5) within Template::Plugin::BEGIN@24 which was called:
# once (9µs+5µs) by base::import at line 24 # spent 14µs making 1 call to Template::Plugin::BEGIN@24
# spent 5µs making 1 call to warnings::import |
25 | 2 | 550µs | 2 | 58µs | # spent 58µs (10+48) within Template::Plugin::BEGIN@25 which was called:
# once (10µs+48µs) by base::import at line 25 # spent 58µs making 1 call to Template::Plugin::BEGIN@25
# spent 48µs making 1 call to base::import, recursion: max depth 1, sum of overlapping time 48µs |
26 | |||||
27 | 1 | 400ns | our $VERSION = 2.70; | ||
28 | 1 | 300ns | our $DEBUG = 0 unless defined $DEBUG; | ||
29 | 1 | 300ns | our $ERROR = ''; | ||
30 | 1 | 100ns | 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 | # spent 8µs within Template::Plugin::load which was called 4 times, avg 2µs/call:
# 4 times (8µs+0s) by Template::Plugins::_load at line 217 of Template/Plugins.pm, avg 2µs/call | ||||
49 | 4 | 18µs | 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 | # spent 22µs within Template::Plugin::new which was called 6 times, avg 4µs/call:
# 6 times (22µs+0s) by Template::Plugins::fetch at line 120 of Template/Plugins.pm, avg 4µs/call | ||||
69 | 6 | 2µs | my $class = shift; | ||
70 | 6 | 28µs | bless { | ||
71 | }, $class; | ||||
72 | } | ||||
73 | |||||
74 | sub old_new { | ||||
75 | my ($class, $context, $delclass, @params) = @_; | ||||
76 | my ($delegate, $delmod); | ||||
77 | |||||
78 | return $class->error("no context passed to $class constructor\n") | ||||
79 | unless defined $context; | ||||
80 | |||||
81 | if (ref $delclass) { | ||||
82 | # $delclass contains a reference to a delegate object | ||||
83 | $delegate = $delclass; | ||||
84 | } | ||||
85 | else { | ||||
86 | # delclass is the name of a module to load and instantiate | ||||
87 | ($delmod = $delclass) =~ s|::|/|g; | ||||
88 | |||||
89 | eval { | ||||
90 | require "$delmod.pm"; | ||||
91 | $delegate = $delclass->new(@params) | ||||
92 | || die "failed to instantiate $delclass object\n"; | ||||
93 | }; | ||||
94 | return $class->error($@) if $@; | ||||
95 | } | ||||
96 | |||||
97 | 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 | my $class = shift; | ||||
115 | my ($pkg, $file, $line) = caller(); | ||||
116 | warn "Template::Plugin::fail() is deprecated at $file line $line. Please use error()\n"; | ||||
117 | $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 | my $self = shift; | ||||
134 | my $method = $AUTOLOAD; | ||||
135 | |||||
136 | $method =~ s/.*:://; | ||||
137 | return if $method eq 'DESTROY'; | ||||
138 | |||||
139 | if (ref $self eq 'HASH') { | ||||
140 | my $delegate = $self->{ _DELEGATE } || return; | ||||
141 | return $delegate->$method(@_); | ||||
142 | } | ||||
143 | my ($pkg, $file, $line) = caller(); | ||||
144 | # warn "no such '$method' method called on $self at $file line $line\n"; | ||||
145 | return undef; | ||||
146 | } | ||||
147 | |||||
148 | |||||
149 | 1 | 4µs | 1; | ||
150 | |||||
151 | __END__ |