File Coverage

lib/Template/Base.pm
Criterion Covered Total %
statement 47 53 88.6
branch 11 16 68.7
condition 6 8 75.0
subroutine 11 12 91.6
pod 4 4 100.0
total 79 93 84.9


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__