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;
39 # add boolean attributes
40 delete $attr->{$_} and $return .= ' '.$_
41 for qw(selected checked disabled readonly);
43 # add attributes with (escaped) string values
44 $return .= sprintf ' %s="%s"', $_, $self->quote($attr->{$_})
45 for sort grep { defined $attr->{$_} } keys %$attr;
52 my ($self, $attr) = @_;
54 return $self->tag(form => $attr);
64 my ($value, $attr) = $self->_attr(1, @_);
66 $attr->{value} = $value if defined $value;
67 $attr->{type} = 'submit' unless defined $attr->{type};
69 return $self->tag(input => $attr);
74 my ($name, $value, $attr) = $self->_attr(2, @_);
76 if (ref $name eq 'HASH') {
77 my @return = map { $self->hidden($_, $name->{$_}, $attr) } sort keys %$name;
78 return wantarray ? @return : join(defined $, ? $, : '', @return);
81 if (ref $value eq 'ARRAY') {
82 my @return = map { $self->hidden($name, $_, $attr) } @$value;
83 return wantarray ? @return : join(defined $, ? $, : '', @return);
86 $attr->{name } = $name if defined $name;
87 $attr->{value} = $value if defined $value;
88 $attr->{value} = $self->{default}->{$name}
89 if not defined $attr->{value} and defined $name and defined $self->{default};
90 $attr->{type} = 'hidden' unless defined $attr->{type};
92 return $self->tag(input => $attr);
97 my ($name, $value, $attr) = $self->_attr(2, @_);
99 $attr->{name } = $name if defined $name;
100 $attr->{value} = $value if defined $value;
101 $attr->{value} = $self->{default}->{$name}
102 if not defined $attr->{value} and defined $name and defined $self->{default};
103 $attr->{id} = $attr->{name} unless defined $attr->{id};
104 $attr->{type} = 'text' unless defined $attr->{type} or defined $attr->{rows};
106 # textarea does not have value as tag attribute
107 $value = delete $attr->{value} if defined $attr->{rows};
109 return defined $attr->{rows} ? sprintf(
111 $self->tag(textarea => $attr),
112 $self->quote(defined $value ? $value : '')
113 ) : $self->tag(input => $attr);
118 my ($name, $rows, $default, $attr) = $self->_attr(3, @_);
120 $attr->{name} = $name;
121 $attr->{id} = $attr->{name} unless defined $attr->{id};
122 $attr->{type} = 'select' unless defined $attr->{type};
124 $default = $attr->{value} unless defined $default;
125 delete $attr->{value}; # never a parent attribute
126 $default = $self->{default}->{$name}
127 if not defined $default and defined $name and defined $self->{default};
129 my @options = map { ref $_ ? $_ : {value => $_} } @$rows;
133 if ($attr->{type} eq 'select') {
134 delete $attr->{type};
136 # select option(s) matching the default value
137 if (defined $default) {
139 $_->{selected} = 1 if defined $_->{value} and $_->{value} eq $default;
144 $self->tag(select => $attr),
145 (map { $self->tag(option => $_) } @options),
150 # set fallback option id from parent id and value
151 if (defined $attr->{id} and $attr->{id} ne '') {
153 or defined $_->{value} and $_->{id} = $attr->{id}.'_'.$_->{value}
157 # put parent label attribute on options
158 if (defined $attr->{label}) {
159 defined $_->{value} and not defined $_->{label}
160 and $_->{label} = $attr->{label}->{$_->{value}}
162 delete $attr->{label};
165 # check any option matching the default value
166 if (defined $default) {
168 $_->{checked} = 1 if defined $_->{value} and $_->{value} eq $default;
172 $_ = {%$attr, %$_} for @options;
174 my $label = delete $_->{label};
175 defined $label && $label ne ''
176 ? '<label>'.$self->tag(input => $_)." $label</label>"
177 : $self->tag(input => $_)
181 return wantarray ? @return : join(defined $, ? $, : '', @return);
186 my ($name, $rows, $label, $default, $attr) = $self->_attr(4, @_);
188 # normalize rows array
189 if (not defined $rows) {
190 if (defined $label) {
191 # fill up values with numbers to match labels
192 $rows = ref $label eq 'ARRAY' ? [1 .. $#$label+1] : [1];
198 elsif (ref $rows ne 'ARRAY') {
203 if (defined $label) {
204 # convert options to hash refs so we can add label attributes
205 $rows = [ map { ref $_ eq 'HASH' ? {%$_} : {value => $_} } @$rows ];
207 if (ref $label eq 'ARRAY') {
208 $rows->[$_]->{label} = $label->[$_] for 0 .. $#$rows;
210 $_->{label} = $label for @$rows;
214 $self->select($name, $rows, $default, {%$attr, type => 'radio'});
219 my ($name, $label, $checked, $attr) = $self->_attr(3, @_);
221 # create option rows array from label argument
222 my $rows = defined $label ? ref $label eq 'ARRAY' ? [@$label] : [$label] : [{}];
223 # convert options to hash refs sooner rather than later
224 $_ = ref $_ eq 'HASH' ? {%$_} : {label => $_} for @$rows;
226 # parse checked argument
227 if (defined $checked) {
228 if (ref $checked eq 'ARRAY') {
229 # each checked row corresponding to an option
230 $rows->[$_]->{checked} = $checked->[$_] for 0 .. $#$rows;
231 # add superfluous rows as new options
232 push @$rows, map { {checked => $_} } @$checked[@$rows .. $#$checked];
235 # a single value for all options
236 $_->{checked} = $checked for @$rows;
240 # set default option value (argument number)
241 exists $rows->[$_]->{value} or $rows->[$_]->{value} = $_ + 1 for 0 .. $#$rows;
243 # set option id without added value if rows were not given as array
244 $rows->[0]->{id} = $attr->{id} || $rows->[0]->{name} || $attr->{name} || $name #XXX: //
245 if ref $label ne 'ARRAY' and defined $rows->[0] and not defined $rows->[0]->{id};
247 $self->select($name, $rows, {%$attr, type => 'checkbox'});
256 HTML::Form::Simple - Generate HTML form elements
260 my $input = HTML::Form::Simple->new;
261 say $input->start; # <form>
262 printf "<label>%s: %s</label>\n", @$_ for (
263 [ 'Your Name' => $input->text(
264 user => 'Mr. Default'
266 [ Message => $input->text(
267 msg => 'Textarea default', {rows => 4, style => 'background:red'}
269 [ Gender => join ' or ', $input->radio(
270 sex => [qw(m f)], [qw(Male Female)]
272 [ Colour => scalar $input->select(
273 favcolour => [qw(Blue Green Red)], 'Green'
275 [ Options => $input->check(
276 spam => 'Receive weekly newsletter'
279 say $input->stop; # </form>
283 Set up a form object with new(). The HTML for the opening and closing
284 C<< <form> >> tags are returned by the start() and stop() methods.
286 The L<hidden>, L<text>, L<select>, L<radio>, and L<check> methods all
287 correspond to various input types. The first argument is always the mandatory
288 name, and a hash ref as the last argument can optionally be provided for
289 additional attributes/options. Everything is properly escaped.
295 Returns the HTML for a simple C<< <input type="hidden"> >> with specified name
296 and value (both are required by HTML specs).
298 $input->hidden('name', 'value');
300 As with all methods, a final hash ref can be given to add further attributes.
301 While rarely needed in this case, it can also be used as an override or
302 alternative to value and name:
304 $input->hidden({name => 'name', value => 'value'})
308 The common C<< <input type="text"> >>.
310 $input->text('name', 'default');
312 If the I<rows> option is set, substitutes a similarly set up C<< <textarea> >>:
314 $input->text('name', 'default', {rows => 4});
318 $input->select('name', ['option'], 'default');
320 Provides C<< <select><option> >> dropdown by default, but can also output
321 multiple C<< <input> >> tags if a I<type> is provided:
323 $input->select('name', ['1'], {type => 'checkbox'});
325 In scalar context, options are joined together by C<$,> (C<$OUTPUT_FIELD_SEPARATOR>).
326 Otherwise a list of tags is returned.
328 Each option can be given as either a simple string containing its I<value>,
329 or a hash ref with custom attributes.
330 When there's no parent tag (only C<< <input> >>s), a fourth parameter can
331 provide common options which will be inherited by each element. Otherwise,
332 options will apply to either the C<< <select> >> or an C<< <option> >>.
334 The default value (either as a third scalar parameter, or with the general
335 I<value> option) will be matched to the value of each option, and if equal,
336 its I<selected> or I<checked> attribute will be set as appropriate.
340 In fact just a shorthand to L<select> with a preset type of I<radio>, but takes
341 an additional third argument to easily set the label for each option:
343 $input->radio('name', ['option'], ['option label'], 'default');
345 This would be the same as saying:
349 [ {label => 'option label', value => 'option'} ],
355 Also a L<select> shorthand, but with a I<checkbox> type.
356 Instead of values, the second argument specifies option I<label>s.
357 The values by default are set to an auto-incrementing number starting with 1.
359 Furthermore, the I<checked> status for each option can be specified by a third
360 argument. Either a single boolean value defining all rows, or an array ref
361 with the value for each row in order.
363 $input->check('name', ['label', 'second option'], [0, 1]);
365 Or more descriptive but identical:
367 $input->check('name', [
368 {label => 'label', value => 1, checked => 0},
369 {label => 'second option', value => 2, checked => 1},
378 =item C<default()> method
380 $input->hidden(foo => $input->default('foo'));
381 $hash_ref = $input->default;
382 $input->default('foo') = 'new value';
383 undef $input->default; # clear all
384 # XXX: does this equal $input->default=undef;?
385 $input->default = {amend => 'stuff'};
389 Actual descriptions instead of just a synopsis.
391 =item C<quote> override
393 Allow custom value quotation function.
394 Makes L<XML::Quote|XML::Quote> dependency optional.
396 =item single checkbox id
398 Do not add value to single check() by default.
404 Mischa POSLAWSKY <perl@shiar.org>
408 This module is free software; you can redistribute it and/or modify it
409 under the same L<terms|perlartistic> as Perl itself.