20
our $VERSION = '3.03';
25
no warnings 'uninitialized';
22
27
use CGI::FormBuilder::Util;
23
28
use HTML::Template;
24
29
use base 'HTML::Template';
31
our $REVISION = do { (my $r='$Revision: 100 $') =~ s/\D+//g; $r };
32
our $VERSION = '3.0501';
35
# For legacy reasons, and due to its somewhat odd interface,
36
# HTML::Template vars use a completely different naming scheme.
39
'js-head' => 'jshead',
40
'form-title' => 'title',
41
'form-start' => 'start',
42
'form-submit' => 'submit',
43
'form-reset' => 'reset',
45
'form-invalid' => 'invalid',
46
'form-required' => 'required',
49
our %FIELD_VARS = map { $_ => "$_-%s" } qw(
28
65
my $class = ref($self) || $self;
31
$opt{die_on_bad_params} = 0; # force to avoid blow-ups
32
$opt{engine} = HTML::Template->new(%opt);
34
return bless \%opt, $class; # rebless
66
my $opt = arghash(@_);
68
$opt->{die_on_bad_params} = 0; # force to avoid blow-ups
69
$opt->{engine} = HTML::Template->new(%$opt);
71
return bless $opt, $class; # rebless
45
# a couple special fields
46
my %tmplvar = $form->tmpl_param;
48
# must generate JS first since it affects the others
49
$tmplvar{'js-head'} = $form->script;
50
$tmplvar{'form-title'} = $form->title;
51
$tmplvar{'form-start'} = $form->start . $form->statetags . $form->keepextras;
52
$tmplvar{'form-submit'} = $form->submit;
53
$tmplvar{'form-reset'} = $form->reset;
54
$tmplvar{'form-end'} = $form->end;
56
# for HTML::Template, each data struct is manually assigned
80
my $tvar = shift || puke "Missing template expansion hashref (\$form->prepare failed?)";
82
while(my($to, $from) = each %FORM_VARS) {
83
debug 1, "renaming attr $from to: <tmpl_var $to>";
84
$tvar->{$to} = "$tvar->{$from}";
88
# For HTML::Template, each data struct is manually assigned
57
89
# to a separate <tmpl_var> and <tmpl_loop> tag
58
for my $field ($form->field) {
60
# Extract value since used often
61
my @value = $field->tag_value;
63
# assign the field tag
64
$tmplvar{"field-$field"} = $field->tag;
65
debug 2, "<tmpl_var field-$field> = " . $tmplvar{"field-$field"};
67
# and the value tag - can only hold first value!
68
$tmplvar{"value-$field"} = $value[0];
69
debug 2, "<tmpl_var value-$field> = " . $tmplvar{"value-$field"};
71
# and the label tag for the field
72
$tmplvar{"label-$field"} = $field->label;
73
debug 2, "<tmpl_var label-$field> = " . $tmplvar{"value-$field"};
76
$tmplvar{"comment-$field"} = $field->comment;
79
$tmplvar{"error-$field"} = $field->error;
81
# create a <tmpl_loop> for multi-values/multi-opts
92
for my $field (@{$tvar->{fields}}) {
94
# Field name is usually a good idea
95
my $name = $field->{name};
96
debug 1, "expanding field: $name";
99
my @value = @{$tvar->{field}{$name}{values} || []};
100
my @options = @{$tvar->{field}{$name}{options} || []};
103
# Auto-expand all of our field tags, such as field, label, value
104
# comment, error, etc, etc
107
while(my($key, $str) = each %FIELD_VARS) {
108
my $var = sprintf $str, $name;
109
$all_loop{$key} = $tvar->{field}{$name}{$key};
110
$tvar->{$var} = "$tvar->{field}{$name}{$key}"; # fuck Perl
111
debug 2, "<tmpl_var $var> = " . $all_loop{$str};
115
# Create a <tmpl_loop> for multi-values/multi-opts
82
116
# we can't include the field, really, since this would involve
83
117
# too much effort knowing what type
84
119
my @tmpl_loop = ();
85
for my $opt ($field->options) {
120
for my $opt (@options) {
86
121
# Since our data structure is a series of ['',''] things,
87
122
# we get the name from that. If not, then it's a list
88
123
# of regular old data that we _toname if nameopts => 1
124
debug 2, "looking at field $name option $opt";
89
125
my($o,$n) = optval $opt;
90
$n ||= $field->nameopts ? toname($o) : $o;
126
$n ||= $tvar->{"nameopts-$name"} ? toname($o) : $o;
91
127
my($slct, $chk) = ismember($o, @value) ? ('selected', 'checked') : ('','');
92
debug 2, "<tmpl_loop loop-$field> = adding { label => $n, value => $o }";
128
debug 2, "<tmpl_loop loop-$name> = adding { label => $n, value => $o }";
93
129
push @tmpl_loop, {
101
# now assign our loop-field
102
$tmplvar{"loop-$field"} = \@tmpl_loop;
137
# Now assign our loop-field
138
$tvar->{"loop-$name"} = \@tmpl_loop;
104
# finally, push onto a top-level loop named "fields"
105
push @{$tmplvar{fields}}, {
106
field => $field->tag,
109
options => [ $field->options ],
110
label => $field->label,
111
comment => $field->comment,
112
error => $field->error,
140
# Finally, push onto a top-level loop named "fields"
142
field => $all_loop{field},
143
value => $all_loop{value},
144
values => [ @value ],
145
options => [ @options ],
146
label => $all_loop{label},
147
comment => $all_loop{comment},
148
error => $all_loop{error},
149
required=> $all_loop{required},
150
missing => $all_loop{missing},
151
fieldset=> $all_loop{fieldset},
152
loop => [ @tmpl_loop ],
155
# kill our previous fields list
156
$tvar->{fields} = \@fieldlist;
117
158
# loop thru each field we have and set the tmpl_param
118
while(my($param, $tag) = each %tmplvar) {
159
while(my($param, $tag) = each %$tvar) {
119
160
$self->{engine}->param($param => $tag);
122
# prepend header to template rendering
123
return $form->header . $self->{engine}->output;
164
return $self->{engine}->output;
added
removed
lib/CGI/FormBuilder/Template/HTML.pm
