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>
259 $input->hidden(name => 'value');
263 $input->text(name => 'default');
267 $input->select(name => ['option'], 'default');
271 $input->radio(name => ['option'], ['option label'], 'default');
277 [ {label => 'option label', value => 'option'} ],
283 $input->check(name => ['label', 'second option'], [0, 1]);
287 $input->check(name => [
288 {label => 'label', value => 1, checked => 0},
289 {label => 'second option', value => 2, checked => 1},
298 =item C<default()> method
300 $input->hidden(foo => $input->default('foo'));
301 $hash_ref = $input->default;
302 $input->default('foo') = 'new value';
303 undef $input->default; # clear all
304 # XXX: does this equal $input->default=undef;?
305 $input->default = {amend => 'stuff'};
309 Actual descriptions instead of just a synopsis.
311 =item C<quote> override
313 Allow custom value quotation function.
314 Makes L<XML::Quote|XML::Quote> dependency optional.
316 =item single checkbox id
318 Do not add value to single check() by default.
324 Mischa POSLAWSKY <perl@shiar.org>
328 This module is free software; you can redistribute it and/or modify it
329 under the same L<terms|perlartistic> as Perl itself.