1 package HTML::Form::Simple;
12 my ($class, $default) = @_;
13 bless {default => $default}, $class;
19 my $attr = ref $_[-1] eq 'HASH' ? pop : {};
20 push @_, undef for @_+1 .. $expect;
27 return XML::Quote::xml_quote_min($_[0]);
31 my ($self, $tag, $attr) = @_;
33 # strip empty if it shouldn't be
34 defined $attr->{$_} and $attr->{$_} eq '' and delete $attr->{$_}
35 for qw(id type class style);
37 my $return = '<' . $tag;
40 delete $attr->{$_} and $return .= ' '.$_
41 for qw(selected checked disabled readonly);
43 $return .= sprintf ' %s="%s"', $_, $self->quote($attr->{$_})
44 for sort grep { defined $attr->{$_} } keys %$attr;
51 my ($self, $attr) = @_;
53 return $self->tag(form => $attr);
63 my ($value, $attr) = $self->_attr(1, @_);
65 $attr->{value} = $value if defined $value;
66 $attr->{type} = 'submit' unless defined $attr->{type};
68 return $self->tag(input => $attr);
73 my ($name, $value, $attr) = $self->_attr(2, @_);
75 if (ref $name eq 'HASH') {
76 my @return = map { $self->hidden($_, $name->{$_}, $attr) } sort keys %$name;
77 return wantarray ? @return : join(defined $, ? $, : '', @return);
80 if (ref $value eq 'ARRAY') {
81 my @return = map { $self->hidden($name, $_, $attr) } @$value;
82 return wantarray ? @return : join(defined $, ? $, : '', @return);
85 $attr->{name } = $name if defined $name;
86 $attr->{value} = $value if defined $value;
87 $attr->{value} = $self->{default}->{$name}
88 if not defined $attr->{value} and defined $name and defined $self->{default};
89 $attr->{type} = 'hidden' unless defined $attr->{type};
91 return $self->tag(input => $attr);
96 my ($name, $value, $attr) = $self->_attr(2, @_);
98 $attr->{name } = $name if defined $name;
99 $attr->{value} = $value if defined $value;
100 $attr->{value} = $self->{default}->{$name}
101 if not defined $attr->{value} and defined $name and defined $self->{default};
102 $attr->{id} = $attr->{name} unless defined $attr->{id};
103 $attr->{type} = 'text' unless defined $attr->{type} or defined $attr->{rows};
104 $value = delete $attr->{value} if defined $attr->{rows};
106 return defined $attr->{rows} ? sprintf(
108 $self->tag(textarea => $attr),
109 $self->quote(defined $value ? $value : '')
110 ) : $self->tag(input => $attr);
115 my ($name, $rows, $default, $attr) = $self->_attr(3, @_);
117 $attr->{name} = $name;
118 $attr->{id} = $attr->{name} unless defined $attr->{id};
119 $attr->{type} = 'select' unless defined $attr->{type};
121 $default = $attr->{value} unless defined $default;
122 delete $attr->{value}; # never a parent attribute
123 $default = $self->{default}->{$name}
124 if not defined $default and defined $name and defined $self->{default};
126 my @options = map { ref $_ ? $_ : {value => $_} } @$rows;
130 if ($attr->{type} eq 'select') {
131 delete $attr->{type};
132 if (defined $default) {
134 $_->{selected} = 1 if defined $_->{value} and $_->{value} eq $default;
138 $self->tag(select => $attr),
139 (map { $self->tag(option => $_) } @options),
144 if (defined $attr->{id} and $attr->{id} ne '') {
146 or defined $_->{value} and $_->{id} = $attr->{id}.'_'.$_->{value}
149 if (defined $attr->{label}) {
150 defined $_->{value} and not defined $_->{label}
151 and $_->{label} = $attr->{label}->{$_->{value}}
153 delete $attr->{label};
155 if (defined $default) {
157 $_->{checked} = 1 if defined $_->{value} and $_->{value} eq $default;
160 $_ = {%$attr, %$_} for @options;
162 my $label = delete $_->{label};
163 defined $label && $label ne ''
164 ? '<label>'.$self->tag(input => $_)." $label</label>"
165 : $self->tag(input => $_)
169 return wantarray ? @return : join(defined $, ? $, : '', @return);
174 my ($name, $rows, $label, $attr) = $self->_attr(3, @_);
176 if (not defined $rows) {
177 if (defined $label) {
178 $rows = ref $label eq 'ARRAY' ? [1 .. $#$label+1] : [1];
184 elsif (ref $rows ne 'ARRAY') {
188 if (defined $label) {
189 $rows = [ map { ref $_ eq 'HASH' ? {%$_} : {value => $_} } @$rows ];
190 if (ref $label eq 'ARRAY') {
191 $rows->[$_]->{label} = $label->[$_] for 0 .. $#$rows;
193 $_->{label} = $label for @$rows;
197 $self->select($name, $rows, {%$attr, type => 'radio'});
202 my ($name, $label, $checked, $attr) = $self->_attr(3, @_);
204 my $rows = defined $label ? ref $label eq 'ARRAY' ? [@$label] : [$label] : [{}];
205 ref $_ eq 'HASH' or $_ = {label => $_} for @$rows;
206 if (defined $checked) {
207 if (ref $checked eq 'ARRAY') {
208 $rows->[$_]->{checked} = $checked->[$_] for 0 .. $#$rows;
209 push @$rows, map { {checked => $_} } @$checked[@$rows .. $#$checked];
212 $_->{checked} = $checked for @$rows;
215 exists $rows->[$_]->{value} or $rows->[$_]->{value} = $_ + 1 for 0 .. $#$rows;
216 $rows->[0]->{id} = $attr->{id} || $rows->[0]->{name} || $attr->{name} || $name #XXX: //
217 if ref $label ne 'ARRAY' and defined $rows->[0] and not defined $rows->[0]->{id};
219 $self->select($name, $rows, {%$attr, type => 'checkbox'});
228 HTML::Form::Simple - Generate HTML form elements
232 my $input = HTML::Form::Simple->new;
233 say $input->start; # <form>
234 printf "<label>%s: %s</label>\n", @$_ for (
235 [ 'Your Name' => $input->text(
236 user => 'Mr. Default'
238 [ Message => $input->text(
239 msg => 'Textarea default', {rows => 4, style => 'background:red'}
241 [ Gender => join ' or ', $input->radio(
242 sex => [qw(m f)], [qw(Male Female)]
244 [ Colour => scalar $input->select(
245 favcolour => [qw(Blue Green Red)], 'Green'
247 [ Options => $input->check(
248 spam => 'Receive weekly newsletter'
251 say $input->stop; # </form>
255 Set up a form object with new(). The HTML for the opening and closing
256 C<< <form> >> tags are returned by the start() and stop() methods.
258 The L<hidden>, L<text>, L<select>, L<radio>, and L<check> methods all
259 correspond to various input types. The first argument is always the mandatory
260 name, and a hash ref as the last argument can optionally be provided for
261 additional attributes/options. Everything is properly escaped.
267 Returns the HTML for a simple C<< <input type="hidden"> >> with specified name
268 and value (both are required by HTML specs).
270 $input->hidden('name', 'value');
272 As with all methods, a final hash ref can be given to add further attributes.
273 While rarely needed in this case, it can also be used as an override or
274 alternative to value and name:
276 $input->hidden({name => 'name', value => 'value'})
280 The common C<< <input type="text"> >>.
282 $input->text('name', 'default');
284 If the I<rows> option is set, substitutes a similarly set up C<< <textarea> >>:
286 $input->text('name', 'default', {rows => 4});
290 $input->select('name', ['option'], 'default');
292 Provides C<< <select><option> >> dropdown by default, but can also output
293 multiple C<< <input> >> tags if a I<type> is provided:
295 $input->select('name', ['1'], {type => 'checkbox'});
297 In scalar context, options are joined together by C<$,> (C<$OUTPUT_FIELD_SEPARATOR>).
298 Otherwise a list of tags is returned.
300 Each option can be given as either a simple string containing its I<value>,
301 or a hash ref with custom attributes.
302 When there's no parent tag (only C<< <input> >>s), a fourth parameter can
303 provide common options which will be inherited by each element. Otherwise,
304 options will apply to either the C<< <select> >> or an C<< <option> >>.
306 The default value (either as a third scalar parameter, or with the general
307 I<value> option) will be matched to the value of each option, and if equal,
308 its I<selected> or I<checked> attribute will be set as appropriate.
312 In fact just a shorthand to L<select> with a preset type of I<radio>, but takes
313 an additional third argument to easily set the label for each option:
315 $input->radio('name', ['option'], ['option label'], 'default');
317 This would be the same as saying:
321 [ {label => 'option label', value => 'option'} ],
327 Also a L<select> shorthand, but with a I<checkbox> type.
328 Instead of values, the second argument specifies option I<label>s.
329 The values by default are set to an auto-incrementing number starting with 1.
331 Furthermore, the I<checked> status for each option can be specified by a third
332 argument. Either a single boolean value defining all rows, or an array ref
333 with the value for each row in order.
335 $input->check('name', ['label', 'second option'], [0, 1]);
337 Or more descriptive but identical:
339 $input->check('name', [
340 {label => 'label', value => 1, checked => 0},
341 {label => 'second option', value => 2, checked => 1},
350 =item C<default()> method
352 $input->hidden(foo => $input->default('foo'));
353 $hash_ref = $input->default;
354 $input->default('foo') = 'new value';
355 undef $input->default; # clear all
356 # XXX: does this equal $input->default=undef;?
357 $input->default = {amend => 'stuff'};
361 Actual descriptions instead of just a synopsis.
363 =item C<quote> override
365 Allow custom value quotation function.
366 Makes L<XML::Quote|XML::Quote> dependency optional.
368 =item single checkbox id
370 Do not add value to single check() by default.
376 Mischa POSLAWSKY <perl@shiar.org>
380 This module is free software; you can redistribute it and/or modify it
381 under the same L<terms|perlartistic> as Perl itself.