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 85     85   8459 use strict;
  85         149  
  85         2902  
23 85     85   429 use warnings;
  85         148  
  85         2290  
24 85     85   38926 use Template::Constants;
  85         204  
  85         9426  
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 13770 my $class = shift;
41 1101         1705 my ($argnames, @args, $arg, $cfg);
42             # $class->error(''); # always clear package $ERROR var?
43              
44 85     85   490 { no strict 'refs';
  85         300  
  85         3188  
  1101         1560  
45 85     85   420 no warnings 'once';
  85         145  
  85         21278  
46 1101   50     1756 $argnames = \@{"$class\::BASEARGS"} || [ ];
47             }
48              
49             # shift off all mandatory args, returning error if undefined or null
50 1101         2940 foreach $arg (@$argnames) {
51 65 50       203 return $class->error("no $arg specified")
52             unless ($cfg = shift);
53 65         205 push(@args, $cfg);
54             }
55              
56             # fold all remaining args into a hash, or use provided hash ref
57 1101 100 100     7884 $cfg = defined $_[0] && ref($_[0]) eq 'HASH' ? shift : { @_ };
58              
59 65         666 my $self = bless {
60 1101         5977 (map { ($_ => shift @args) } @$argnames),
61             _ERROR => '',
62             DEBUG => 0,
63             }, $class;
64            
65 1101 100       5368 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 118 my $self = shift;
82 49         70 my $errvar;
83              
84             {
85 85     85   483 no strict qw( refs );
  85         174  
  85         31813  
  49         59  
86 49 100       163 $errvar = ref $self ? \$self->{ _ERROR } : \${"$self\::ERROR"};
  11         42  
87             }
88 49 100       113 if (@_) {
89 23 100       91 $$errvar = ref($_[0]) ? shift : join('', @_);
90 23         157 return undef;
91             }
92             else {
93 26         169 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   9 my ($self, $config) = @_;
109 4         44 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 4 my $self = shift;
136 2   66     11 my $class = ref $self || $self;
137 85     85   508 no strict 'refs';
  85         177  
  85         11844  
138 2         16 return ${"${class}::VERSION"};
  2         15  
139             }
140              
141              
142             1;
143              
144             __END__