line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#============================================================= -*-perl-*- |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# Template::Base |
4
|
|
|
|
|
|
|
# |
5
|
|
|
|
|
|
|
# DESCRIPTION |
6
|
|
|
|
|
|
|
# Base class module implementing common functionality for various other |
7
|
|
|
|
|
|
|
# Template Toolkit modules. |
8
|
|
|
|
|
|
|
# |
9
|
|
|
|
|
|
|
# AUTHOR |
10
|
|
|
|
|
|
|
# Andy Wardley |
11
|
|
|
|
|
|
|
# |
12
|
|
|
|
|
|
|
# COPYRIGHT |
13
|
|
|
|
|
|
|
# Copyright (C) 1996-2007 Andy Wardley. All Rights Reserved. |
14
|
|
|
|
|
|
|
# |
15
|
|
|
|
|
|
|
# This module is free software; you can redistribute it and/or |
16
|
|
|
|
|
|
|
# modify it under the same terms as Perl itself. |
17
|
|
|
|
|
|
|
# |
18
|
|
|
|
|
|
|
#======================================================================== |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
package Template::Base; |
21
|
|
|
|
|
|
|
|
22
|
86
|
|
|
86
|
|
582
|
use strict; |
|
86
|
|
|
|
|
315
|
|
|
86
|
|
|
|
|
2870
|
|
23
|
86
|
|
|
86
|
|
716
|
use warnings; |
|
86
|
|
|
|
|
181
|
|
|
86
|
|
|
|
|
2067
|
|
24
|
86
|
|
|
86
|
|
38393
|
use Template::Constants; |
|
86
|
|
|
|
|
195
|
|
|
86
|
|
|
|
|
10015
|
|
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
our $VERSION = 2.78; |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
#------------------------------------------------------------------------ |
30
|
|
|
|
|
|
|
# new(\%params) |
31
|
|
|
|
|
|
|
# |
32
|
|
|
|
|
|
|
# General purpose constructor method which expects a hash reference of |
33
|
|
|
|
|
|
|
# configuration parameters, or a list of name => value pairs which are |
34
|
|
|
|
|
|
|
# folded into a hash. Blesses a hash into an object and calls its |
35
|
|
|
|
|
|
|
# _init() method, passing the parameter hash reference. Returns a new |
36
|
|
|
|
|
|
|
# object derived from Template::Base, or undef on error. |
37
|
|
|
|
|
|
|
#------------------------------------------------------------------------ |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
sub new { |
40
|
1101
|
|
|
1101
|
1
|
38857
|
my $class = shift; |
41
|
1101
|
|
|
|
|
1752
|
my ($argnames, @args, $arg, $cfg); |
42
|
|
|
|
|
|
|
# $class->error(''); # always clear package $ERROR var? |
43
|
|
|
|
|
|
|
|
44
|
86
|
|
|
86
|
|
525
|
{ no strict 'refs'; |
|
86
|
|
|
|
|
156
|
|
|
86
|
|
|
|
|
3137
|
|
|
1101
|
|
|
|
|
3244
|
|
45
|
86
|
|
|
86
|
|
574
|
no warnings 'once'; |
|
86
|
|
|
|
|
138
|
|
|
86
|
|
|
|
|
23883
|
|
46
|
1101
|
|
50
|
|
|
1708
|
$argnames = \@{"$class\::BASEARGS"} || [ ]; |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
# shift off all mandatory args, returning error if undefined or null |
50
|
1101
|
|
|
|
|
5623
|
foreach $arg (@$argnames) { |
51
|
65
|
50
|
|
|
|
531
|
return $class->error("no $arg specified") |
52
|
|
|
|
|
|
|
unless ($cfg = shift); |
53
|
65
|
|
|
|
|
231
|
push(@args, $cfg); |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
# fold all remaining args into a hash, or use provided hash ref |
57
|
1101
|
100
|
100
|
|
|
9016
|
$cfg = defined $_[0] && ref($_[0]) eq 'HASH' ? shift : { @_ }; |
58
|
|
|
|
|
|
|
|
59
|
65
|
|
|
|
|
560
|
my $self = bless { |
60
|
1101
|
|
|
|
|
8397
|
(map { ($_ => shift @args) } @$argnames), |
61
|
|
|
|
|
|
|
_ERROR => '', |
62
|
|
|
|
|
|
|
DEBUG => 0, |
63
|
|
|
|
|
|
|
}, $class; |
64
|
|
|
|
|
|
|
|
65
|
1101
|
100
|
|
|
|
6486
|
return $self->_init($cfg) ? $self : $class->error($self->error); |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
#------------------------------------------------------------------------ |
70
|
|
|
|
|
|
|
# error() |
71
|
|
|
|
|
|
|
# error($msg, ...) |
72
|
|
|
|
|
|
|
# |
73
|
|
|
|
|
|
|
# May be called as a class or object method to set or retrieve the |
74
|
|
|
|
|
|
|
# package variable $ERROR (class method) or internal member |
75
|
|
|
|
|
|
|
# $self->{ _ERROR } (object method). The presence of parameters indicates |
76
|
|
|
|
|
|
|
# that the error value should be set. Undef is then returned. In the |
77
|
|
|
|
|
|
|
# absence of parameters, the current error value is returned. |
78
|
|
|
|
|
|
|
#------------------------------------------------------------------------ |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
sub error { |
81
|
49
|
|
|
49
|
1
|
114
|
my $self = shift; |
82
|
49
|
|
|
|
|
58
|
my $errvar; |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
{ |
85
|
86
|
|
|
86
|
|
517
|
no strict qw( refs ); |
|
86
|
|
|
|
|
250
|
|
|
86
|
|
|
|
|
31824
|
|
|
49
|
|
|
|
|
3294
|
|
86
|
49
|
100
|
|
|
|
166
|
$errvar = ref $self ? \$self->{ _ERROR } : \${"$self\::ERROR"}; |
|
11
|
|
|
|
|
40
|
|
87
|
|
|
|
|
|
|
} |
88
|
49
|
100
|
|
|
|
110
|
if (@_) { |
89
|
23
|
100
|
|
|
|
94
|
$$errvar = ref($_[0]) ? shift : join('', @_); |
90
|
23
|
|
|
|
|
147
|
return undef; |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
else { |
93
|
26
|
|
|
|
|
153
|
return $$errvar; |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
#------------------------------------------------------------------------ |
99
|
|
|
|
|
|
|
# _init() |
100
|
|
|
|
|
|
|
# |
101
|
|
|
|
|
|
|
# Initialisation method called by the new() constructor and passing a |
102
|
|
|
|
|
|
|
# reference to a hash array containing any configuration items specified |
103
|
|
|
|
|
|
|
# as constructor arguments. Should return $self on success or undef on |
104
|
|
|
|
|
|
|
# error, via a call to the error() method to set the error message. |
105
|
|
|
|
|
|
|
#------------------------------------------------------------------------ |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
sub _init { |
108
|
4
|
|
|
4
|
|
7
|
my ($self, $config) = @_; |
109
|
4
|
|
|
|
|
42
|
return $self; |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
sub debug { |
114
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
115
|
0
|
|
|
|
|
0
|
my $msg = join('', @_); |
116
|
0
|
|
|
|
|
0
|
my ($pkg, $file, $line) = caller(); |
117
|
|
|
|
|
|
|
|
118
|
0
|
0
|
|
|
|
0
|
unless ($msg =~ /\n$/) { |
119
|
0
|
0
|
|
|
|
0
|
$msg .= ($self->{ DEBUG } & Template::Constants::DEBUG_CALLER) |
120
|
|
|
|
|
|
|
? " at $file line $line\n" |
121
|
|
|
|
|
|
|
: "\n"; |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
0
|
|
|
|
|
0
|
print STDERR "[$pkg] $msg"; |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
#------------------------------------------------------------------------ |
129
|
|
|
|
|
|
|
# module_version() |
130
|
|
|
|
|
|
|
# |
131
|
|
|
|
|
|
|
# Returns the current version number. |
132
|
|
|
|
|
|
|
#------------------------------------------------------------------------ |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
sub module_version { |
135
|
2
|
|
|
2
|
1
|
3
|
my $self = shift; |
136
|
2
|
|
66
|
|
|
11
|
my $class = ref $self || $self; |
137
|
86
|
|
|
86
|
|
501
|
no strict 'refs'; |
|
86
|
|
|
|
|
174
|
|
|
86
|
|
|
|
|
6003
|
|
138
|
2
|
|
|
|
|
3
|
return ${"${class}::VERSION"}; |
|
2
|
|
|
|
|
12
|
|
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
1; |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
__END__ |