# $Id: StickyForm.pm,v 1.3 2005/10/19 15:44:21 pmh Exp $ =head1 NAME HTML::StickyForm - Lightweight general-purpose HTML form generation, with sticky values =head1 SYNOPSIS # mod_perl example use HTML::StickyForm; use Apache::Request; sub handler{ my($r)=@_; $r=Apache::Request->new($r); my $f=HTML::StickyForm->new($r); $r->send_http_header; print '', $form->form_start, "Text field:", $f->text(name => 'field1', size => 40, default => 'default value'), "
Text area:", $f->textarea(name => 'field2', cols => 60, rows => 5, default => 'stuff'), "
Radio buttons:", $f->radio_group(name => 'field3', values => [1,2,3], labels => { 1=>'one', 2=>'two', 3=>'three' }, default => 2), "
Single checkbox:", $f->checkbox(name => 'field4', value => 'xyz', checked => 1), "
Checkbox group:", $f->checkbox_group(name => 'field5', values => [4,5,6], labels => { 4=>'four', 5=>'five', 6=>'six' }, default => [5,6]), "
Password field:", $f->password(name => 'field6', size => 20), '
", $f->submit(value => ' Hit me! '), $f->form_end, '', ; return OK; } =head1 DESCRIPTION This module provides a simple interface for generating HTML form elements, with default values chosen from the previous form submission. This module was written with mod_perl (L) in mind, but works equally well with CGI.pm, including the new 3.x version, or any other module which implements a param() method, or even completely standalone. The module does not provide methods for generating all possible HTML elements, only those which are used in form construction. In addition, this module's interface is much less flexible than CGI.pm's; all routines work only as methods, and there is only one way of passing parameters to each method. This was done for two reasons: to keep the API simple and consistent, and to keep the code size down to a minimum. =cut package HTML::StickyForm; use strict; use vars qw( $VERSION ); $VERSION=0.07; =head1 CLASS METHODS =over =item new([REQUEST]) Creates a new form generation object. The single argument can be: =over =item * any object which responds to a C method in the same way that L and L objects do. That is, with no arguments, the names of the parameters are returned as a list. With a single argument, the value(s) of the supplied parameter is/are returned; in scalar context the first value, and in list context all values. =item * a plain arrayref. This will be used to construct an L object, which responds as described above. The array will be passed directly to the RequestHash constructor, so both methods for specifying multiple values are allowed. =item * a plain hashref. This will be used to construct an L object. Multiple values must be represented as arrayref values. =item * a false value. This will be used to construct an L object with no parameters set. =back The constructor dies if passed an unrecognised request object. If an appropriate object is supplied, parameters will be fetched from the object on an as needed basis, which means that changes made to the request object after the form object is constructed may affect the default values used in generated form elements. However, once constructed, the form object's sticky status does not get automatically updated, so if changes made to the request object need to affect the form object's sticky status, set_sticky() must be called between request object modification and form generation. In contrast, L objects created as part of form object construction use copies of the parameters from the supplied hashref or arrayref. This means that the changes made to the original data do not affect the request object, so have absolutely no effect of the behaviour of the form object. =cut sub new{ my($class,$req)=@_; # Identify the type of request my $type; if(!$req){ $type='hash'; $req={}; }elsif(eval{ local $SIG{__DIE__}; $req->can('param'); }){ $type='object'; }elsif(ref($req) eq 'HASH'){ $type='hash'; }elsif(ref($req) eq 'ARRAY'){ $type='array'; }else{ require Carp; Carp::croak( "Unrecognised request passed to HTML::StickyForm constructor ($req)"); } if($type eq 'hash' || $type eq 'array'){ require HTML::StickyForm::RequestHash; $req=HTML::StickyForm::RequestHash->new($type eq 'hash' ? %$req : @$req); } my $self=bless { req => $req, values_as_labels => 0, well_formed => ' /', },$class; # Count submitted fields $self->set_sticky; $self; } =back =head1 METHODS =head2 Configuration methods =over =item set_sticky([BOOL]) With no arguments, the request object's parameters are counted, and the form object is made sticky if one or more parameters are present, non-sticky otherwise. If an argument is given, its value as a boolean determines whether the form object will be sticky or not. In both cases, the return value will be the new value of the sticky flag. A non-sticky form object always uses the values supplied to methods when constructing HTML elements, whereas a sticky form object will use the values from the request. This method is called by the constructor when the form object is created, so it is not usually necessary to call it explicitly. However, it may be necessary to call this method if parameters are set with the C method after the form object is created. =cut sub set_sticky{ my $self=shift; return $self->{params}=!!$_[0] if @_; $self->{params}=!!(()=$self->{req}->param); } =item get_sticky() Returns true if the form object is sticky. =cut sub get_sticky{ my($self)=@_; !!$self->{params}; } =item values_as_labels([BOOL]) With no arguments, this method returns the C attribute, which determines what should happen when a value has no label in the checkbox_group(), radio_group() and select() methods. If this attribute is false (the default), no labels will be automatically generated. If it is true, labels will default to the corresponding value if they are not supplied by the user. If an argument is passed, it is used to set the C attribute. =cut sub values_as_labels{ my $self=shift; return $self->{values_as_labels}=!!$_[0] if @_; $self->{values_as_labels}; } =item well_formed([BOOL]) With no arguments, this method return the C attribute, which determines whether to generate well-formed XML, by including the trailing slash in non-container elements. If true, all generated elements will be well-formed. If false, no slashes are added - which is unfortunately required by some older browsers. If an argument is passed, it is used to set the C attribute. =cut sub well_formed{ my $self=shift; return !!($self->{well_formed}=$_[0] ? ' /' : '') if @_; !!$self->{well_formed}; } =back =head2 HTML generation methods Most of these methods are specified as taking PAIRLIST arguments. This means that arguments must be passed as a list of name/value pairs. For example: $form->text(name => 'fred',value => 'bloggs'); This represents two arguments; "name" with a value of "fred", and "value" with a value of "bloggs". In cases where sticky values are useful, there are two ways of specifying the values, depending on whether stickiness is required for the element being generated. To set sticky value defaults, use the C argument. Alternatively, to set values which are not affected by previous values entered by the user, use the C argument (or C or C, depending on the type of element being generated). =over =item form_start(PAIRLIST) Generates a CformE> start tag. All arguments are interpreted as attributes for the element. All names and values are HTML escaped. The following arguments are treated specially: C: Defaults to C =cut sub form_start{ my($self,%args)=@_; $args{method}='GET' unless exists $args{method}; my $field=' argument defaults to C. =cut sub form_start_multipart{ my $self=shift; $self->form_start(enctype => 'mutipart/form-data',@_); } =item form_end() Generates a CformE> end tag. =cut sub form_end{ ''; } =item text(PAIRLIST) Generates an CinputE> element. In general, arguments are interpreted as attributes for the element. All names and values are HTML escaped. The following arguments are treated specially: C: Defaults to C C: Unconditional value. If present, causes C and any sticky value to be ignored. C: Conditional value, ignored if C is present. If the form is sticky, the sticky value will be used for the C attribute's value. Otherwise, the supplied C will be used. A C attribute is never created. =cut sub text{ my($self,%args)=@_; my $type=delete $args{type} || 'text'; my $name=delete $args{name}; my $value; if(exists $args{value}){ $value=delete $args{value}; delete $args{default}; }else{ $value=delete $args{default}; $value=$self->{req}->param($name) if $self->{params}; } _escape($type); _escape($name); _escape($value); my $field=qq({well_formed}>"; } =item hidden(PAIRLIST) As text(), but produces an input element of type C. =cut sub hidden{ my $self=shift; $self->text(@_,type => 'hidden'); } =item password(PAIRLIST) As text(), but produces an input element of type C. =cut sub password{ my $self=shift; $self->text(@_,type => 'password'); } =item textarea(PAIRLIST) Generates a EtextareaE container. All arguments are used directly to generate attributes for the start tag, except for those listed below. All values are HTML-escaped. C: Unconditional value. If present, specifies the contents of the container, and causes C and any sticky value to be ignored. A C attribute is never created. C: Conditional value, ignored if C is present. If the form is stikcy, the sticky value wil be used for the container contents. Otherwise, sticky, the supplied C will be used. A C attribute is never created. =cut sub textarea{ my($self,%args)=@_; my $name=delete $args{name}; my $value; if(exists $args{value}){ $value=delete $args{value}; delete $args{default}; }else{ $value=delete $args{default}; $value=$self->{req}->param($name) if $self->{params}; } _escape($name); _escape($value); my $field=qq("; } =item checkbox(PAIRLIST) Generates a single C type CinputE> element. All arguments are used directly to generate attributes for the tag, except for those listed below. All values are HTML-escaped. C: Unconditional status. If present, used to decide whether to include a checked attribute, and causes C and any sticky value to be ignored. C: Conditional status, ignored if C is present. If the form is sticky, the sticky value will be used to determine whether to include a checked attribute. Otherwise, the supplied C will be used. If the decision to include the C attribute is based on the sticky value, the sticky parameter must include at least one value which is the same as the supplied C argument. If the decision is based on the value of the C or C arguments, the supplied argument need only be true for the C attribute to be created. =cut sub checkbox{ my($self,%args)=@_; my $name=delete $args{name}; my $value=delete $args{value}; my $checked; if(exists $args{checked}){ $checked=delete $args{checked}; delete $args{default}; }else{ $checked=delete $args{default}; $value='' unless defined($value); $checked=grep $_ eq $value,$self->{req}->param($name) if $self->{params}; } _escape($name); _escape($value); my $field=qq({well_formed}>"; } =item checkbox_group(PAIRLIST) Generates a group of C type CinputE> elements. If called in list context, returns a list of elements, otherwise a single string containing all tags. All arguments are used directly to generate attributes in each tag, except for those listed below. Unless otherwise stated, all names and values are HTML-escaped. C: An arrayref of values. One element will be generated for each element, in the order supplied. If not supplied, the label keys will be used instead. C: A hashref of labels. Each element generated will be followed by the label keyed by the value. Values will be HTML-escaped unless a false C argument is supplied. If no label is present for a given value and C is true, the value will also be used for the label. C: If present and false, labels will not be HTML-escaped. C: Unconditional status. If present, used to decide whether each checkbox is marked as checked, and causes C, C and any sticky values to be ignored. May be a single value or arrayref of values. C: Conditional status, ignored if C is present. If the form is sticky, individual checkboxes are marked as checked if the sticky parameter includes at least one value which is the same as the individual checkbox's value. Otherwise, the supplied C values are used in the same way. May be a single value or arrayref of values. C: If true, each element/label will be followed by a CbrE> element. C: If supplied, overrides the form object's C attribute. =cut sub checkbox_group{ my($self,%args)=@_; my $type=delete $args{type} || 'checkbox'; my $name=delete $args{name}; my $labels=delete $args{labels} || {}; my $escape_labels=1; $escape_labels=delete $args{escape_labels} if exists $args{escape_labels}; my $values=delete $args{values}; $values||=[keys %$labels]; my $checked=[]; if(exists $args{checked}){ $checked=delete $args{checked}; $checked=[$checked] if ref($checked) ne 'ARRAY'; delete $args{default}; }else{ if(exists $args{default}){ $checked=delete $args{default}; $checked=[$checked] if ref($checked) ne 'ARRAY'; } $checked=[$self->{req}->param($name)] if $self->{params}; } my %checked=map +($_,1),@$checked; my $br=delete $args{linebreak} ? "{well_formed}>" : ''; my $v_as_l=$self->{values_as_labels}; if(exists $args{values_as_labels}){ $v_as_l=delete $args{values_as_labels}; } _escape($type); _escape($name); my $field=qq({$value}){ my $label=$labels->{$value}; _escape($label) if $escape_labels; $field.=$label; }elsif($v_as_l){ $field.=$evalue; } $field.=$br; push @checkboxes,$field; } return @checkboxes if wantarray; return join '',@checkboxes; } =item radio_group(PAIRLIST) As checkbox_group(), but setting C to C. =cut sub radio_group{ my $self=shift; $self->checkbox_group(@_,type => 'radio'); } =item select(%args) Generates a CselectE> element. All arguments are used directly to generate attributes in the CselectE> element, except for those listed below. Unless otherwise stated, all names and values are HTML-escaped. C: An arrayref of values. One CoptionE> element will be created inside the CselectE> element for each entry, in the supplied order. Defaults to label keys. C: A hashref of labels. Each CoptionE> tag generated will contain the label keyed by its value. If no label is present for a given value, no label will be generated. Defaults to an empty hashref. C: Unconditional status. If present, the supplied values will be used to decide which options to mark as selected, and C and any sticky values will be ignored. May be a single value or arrayref. C: Consitional status, ignored if C is supplied. If the form is sticky, the sticky values will be used to decide which options are selected. Otherwise, the supplied values will be used. May be a single value or arrayref. C: If true, the C attribute is set to C. C: Overrides the form object's C attribute. This is of little value, since it's the default behaviour of HTML in any case. =cut sub select{ my($self,%args)=@_; my $name=delete $args{name}; my $multiple=delete $args{multiple}; my $labels=delete $args{labels} || {}; my $values=delete $args{values} || [keys %$labels]; my $selected; if(exists $args{selected}){ $selected=delete $args{selected}; delete $args{default}; }else{ $selected=delete $args{default}; $selected=[$self->{req}->param($name)] if $self->{params}; } if(!defined $selected){ $selected=[]; } elsif(ref($selected) ne 'ARRAY'){ $selected=[$selected]; } my %selected=map +($_,1),@$selected; my $v_as_l=$self->{values_as_labels}; if(exists $args{values_as_labels}){ $v_as_l=delete $args{values_as_labels}; } _escape($name); my $field=qq("; $field; } =item submit(PAIRLIST) Generates an CinputE> of type C. All of the supplied arguments are HTML-escaped, and used directly as attributes. C fields are not sticky. =cut sub submit{ my($self,%args)=@_; $args{type}='submit' unless exists $args{type}; my $field='&"]|[^\0-\177])/sprintf "&#%d;",ord $1/ge; }else{ $_[0]=''; } } =back =end private =cut # Return true to require 1; =head1 AUTHOR Copyright (C) Institute of Physics Publishing 2000-2005 Peter Haworth You may use and distribute this module according to the same terms that Perl is distributed under.