File Coverage

lib/CGI/FormBuilder/Template/CGI_SSI.pm
Criterion Covered Total %
statement 16 18 88.8
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 22 24 91.6


line stmt bran cond sub pod time code
1              
2             ###########################################################################
3             # Copyright (c) Nate Wiger http://nateware.com. All Rights Reserved.
4             # Please visit http://formbuilder.org for tutorials, support, and examples.
5             ###########################################################################
6              
7             package CGI::FormBuilder::Template::CGI_SSI;
8              
9             =head1 NAME
10              
11             CGI::FormBuilder::Template::CGI_SSI - FormBuilder interface to CGI::SSI
12              
13             =head1 SYNOPSIS
14              
15             my $form = CGI::FormBuilder->new(
16             fields => \@fields,
17             template => {
18             type => 'CGI_SSI',
19             file => "template.html",
20             },
21             );
22              
23             =cut
24              
25 1     1   4 use Carp;
  1         1  
  1         50  
26 1     1   3 use strict;
  1         1  
  1         14  
27 1     1   3 use warnings;
  1         1  
  1         18  
28 1     1   2 no warnings 'uninitialized';
  1         1  
  1         22  
29              
30 1     1   3 use CGI::FormBuilder::Util;
  1         1  
  1         100  
31 1     1   163 use CGI::SSI;
  0            
  0            
32             use base 'CGI::SSI';
33              
34              
35             our $VERSION = '3.10';
36              
37             #
38             # For legacy reasons, and due to its somewhat odd interface,
39             # CGI::SSI vars use a completely different naming scheme.
40             #
41             our %FORM_VARS = (
42             'js-head' => 'jshead',
43             'form-title' => 'title',
44             'form-start' => 'start',
45             'form-submit' => 'submit',
46             'form-reset' => 'reset',
47             'form-end' => 'end',
48             'form-invalid' => 'invalid',
49             'form-required' => 'required',
50             );
51              
52             our %FIELD_VARS = map { $_ => "$_-%s" } qw(
53             field
54             value
55             label
56             type
57             comment
58             required
59             error
60             invalid
61             missing
62             nameopts
63             cleanopts
64             );
65              
66             sub new {
67             my $self = shift;
68             my $class = ref($self) || $self;
69             my $opt = arghash(@_);
70              
71             $opt->{die_on_bad_params} = 0; # force to avoid blow-ups
72              
73             my %opt2 = %$opt;
74             delete $opt2{virtual};
75             delete $opt2{file};
76             delete $opt2{string};
77             $opt->{engine} = CGI::SSI->new(%opt2);
78              
79             return bless $opt, $class; # rebless
80             }
81              
82             sub engine {
83             return shift()->{engine};
84             }
85              
86             sub render {
87             my $self = shift;
88             my $tvar = shift || puke "Missing template expansion hashref (\$form->prepare failed?)";
89              
90             while(my($to, $from) = each %FORM_VARS) {
91             debug 1, "renaming attr $from to: "
98             #
99             my @fieldlist;
100             for my $field (@{$tvar->{fields}}) {
101              
102             # Field name is usually a good idea
103             my $name = $field->{name};
104             debug 1, "expanding field: $name";
105              
106             # Get all values
107             my @value = @{$tvar->{field}{$name}{values} || []};
108             my @options = @{$tvar->{field}{$name}{options} || []};
109              
110             #
111             # Auto-expand all of our field tags, such as field, label, value
112             # comment, error, etc, etc
113             #
114             my %all_loop;
115             while(my($key, $str) = each %FIELD_VARS) {
116             my $var = sprintf $str, $name;
117             $all_loop{$key} = $tvar->{field}{$name}{$key};
118             $tvar->{$var} = "$tvar->{field}{$name}{$key}"; # fuck Perl
119             debug 2, "