File Coverage

blib/lib/XML/Template.pm
Criterion Covered Total %
statement 3 3 100.0
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 4 4 100.0


line stmt bran cond sub pod time code
1             ###############################################################################
2             # XML::Template
3             #
4             # Copyright (c) 2002-2003 Jonathan A. Waxman
5             # All rights reserved.
6             #
7             # This program is free software; you can redistribute it and/or modify it
8             # under the same terms as Perl itself.
9             #
10             # ----------------------------------------------------------------------------
11             #
12             # Much of the initial design philosophy (and design) was taken from the
13             # masterfully written Template Toolkit by Andy Wardley which I use
14             # extensively myself.
15             ###############################################################################
16             package XML::Template;
17 1     1   8352 use base qw(XML::Template::Base);
  1         2  
  1         808  
18              
19             use strict;
20             use vars qw($VERSION);
21             use CGI;
22             use File::Spec;
23              
24              
25             $VERSION = '3.20';
26              
27             =pod
28              
29             =head1 NAME
30              
31             XML::Template - Front end module to XML::Template.
32              
33             =head1 SYNOPSIS
34              
35             use XML::Template;
36              
37             my $xml_template = XML::Template->new ($config)
38             || die XML::Template->error;
39             $xml_template->process ('filename.xhtml', %vars)
40             || die $xml_template->error;
41              
42             =head1 DESCRIPTION
43              
44             This module provides a front-end interface to XML::Template.
45              
46             =head1 CONSTRUCTOR
47              
48             A constructor method C is provided by L. A list
49             of named configuration parameters may be passed to the constructor. The
50             constructor returns a reference to a new XML::Template object or undef if
51             an error occurrs. If undef is returned, use the method C to
52             retrieve the error. For instance:
53              
54             my $xml_template = XML::Template->new (%config)
55             || die XML::Template->error;
56              
57             The following named configuration parameters are supported by this
58             module:
59              
60             =over 4
61              
62             =item ErrorTemplate
63              
64             If a scalar, the name of the XML::Template document to display when an
65             exception is raised. The template variables C and
66             C will be set for the exception type and description,
67             respectively.
68              
69             C may also be a reference to an array in which the first
70             element is the name of the default error template and the second element
71             is a hash of exception type/template name pairs. If the type of the
72             exception raised in listed in the hash, the associated template will be
73             displayed. Otherwise, the default template is displayed.
74              
75             If no error template is given (the default), XML::Template will die.
76              
77             =item Process
78              
79             A reference to a processor object. This value will override the default
80             value C<$PROCESS> in L. The default process object
81             is L.
82              
83             =back
84              
85             See L and L for additional
86             options.
87              
88             =head1 PRIVATE METHODS
89              
90             =head2 _init
91              
92             This method is the internal initialization function called from
93             L when a new object is created.
94              
95             =cut
96              
97             sub _init {
98             my $self = shift;
99             my %params = @_;
100              
101             print "XML::Template::_init\n" if $self->{_debug};
102              
103             $self->{_error_template} = $params{ErrorTemplate};
104              
105             # Get processor object.
106             $self->{_process} = $params{Process}
107             || XML::Template::Config->process (%params)
108             || return $self->_handle_error (XML::Template::Config->error);
109              
110             return 1;
111             }
112              
113             =pod
114              
115             =head2 _handle_error
116              
117             $self->_handle_error ($type, $info);
118              
119             This method will display the appropriate error template for the exception
120             type, the first parameter. The second parameter is the description of the
121             exception or error message.
122              
123             =cut
124              
125             sub _handle_error {
126             my $self = shift;
127             my ($type, $info) = @_;
128              
129             if (defined $type) {
130             if (defined $self->{_error_template}) {
131             my %vars = (
132             'Exception.type' => $type,
133             'Exception.info' => $info
134             );
135              
136             my $error_template = $self->{_error_template};
137             delete $self->{_error_template};
138              
139             if (ref ($error_template)) {
140             my $default = $error_template->[0];
141             my $templates = $error_template->[1];
142             if (exists $templates->{$type}) {
143             $error_template = $templates->{$type};
144             } else {
145             $error_template = $default;
146             }
147             }
148              
149             select STDOUT; # In case error inside code has selected another fh.
150             if (defined $self->{_process}) {
151             $self->{_process}->{_cgi_header} = 1;
152             my $success;
153             $success = $self->{_process}->process ($error_template, \%vars);
154             if (! $success) {
155             print CGI->header ();
156             print scalar ($self->{_process}->error);
157             return undef;
158             }
159             } else {
160             print CGI->header ();
161             print "$type: $info";
162             return undef;
163             }
164             } else {
165             return $self->error ($type, $info);
166             }
167             }
168              
169             return 1;
170             }
171              
172             =pod
173              
174             =head1 PUBLIC METHODS
175              
176             =head2 process
177              
178             $xml_template->process ($filename, %vars)
179             || die $xml_template->error;
180              
181             This method is used to process an XML file. The first parameter is the
182             name of an XML document. The actual source of the XML depends on the
183             which loader loads the document first. (See L.)
184             The second parameter is a reference to a hash containing name/value pairs
185             of variables to add to the global variable context.
186              
187             =cut
188              
189             sub process {
190             my $self = shift;
191             my ($name, $vars) = @_;
192              
193             print ref ($self) . "::process\n" if $self->{_debug};
194              
195             # Put CGI variables in a global hash named Form.
196             my $cgi = CGI->new ();
197             foreach my $param ($cgi->param) {
198             my @values = $cgi->param ($param);
199             $vars->{"Form.$param"} = scalar (@values) == 1 ? $values[0] : \@values;
200             }
201              
202             if (! $self->{_process}->process ($name, $vars)) {
203             return $self->_handle_error ($self->{_process}->error ());
204             }
205              
206             return 1;
207             }
208              
209             =pod
210              
211             =head1 ACKNOWLEDGEMENTS
212              
213             Much of the initial design philosophy (and design) was taken from or
214             inspired by the masterfully written Template Toolkit by Andy Wardley which
215             I use extensively myself.
216              
217             Thanks to Josh Marcus, August Wohlt, and Kristina Clair for many valuable
218             discussions.
219              
220             =head1 AUTHOR
221              
222             Jonathan A. Waxman
223            
224              
225             =head1 COPYRIGHT
226              
227             Copyright (c) 2002-2003 Jonathan A. Waxman
228             All rights reserved.
229              
230             This program is free software; you can redistribute it and/or
231             modify it under the same terms as Perl itself.
232              
233             =cut
234              
235              
236             1;