File Coverage

lib/Template/Exception.pm
Criterion Covered Total %
statement 42 42 100.0
branch 8 8 100.0
condition 3 3 100.0
subroutine 13 13 100.0
pod 2 7 28.5
total 68 73 93.1


line stmt bran cond sub pod time code
1             #============================================================= -*-Perl-*-
2             #
3             # Template::Exception
4             #
5             # DESCRIPTION
6             # Module implementing a generic exception class used for error handling
7             # in the Template Toolkit.
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::Exception;
21              
22 86     86   2610 use strict;
  86         215  
  86         3306  
23 86     86   599 use warnings;
  86         339  
  86         2589  
24 86     86   800 use constant TYPE => 0;
  86         185  
  86         8012  
25 86     86   678 use constant INFO => 1;
  86         570  
  86         4463  
26 86     86   506 use constant TEXT => 2;
  86         163  
  86         4383  
27 86     86   184754 use overload q|""| => "as_string", fallback => 1;
  86         120235  
  86         715  
28              
29             our $VERSION = 2.70;
30              
31              
32             #------------------------------------------------------------------------
33             # new($type, $info, \$text)
34             #
35             # Constructor method used to instantiate a new Template::Exception
36             # object. The first parameter should contain the exception type. This
37             # can be any arbitrary string of the caller's choice to represent a
38             # specific exception. The second parameter should contain any
39             # information (i.e. error message or data reference) relevant to the
40             # specific exception event. The third optional parameter may be a
41             # reference to a scalar containing output text from the template
42             # block up to the point where the exception was thrown.
43             #------------------------------------------------------------------------
44              
45             sub new {
46 165     165 0 595 my ($class, $type, $info, $textref) = @_;
47 165         1766 bless [ $type, $info, $textref ], $class;
48             }
49              
50              
51             #------------------------------------------------------------------------
52             # type()
53             # info()
54             # type_info()
55             #
56             # Accessor methods to return the internal TYPE and INFO fields.
57             #------------------------------------------------------------------------
58              
59             sub type {
60 193     193 1 2723 $_[0]->[ TYPE ];
61             }
62              
63             sub info {
64 76     76 1 1950 $_[0]->[ INFO ];
65             }
66              
67             sub type_info {
68 1     1 0 3 my $self = shift;
69 1         5 @$self[ TYPE, INFO ];
70             }
71              
72             #------------------------------------------------------------------------
73             # text()
74             # text(\$pretext)
75             #
76             # Method to return the text referenced by the TEXT member. A text
77             # reference may be passed as a parameter to supercede the existing
78             # member. The existing text is added to the *end* of the new text
79             # before being stored. This facility is provided for template blocks
80             # to gracefully de-nest when an exception occurs and allows them to
81             # reconstruct their output in the correct order.
82             #------------------------------------------------------------------------
83              
84             sub text {
85 136     136 0 347 my ($self, $newtextref) = @_;
86 136         455 my $textref = $self->[ TEXT ];
87            
88 136 100       325 if ($newtextref) {
    100          
89 124 100 100     752 $$newtextref .= $$textref if $textref && $textref ne $newtextref;
90 124         243 $self->[ TEXT ] = $newtextref;
91 124         493 return '';
92             }
93             elsif ($textref) {
94 11         54 return $$textref;
95             }
96             else {
97 1         5 return '';
98             }
99             }
100              
101              
102             #------------------------------------------------------------------------
103             # as_string()
104             #
105             # Accessor method to return a string indicating the exception type and
106             # information.
107             #------------------------------------------------------------------------
108              
109             sub as_string {
110 419     419 0 3421 my $self = shift;
111 419         2513 return $self->[ TYPE ] . ' error - ' . $self->[ INFO ];
112             }
113              
114              
115             #------------------------------------------------------------------------
116             # select_handler(@types)
117             #
118             # Selects the most appropriate handler for the exception TYPE, from
119             # the list of types passed in as parameters. The method returns the
120             # item which is an exact match for TYPE or the closest, more
121             # generic handler (e.g. foo being more generic than foo.bar, etc.)
122             #------------------------------------------------------------------------
123              
124             sub select_handler {
125 121     121 0 2810 my ($self, @options) = @_;
126 121         258 my $type = $self->[ TYPE ];
127 121         228 my %hlut;
128 121         469 @hlut{ @options } = (1) x @options;
129              
130 121         510 while ($type) {
131 132 100       487 return $type if $hlut{ $type };
132              
133             # strip .element from the end of the exception type to find a
134             # more generic handler
135 95         668 $type =~ s/\.?[^\.]*$//;
136             }
137 84         333 return undef;
138             }
139            
140             1;
141              
142             __END__