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 ${$_[0]} if ref $_[0] eq 'SCALAR';
28 return XML::Quote::xml_quote_min($_[0]);
32 my ($self, $tag, $attr) = @_;
34 # strip empty if it shouldn't be
35 defined $attr->{$_} and $attr->{$_} eq '' and delete $attr->{$_}
36 for qw(id type class style);
38 my $return = '<' . $tag;
40 # add boolean attributes
41 delete $attr->{$_} and $return .= ' '.$_
42 for qw(selected checked disabled readonly);
44 # add attributes with (escaped) string values
45 $return .= sprintf ' %s="%s"', $_, $self->quote($attr->{$_})
46 for sort grep { defined $attr->{$_} } keys %$attr;
53 my ($self, $attr) = @_;
55 return $self->tag(form => $attr);
65 my ($value, $attr) = $self->_attr(1, @_);
67 $attr->{value} = $value if defined $value;
68 $attr->{type} = 'submit' unless defined $attr->{type};
70 return $self->tag(input => $attr);
75 my ($name, $value, $attr) = $self->_attr(2, @_);
77 if (ref $name eq 'HASH') {
78 my @return = map { $self->hidden($_, $name->{$_}, $attr) } sort keys %$name;
79 return wantarray ? @return : join(defined $, ? $, : '', @return);
82 if (ref $value eq 'ARRAY') {
83 my @return = map { $self->hidden($name, $_, $attr) } @$value;
84 return wantarray ? @return : join(defined $, ? $, : '', @return);
87 $attr->{name } = $name if defined $name;
88 $attr->{value} = $value if defined $value;
89 $attr->{value} = $self->{default}->{$name}
90 if not defined $attr->{value} and defined $name and defined $self->{default};
91 $attr->{type} = 'hidden' unless defined $attr->{type};
93 return $self->tag(input => $attr);
98 my ($name, $value, $attr) = $self->_attr(2, @_);
100 $attr->{name } = $name if defined $name;
101 $attr->{value} = $value if defined $value;
102 $attr->{value} = $self->{default}->{$name}
103 if not defined $attr->{value} and defined $name and defined $self->{default};
104 $attr->{id} = $attr->{name} unless defined $attr->{id};
105 $attr->{type} = 'text' unless defined $attr->{type} or defined $attr->{rows};
107 # textarea does not have value as tag attribute
108 $value = delete $attr->{value} if defined $attr->{rows};
110 return defined $attr->{rows} ? sprintf(
112 $self->tag(textarea => $attr),
113 $self->quote(defined $value ? $value : '')
114 ) : $self->tag(input => $attr);
119 my ($name, $rows, $default, $attr) = $self->_attr(3, @_);
121 $attr->{name} = $name;
122 $attr->{id} = $attr->{name} unless defined $attr->{id};
123 $attr->{type} = 'select' unless defined $attr->{type};
125 $default = $attr->{value} unless defined $default;
126 delete $attr->{value}; # never a parent attribute
127 $default = $self->{default}->{$name}
128 if not defined $default and defined $name and defined $self->{default};
130 my @options = map { ref $_ ? $_ : {value => $_} } @$rows;
134 if ($attr->{type} eq 'select') {
135 delete $attr->{type};
137 # select option(s) matching the default value
138 if (defined $default) {
140 $_->{selected} = 1 if defined $_->{value} and $_->{value} eq $default;
145 $self->tag(select => $attr),
146 (map { $self->tag(option => $_) } @options),
151 # set fallback option id from parent id and value
152 if (defined $attr->{id} and $attr->{id} ne '') {
154 or defined $_->{value} and $_->{id} = $attr->{id}.'_'.$_->{value}
158 # put parent label attribute on options
159 if (defined $attr->{label}) {
160 defined $_->{value} and not defined $_->{label}
161 and $_->{label} = $attr->{label}->{$_->{value}}
163 delete $attr->{label};
166 # check any option matching the default value
167 if (defined $default) {
169 $_->{checked} = 1 if defined $_->{value} and $_->{value} eq $default;
173 $_ = {%$attr, %$_} for @options;
175 my $label = delete $_->{label};
176 defined $label && $label ne ''
177 ? '<label>'.$self->tag(input => $_)." $label</label>"
178 : $self->tag(input => $_)
182 return wantarray ? @return : join(defined $, ? $, : '', @return);
187 my ($name, $rows, $label, $default, $attr) = $self->_attr(4, @_);
189 # normalize rows array
190 if (not defined $rows) {
191 if (defined $label) {
192 # fill up values with numbers to match labels
193 $rows = ref $label eq 'ARRAY' ? [1 .. $#$label+1] : [1];
199 elsif (ref $rows ne 'ARRAY') {
204 if (defined $label) {
205 # convert options to hash refs so we can add label attributes
206 $rows = [ map { ref $_ eq 'HASH' ? {%$_} : {value => $_} } @$rows ];
208 if (ref $label eq 'ARRAY') {
209 $rows->[$_]->{label} = $label->[$_] for 0 .. $#$rows;
211 $_->{label} = $label for @$rows;
215 $self->select($name, $rows, $default, {%$attr, type => 'radio'});
220 my ($name, $label, $checked, $attr) = $self->_attr(3, @_);
222 # create option rows array from label argument
223 my $rows = defined $label ? ref $label eq 'ARRAY' ? [@$label] : [$label] : [{}];
224 # convert options to hash refs sooner rather than later
225 $_ = ref $_ eq 'HASH' ? {%$_} : {label => $_} for @$rows;
227 # parse checked argument
228 if (defined $checked) {
229 if (ref $checked eq 'ARRAY') {
230 # each checked row corresponding to an option
231 $rows->[$_]->{checked} = $checked->[$_] for 0 .. $#$rows;
232 # add superfluous rows as new options
233 push @$rows, map { {checked => $_} } @$checked[@$rows .. $#$checked];
236 # a single value for all options
237 $_->{checked} = $checked for @$rows;
241 # set default option value (argument number)
242 exists $rows->[$_]->{value} or $rows->[$_]->{value} = $_ + 1 for 0 .. $#$rows;
244 # set option id without added value if rows were not given as array
245 $rows->[0]->{id} = $attr->{id} || $rows->[0]->{name} || $attr->{name} || $name #XXX: //
246 if ref $label ne 'ARRAY' and defined $rows->[0] and not defined $rows->[0]->{id};
248 $self->select($name, $rows, {%$attr, type => 'checkbox'});
257 HTML::Form::Simple - Generate HTML form elements
261 my $input = HTML::Form::Simple->new;
262 say $input->start; # <form>
263 printf "<label>%s: %s</label>\n", @$_ for (
264 [ 'Your Name' => $input->text(
265 user => 'Mr. Default'
267 [ Message => $input->text(
268 msg => 'Textarea default', {rows => 4, style => 'background:red'}
270 [ Gender => join ' or ', $input->radio(
271 sex => [qw(m f)], [qw(Male Female)]
273 [ Colour => scalar $input->select(
274 favcolour => [qw(Blue Green Red)], 'Green'
276 [ Options => $input->check(
277 spam => 'Receive weekly newsletter'
280 say $input->stop; # </form>
284 Set up a form object with new(). The HTML for the opening and closing
285 C<< <form> >> tags are returned by the start() and stop() methods.
287 The L<hidden>, L<text>, L<select>, L<radio>, and L<check> methods all
288 correspond to various input types. The first argument is always the mandatory
289 name, and a hash ref as the last argument can optionally be provided for
290 additional attributes/options. Everything is properly escaped.
296 Returns the HTML for a simple C<< <input type="hidden"> >> with specified name
297 and value (both are required by HTML specs).
299 $input->hidden('name', 'value');
301 As with all methods, a final hash ref can be given to add further attributes.
302 While rarely needed in this case, it can also be used as an override or
303 alternative to value and name:
305 $input->hidden({name => 'name', value => 'value'})
309 The common C<< <input type="text"> >>.
311 $input->text('name', 'default');
313 If the I<rows> option is set, substitutes a similarly set up C<< <textarea> >>:
315 $input->text('name', 'default', {rows => 4});
319 $input->select('name', ['option'], 'default');
321 Provides C<< <select><option> >> dropdown by default, but can also output
322 multiple C<< <input> >> tags if a I<type> is provided:
324 $input->select('name', ['1'], {type => 'checkbox'});
326 In scalar context, options are joined together by C<$,> (C<$OUTPUT_FIELD_SEPARATOR>).
327 Otherwise a list of tags is returned.
329 Each option can be given as either a simple string containing its I<value>,
330 or a hash ref with custom attributes.
331 When there's no parent tag (only C<< <input> >>s), a fourth parameter can
332 provide common options which will be inherited by each element. Otherwise,
333 options will apply to either the C<< <select> >> or an C<< <option> >>.
335 The default value (either as a third scalar parameter, or with the general
336 I<value> option) will be matched to the value of each option, and if equal,
337 its I<selected> or I<checked> attribute will be set as appropriate.
341 In fact just a shorthand to L<select> with a preset type of I<radio>, but takes
342 an additional third argument to easily set the label for each option:
344 $input->radio('name', ['option'], ['option label'], 'default');
346 This would be the same as saying:
350 [ {label => 'option label', value => 'option'} ],
356 Also a L<select> shorthand, but with a I<checkbox> type.
357 Instead of values, the second argument specifies option I<label>s.
358 The values by default are set to an auto-incrementing number starting with 1.
360 Furthermore, the I<checked> status for each option can be specified by a third
361 argument. Either a single boolean value defining all rows, or an array ref
362 with the value for each row in order.
364 $input->check('name', ['label', 'second option'], [0, 1]);
366 Or more descriptive but identical:
368 $input->check('name', [
369 {label => 'label', value => 1, checked => 0},
370 {label => 'second option', value => 2, checked => 1},
379 =item C<default()> method
381 $input->hidden(foo => $input->default('foo'));
382 $hash_ref = $input->default;
383 $input->default('foo') = 'new value';
384 undef $input->default; # clear all
385 # XXX: does this equal $input->default=undef;?
386 $input->default = {amend => 'stuff'};
390 Actual descriptions instead of just a synopsis.
392 =item C<quote> override
394 Allow custom value quotation function.
395 Makes L<XML::Quote|XML::Quote> dependency optional.
397 =item single checkbox id
399 Do not add value to single check() by default.
405 Mischa POSLAWSKY <perl@shiar.org>
409 This module is free software; you can redistribute it and/or modify it
410 under the same L<terms|perlartistic> as Perl itself.