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 for 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'});
253 my ($name, $contents, $attr) = $self->_attr(2, @_);
255 $contents = defined $contents && ref $contents ne 'HASH'
256 ? $self->quote($contents) : $self->text($name, $contents);
257 my $label = defined $attr->{label}
258 ? $self->quote(delete $attr->{label})
259 : defined $name ? $self->quote($name) : '';
261 return $self->tag(label => {for => $name, %$attr})
264 . (defined $, ? $, : ' ')
275 HTML::Form::Simple - Generate HTML form elements
279 my $input = HTML::Form::Simple->new;
280 say $input->start; # <form>
281 printf "<label>%s: %s</label>\n", @$_ for (
282 [ 'Your Name' => $input->text(
283 user => 'Mr. Default'
285 [ Message => $input->text(
286 msg => 'Textarea default', {rows => 4, style => 'background:red'}
288 [ Gender => join ' or ', $input->radio(
289 sex => [qw(m f)], [qw(Male Female)]
291 [ Colour => scalar $input->select(
292 favcolour => [qw(Blue Green Red)], 'Green'
294 [ Options => $input->check(
295 spam => 'Receive weekly newsletter'
298 say $input->stop; # </form>
302 Set up a form object with new(). The HTML for the opening and closing
303 C<< <form> >> tags are returned by the start() and stop() methods.
305 The L<hidden>, L<text>, L<select>, L<radio>, and L<check> methods all
306 correspond to various input types. The first argument is always the mandatory
307 name, and a hash ref as the last argument can optionally be provided for
308 additional attributes/options. Everything is properly escaped.
314 Returns the HTML for a simple C<< <input type="hidden"> >> with specified name
315 and value (both are required by HTML specs).
317 $input->hidden('name', 'value');
319 As with all methods, a final hash ref can be given to add further attributes.
320 While rarely needed in this case, it can also be used as an override or
321 alternative to value and name:
323 $input->hidden({name => 'name', value => 'value'})
327 The common C<< <input type="text"> >>.
329 $input->text('name', 'default');
331 If the I<rows> option is set, substitutes a similarly set up C<< <textarea> >>:
333 $input->text('name', 'default', {rows => 4});
337 $input->select('name', ['option'], 'default');
339 Provides C<< <select><option> >> dropdown by default, but can also output
340 multiple C<< <input> >> tags if a I<type> is provided:
342 $input->select('name', ['1'], {type => 'checkbox'});
344 In scalar context, options are joined together by C<$,> (C<$OUTPUT_FIELD_SEPARATOR>).
345 Otherwise a list of tags is returned.
347 Each option can be given as either a simple string containing its I<value>,
348 or a hash ref with custom attributes.
349 When there's no parent tag (only C<< <input> >>s), a fourth parameter can
350 provide common options which will be inherited by each element. Otherwise,
351 options will apply to either the C<< <select> >> or an C<< <option> >>.
353 The default value (either as a third scalar parameter, or with the general
354 I<value> option) will be matched to the value of each option, and if equal,
355 its I<selected> or I<checked> attribute will be set as appropriate.
359 In fact just a shorthand to L<select> with a preset type of I<radio>, but takes
360 an additional third argument to easily set the label for each option:
362 $input->radio('name', ['option'], ['option label'], 'default');
364 This would be the same as saying:
368 [ {label => 'option label', value => 'option'} ],
374 Also a L<select> shorthand, but with a I<checkbox> type.
375 Instead of values, the second argument specifies option I<label>s.
376 The values by default are set to an auto-incrementing number starting with 1.
378 Furthermore, the I<checked> status for each option can be specified by a third
379 argument. Either a single boolean value defining all rows, or an array ref
380 with the value for each row in order.
382 $input->check('name', ['label', 'second option'], [0, 1]);
384 Or more descriptive but identical:
386 $input->check('name', [
387 {label => 'label', value => 1, checked => 0},
388 {label => 'second option', value => 2, checked => 1},
397 =item C<default()> method
399 $input->hidden(foo => $input->default('foo'));
400 $hash_ref = $input->default;
401 $input->default('foo') = 'new value';
402 undef $input->default; # clear all
403 # XXX: does this equal $input->default=undef;?
404 $input->default = {amend => 'stuff'};
408 Actual descriptions instead of just a synopsis.
410 =item C<quote> override
412 Allow custom value quotation function.
413 Makes L<XML::Quote|XML::Quote> dependency optional.
415 =item single checkbox id
417 Do not add value to single check() by default.
423 Mischa POSLAWSKY <perl@shiar.org>
427 This module is free software; you can redistribute it and/or modify it
428 under the same L<terms|perlartistic> as Perl itself.