lib/HTML/Form/Simple.pm

   1 package HTML::Form::Simple;
   2
   3 use strict;
   4 use warnings;
   5
   6 use XML::Quote;
   7
   8 our $VERSION = '1.00';
   9
  10
  11 sub new {
  12         bless {}, $_[0];
  13 }
  14
  15 sub _attr {
  16         my $self = shift;
  17         my $expect = shift;
  18         my $attr = ref $_[-1] eq 'HASH' ? pop : {};
  19         push @_, undef for @_+1 .. $expect;
  20         push @_, $attr;
  21         return @_;
  22 }
  23
  24 sub quote {
  25         my $self = shift;
  26         return XML::Quote::xml_quote_min($_[0]);
  27 }
  28
  29 sub tag {
  30         my ($self, $tag, $attr) = @_;
  31
  32         # strip empty if it shouldn't be
  33         defined $attr->{$_} and $attr->{$_} eq '' and delete $attr->{$_}
  34                 for qw(id type class style);
  35
  36         my $return = '<' . $tag;
  37
  38         # add booleans
  39         delete $attr->{$_} and $return .= ' '.$_
  40                 for qw(selected checked disabled readonly);
  41
  42         $return .= sprintf ' %s="%s"', $_, $self->quote($attr->{$_})
  43                 for sort grep { defined $attr->{$_} } keys %$attr;
  44
  45         return $return . '>';
  46 }
  47
  48
  49 sub start {
  50         my ($self, $attr) = @_;
  51
  52         return $self->tag(form => $attr);
  53 }
  54
  55 sub stop {
  56         return '</form>';
  57 }
  58
  59
  60 sub submit {
  61         my $self = shift;
  62         my ($value, $attr) = $self->_attr(1, @_);
  63
  64         $attr->{value} = $value if defined $value;
  65         $attr->{type} = 'submit' unless defined $attr->{type};
  66
  67         return $self->tag(input => $attr);
  68 }
  69
  70 sub hidden {
  71         my $self = shift;
  72         my ($name, $value, $attr) = $self->_attr(2, @_);
  73
  74         $attr = {type => 'hidden', name => $name, value => $value};
  75         #TODO: $attr
  76
  77         return $self->tag(input => $attr);
  78 }
  79
  80 sub input {
  81         my $self = shift;
  82         my ($name, $value, $attr) = $self->_attr(2, @_);
  83
  84         $attr->{name } = $name  if defined $name;
  85         $attr->{value} = $value if defined $value;
  86         $attr->{id}   = $attr->{name} unless defined $attr->{id};
  87         $attr->{type} = 'text' unless defined $attr->{type} or defined $attr->{rows};
  88         $value = delete $attr->{value} if defined $attr->{rows};
  89
  90         return defined $attr->{rows} ? sprintf(
  91                 '%s%s</textarea>',
  92                 $self->tag(textarea => $attr),
  93                 $self->quote(defined $value ? $value : '')
  94         ) : $self->tag(input => $attr);
  95 }
  96
  97 sub select {
  98         my $self = shift;
  99         my ($name, $rows, $default, $attr) = $self->_attr(3, @_);
 100
 101         $default = $attr->{value} unless defined $default;
 102         delete $attr->{value};  # never a parent attribute
 103
 104         $attr->{name} = $name;
 105         $attr->{id}   = $attr->{name} unless defined $attr->{id};
 106         $attr->{type} = 'select' unless defined $attr->{type};
 107
 108         my @options = map { ref $_ ? $_ : {value => $_} } @$rows;
 109
 110         if ($attr->{type} eq 'select') {
 111                 delete $attr->{type};
 112                 if (defined $default) {
 113                         for (@options) {
 114                                 $_->{selected} = 1 if defined $_->{value} and $_->{value} eq $default;
 115                         }
 116                 }
 117                 my @return = (
 118                         $self->tag(select => $attr),
 119                         (map { $self->tag(option => $_) } @options),
 120                         '</select>',
 121                 );
 122                 return wantarray ? @return : join('', @return);
 123         }
 124         else {
 125                 if (defined $attr->{id}) {
 126                         defined $_->{id} or defined $_->{value} and $_->{id} = $attr->{id}.'_'.$_->{value}
 127                                 for @options;
 128                 }
 129                 if (defined $attr->{label}) {
 130                         defined $_->{value} and not defined $_->{label}
 131                                 and $_->{label} = $attr->{label}->{$_->{value}}
 132                                         for @options;
 133                         delete $attr->{label};
 134                 }
 135                 if (defined $default) {
 136                         for (@options) {
 137                                 $_->{checked} = 1 if defined $_->{value} and $_->{value} eq $default;
 138                         }
 139                 }
 140                 $_ = {%$attr, %$_} for @options;
 141                 my @return = map {
 142                         my $label = delete $_->{label};
 143                         defined $label && $label ne ''
 144                                 ? '<label>'.$self->tag(input => $_)." $label</label>"
 145                                 :           $self->tag(input => $_)
 146                 } @options;
 147                 return wantarray ? @return : join('', @return);
 148         }
 149 }
 150
 151 sub radio {
 152         my $self = shift;
 153         my ($name, $value, $attr) = $self->_attr(2, @_);
 154
 155         $self->select($name, [$value], {%$attr, type => 'radio'});
 156 }
 157
 158 sub check {
 159         my $self = shift;
 160         my ($name, $label, $checked, $attr) = $self->_attr(3, @_);
 161
 162         $attr->{label  } = $label   if defined $label;
 163         $attr->{checked} = $checked if defined $checked;
 164         $attr->{value  } = '1' unless exists $attr->{value};
 165
 166         $self->select($name, [$attr], {type => 'checkbox'});
 167 }
 168
 169 1;
 170
 171 =head1 NAME
 172
 173 HTML::Form::Simple
 174
 175 =head1 SYNOPSIS
 176
 177         my $input = HTML::Form::Simple->new;
 178         say $input->start; # <form>
 179         printf "<label>%s: %s</label>\n", @$_ for (
 180                 [ 'Your Name' => $input->text(
 181                         user => 'Mr. Default'
 182                 ) ],
 183                 [ Message => $input->text(
 184                         msg => 'Textarea default', {rows => 4, style => 'background:red'}
 185                 ) ],
 186                 [ Gender => join ' or ', $input->radio(
 187                         sex => ['m', 'f']
 188                 ) ],
 189                 [ Colour => scalar $input->select(
 190                         favcolour => [qw(Blue Green Red)], 'Green'
 191                 ) ],
 192                 [ Options => $input->check(
 193                         spam => 'Receive weekly newsletter'
 194                 ) ],
 195         );
 196         say $input->stop; # </form>
 197