File Coverage

blib/lib/HTML/FormWizard.pm

Criterion	Covered	Total	%
statement	180	462	38.9
branch	82	314	26.1
condition	24	65	36.9
subroutine	22	34	64.7
pod	15	15	100.0
total	323	890	36.2

package HTML::FormWizard;

use vars qw($VERSION);

use strict;

$VERSION="0.1.09";

=head1 NAME

	HTML::FormWizard - Forms HTML made simple.

=head1 SYNOPSIS

	# this script does almost the same that CGI.pm
	# example. And, yes, I use CGI, that is,
	# writes a form and write the submited values

	use CGI();
	use HTML::FormWizard();


	my $form = HTML::FormWizard->new(
	  -title 	=> 'A simple Example',
	  -fields => [
	      { name 		=> 'name',
		    description	=> "What's your name?"},
	      { name			=> 'words',
			descritpion	=> "What's the combination?",
			type 		=> 'check',
			value		=> ['eenie','meenie',
				'minie',moe'],
			defaults	=> ['eenie','minie'] },
		  { name		=> 'color',
		    description	=> "What's your favorite color?",
		    type		=> 'list',
		    value		=> ['red','green',
				'blue','chartreuse']}
		]
	);

	# Well, That almost it... But now, that do other things...

	# Append field another list field, this one with
	# descriptions, for example... that you must select,
	# initially saying "--Select Please--".

	$form->add(
		{ name 		=> 'country',
		  description 	=> 'Where did you born?',
		  type			=> 'list',
		  value =>
		  		{ pt => 'Portugal',
		   		  us => 'United States',
				  uk => 'United Kingdom',
				  fr => 'France',
				 '--' => 'Other',
				 ''	=> '--Select Please--'},
		 default		=> '',
		 needed 		=> 1 }
	);

	# And just one more... A password field, that must
	# have 3 to 8 characters length, and you want to
	# validate with a function you wrote...

	$form->add(
		{ name 		=> 'password',
		  type 		=> 'password',
		  minlen	=> 3,
		  maxlen	=> 8,
		  validate 	=> sub {
		  	my $pass = shift;
			return 0 if (($pass =~ /\d/)
					and ($pass =~ /[a-zA-Z]/)
					and ($pass =~ /\W/));
			return "The field password must have at least a number,".
					" a letter and a symbol";
		  },
		  needed    => 1
		}
	);

	# And now... let's get the results!!!

	if (my $data=$form->run) {
		print
		qq(
			Your name id $$data{name}
			The Keywords are: ),
				join(", ", @{$$data{words}}),qq(
			Your Favorite Color is $$data{color}
			Your birth country is $$data{country}
			And you password is $$data{password}
		)
	}

=head1 DESCRIPTION

There are to much libs that write forms, and only a few that
process both things, that is, write HTML forms, and retrieve
the data send by the user.

Or... in a more correct way... That handles everything
between the first request and the correct data introduction.
Why should every program we devel ask some module to create
a form, and then ask some other to verify that the submit is
correct? Or why should it verify the data?

HTML::FormWizard was wrote for that.

It uses CGI to retrieve data from the requests,
and the HTML forms are produced using an object template
that if not provided, will be $self (a self reference).

=head1 METHODS

The following methods are available (for properties list, see above):

=head2 $form = HTML::FormWizard->new([$property => $value]+);

Constructor for the FormWizard. Returns a reference for a
HTML::FormWizard object.

=cut

my %validators=(
	email => sub {
				my $str=shift;
				if ($str=~/^[a-zA-Z][\w\.\_\-]*\@[\w\.\-]+\.[a-zA-Z]{2,4}$/) {
					return 0;
				} else {
					return "Invalid Email";
				}
			},
	phone => sub {
				my $str=shift;
				if ($str=~
					/^(\+\d{1,3})? ?([\(-\s])?\d{1,3}?([\s-\)])[\d\s\-]+$/) {
					return 0;
				} else {
					return "This is not a valid phone number";
				}
			},
	ccard => sub {
				my $str=shift;
				if ($str =~ /^\d{4}[\- ]?\d{4}[\- ]?\d{4}[\- ]?\d{4}$|^\d{4}[\- ]?\d{6}[\- ]?\d{5}$/) {
					return 0;
				} else {
					return "The credit card number you type is not valid";
				}
			},
	pt_cp => sub {
				my $str=shift;
				if ($str=~/^\d{4}(-\d{3})$/ ) {
					return 0;
				} else {
					return "The Postal Code you typed isn't a valid Portuguese Postal Code.";
				}
			},
	us_cp => sub {
				my $str=shift;
				if ($str=~/^\d{5}(-\d{4})?$/) {
					return 0
				} else {
					return "The Postal Code you typed is not a US postal code.";
				}
			},
	ipv4 => sub {
				my $zbr=shift;
				my @secs=split /./, $zbr;
				if (scalar @secs!=4 or $secs[0]<1 or $secs[0]>255
					or $secs[1]<0 or $secs[1]>255
					or $secs[2]<0 or $secs[2]>255
					or $secs[3]<1 or $secs[3]>255) {
						return "This is not a value IPv4 value.";
				} else {
					return 0;
				}
			}
);

my $error_field;
my $error_msg;

sub new {
	my $self={};
	bless $self, shift;
	if (scalar @_) {
		if (((scalar @_ + 1) % 2) and ($_[0] =~ /^\-/)) {
			my ($key,$val);
			while (@_) {
				$key = shift;
				if ($key =~ /^\-(\w+)/) {
					my $value = shift;
					$self->{lc($1)} = $value;
				} else {
					die "Can't use init option parameters and init ".
						"standard parameters together.";
				}
			}
		} else {
			my ($url, $method, $template, $title, $cgi, $fields) = @_;
			$self->{url} = $url if $url;
			$self->{method} = $method if $method;
			$self->{template} = $template if $template;
			$self->{title} = $title if $title;
			$self->{cgi} = $cgi if $cgi;
			$self->{fields} = $fields if $fields;
		}
	}

	$self->{url}="" unless $self->{url};
	$self->{method}="POST" unless $self->{method};
	$self->{template}=$self unless $self->{template};
	$self->{title}="" unless $self->{title};
	$self->{cgi}=undef unless $self->{cgi};
	$self->{fields}=[()] unless $self->{fields};
	$self->{actions}=[({ undef => 'Send' })] unless $self->{actions};
	$self->{encoding}="multipart/form-data" unless $self->{encoding};


	return $self;
}

=head2 $form->set([$property => $value]+);

This method allow you to set the properties that you didn't set initially
with new(). This methos only allow you to set a property for each call.

With new() you can set as much properties as you want, but set was
thought to modify values predefined or values that you can't know when
you init the object.

=cut

sub set {
	my $self = shift;
	my $key = shift;
	my $value=shift;
	return 0 unless $key =~/^\-(\w+)/;

	$self->{lc($1)}=$value;
}

=head2 $form->add([$field]+);

This method allows you to add fields to the fields list at any time.

For field properties see below.

=cut

sub add {
	my $self = shift;
	push @{$self->{fields}}, @_;
}

=head2 HTML::FormWizard::validate($fieldsref,$dataref);

This function allows validation of a datahash againt a fields list.
This allows you to create an hash of data received by email or
already on a database and verify that it is valid for a fields list.

This function is used internally to verify that data. It's called by
run() method.

=cut

sub validate {
	my $fields = shift;
	my $data = shift;

	for my $field (@{$fields}) {
		$error_msg = $$field{name} if $$field{name};
		$error_msg = $$field{description} if $$field{description};
		$error_field=$$field{name};
		$$field{type}='line' unless $$field{type};
		if ($$field{type} eq 'group') {
			if ($$field{name}) {
				return 0 unless validate($$field{parts},
								$$data{lc($$field{name})});
			} else {
				return 0 unless validate($$field{parts}, $data);
			}
		} elsif (($$field{type} eq 'radio') or ($$field{type} eq 'list')){
			if ($$field{name}) {
				return 0 if ref $$data{lc($$field{name})};
				my $ok=0;
				if (my $rtype=ref($$field{value})) {
					my @values;
					if($rtype eq "ARRAY") {
						@values = @{$$field{value}};
					} else {
						@values = keys %{$$field{value}};
					}
					for (@values) {
						$ok = 1 if $_ eq $$data{lc($$field{name})};
						last if $ok;
					}
				} else {
					$ok = $$data{lc($$field{name})} eq $$field{value};
				}
				return 0 if ($$data{lc($$field{name})} and not $ok);
				return 0 if ($$field{needed} and not $ok);
			}
		} elsif (($$field{type} eq 'checkbox') or ($$field{type} eq 'check')
				or ($$field{type} eq 'mlist')) {
			if ($$field{name}) {
				my $ok=1;
				if (ref $$data{lc($$field{name})}) {
					if (my $rtype=ref $$field{value}) {
						my @vals;
						if ($rtype eq "ARRAY") {
							@vals = @{$$field{value}};
						} else {
							@vals = keys %{$$field{value}};
						}
						my $vok;
						for my $value (@{$$data{lc($$field{name})}}) {
							$vok = 0;
							for (@vals) {
								$vok = 1 if $value eq $_;
								last if $vok;
							}
							$ok = 0 unless $vok;
							last unless $ok;
						}
					} else {
						$ok = 0;
					}
				} else {
					$ok=0;
					if (my $rtype=ref($$field{value})) {
						my @values;
						if ($rtype eq "ARRAY") {
							@values = @{$$field{value}};
						} else {
							@values = keys %{$$field{value}};
						}
						for (@values) {
							$ok = 1 if $$data{lc($$field{name})} eq $_;
							last if $ok;
						}
					} else {
						$ok = 1 if ($$data{lc($$field{name})}
									eq $$field{value});
					}
				}
				return 0 unless $ok;
			}
		} elsif ($$field{type} eq 'file') {
			return 0 unless $$data{lc($$field{name})} or !$$field{needed};
		} else {
			return 0 unless $$data{lc($$field{name})} or !$$field{needed};
			return 0 if (($$field{minlen}
					and length($$data{lc($$field{name})})<$$field{minlen})
				or ($$field{maxlen}
					and length($$data{lc($$field{name})})>$$field{maxlen}));
		}
		if (defined($$field{datatype})
			and defined($validators{$$field{datatype}})
			and $$data{lc($$field{name})}) {
			my $zbr=$validators{$$field{datatype}}->($$data{lc($$field{name})});
			if ($zbr) {
				$error_msg = $zbr;
				return 0;
			}
		}
		if (defined($$field{validate})) {
			my $zbr=$$field{validate}->($$data{lc($$field{name})});
			if ($zbr) {
				$error_msg = $zbr;
				return 0;
			}
		}
	}

	$error_field="";
	return 1;
}

=head2 my $dataref = $form->getdata([$field]+);

Loads the data from the request and returns a reference to a datahash.

This method receives a list of fields, so it can be called recursively
to handle group items.

It returns a HASH with pair:

	{ fieldname => fieldvalue }

=head2 fieldvalue is an ARRAYREF

This happens when fieldvalue is more than a value.
The values for mlist and checkboxes are frequently of this time.

=head2 fieldvalue is an HASHREF

This happens to every named group. One of the group type is group.

In true, group is not an field, but a group of field. If a group have name
getdata will create an fieldpair with the key equal to the group name
property and the value equal to an HASHREF to an hash of VALUES, with the
same structure.

=cut

sub getdata {
	my $self = shift;

	my $data = {};

	for my $field (@_) {
		$$field{type}='line' unless $$field{type};
		if ($$field{type} eq 'group') {
			my $values = $self->getdata(@{$$field{parts}});
			if ($$field{name}) {
				$$data{lc($$field{name})} = $values;
			} else {
				for (keys %{$values}) {
					$$data{$_} = $$values{$_};
				}
			}
		} else {
			if ($$field{name}) {
				my $vals=[];
				@{$vals} = $self->{cgi}->param($$field{name});
				if (scalar @{$vals} <= 1) {
					$$data{lc($$field{name})}=$$vals[0]||"";
					chomp($$data{lc($$field{name})});
				} else {
					$$data{lc($$field{name})}=$vals;
				}
				$vals=undef;
			}
		}
	}

	return $data;
}

sub _set_fields {
	my $fields=shift;
	my $data = shift;
	for my $field (@{$fields}) {
		if ($$field{type} eq 'group') {
			if ($$field{name}) {
				_set_fields($$field{parts}, $$data{$$field{name}});
			} else {
				_set_fields($$field{parts}, $data);
			}
		} elsif (($$field{type} eq 'radio') or ($$field{type} eq 'list')) {
			$$field{default} = $$data{lc($$field{name})};
		} elsif (($$field{type} eq 'check') or ($$field{type} eq 'checkbox')
				or ($$field{type} eq 'mlist')) {
			$$field{defaults} = $$data{lc($$field{name})};
		} else {
			$$field{value}=$$data{lc($$field{name})};
		}
	}
}

sub _set_defaults {
	my $self = shift;
	$self->{erro} = $error_msg;
	$self->{fielderror}=$error_field;

	_set_fields($self->{fields}, $self->{data});

	return;
}

=head2 my $data = $form->run();

Verify when the request is a submission to the form or just a form
request, and in the first case it calls getdata and validade to verify
the data. If the data is valid return a reference to the datahash (see
getdata() for datahash format).

=cut

sub run {
	my $self = shift;

	$self->{fields} = [] unless $self->{fields};

	if (($self->{cgi}) and ($self->{cgi}->param())) {
		if (($self->{data}=$self->getdata(@{$self->{fields}}))
				and (validate($self->{fields},$self->{data}))) {
			return $self->{data};
		} else {
			$self->_set_defaults;
		}
	}
	$self->write;
	return undef;
}

=head2 $form->write;

Writes the HTML to the form. This function is called by $form->run. In true
it calls the functions from the template property to write the help.

See more about the template above.

=cut

sub write {

	my $self = shift;
	my $html="";

	$self->{template} = $self unless $self->{template};
	$self->{method} = "POST" unless $self->{method};
	$self->{encoding} = "multipart/form-data" unless $self->{encoding};
	$self->{erro} = "" unless $self->{erro};
	$self->{fielderror}="" unless $self->{fielderror};

	$html = $self->{template}->header;
	$html .= $self->{template}->form_header(
				$self->{title}, $self->{url}, $self->{method},
				$self->{encoding}, $self->{erro},$self->{fielderror});

	$self->{fields} = [] unless $self->{fields};

	$html .= $self->_write_fields(@{$self->{fields}});

	$html .= $self->_write_actions(@{$self->{actions}});

	$html .= $self->{template}->form_footer;
	$html .= $self->{template}->footer;

	$self->_print($html);
}

sub _write_actions {
	my $self = shift;

	@_ = ( { value => 'Send' } ) unless @_;

	my @html_buttons = ();

	for my $button (@_) {
		my $html = "";

		$$button{type}="" unless $$button{type};

		if ($$button{type} eq "image") {
			$html = _image_button($button);
		} elsif ($$button{type} eq "reset") {
			$html = _reset_button($button);
		} else {
			$html = _button($button);
		}

		unshift @html_buttons, $html;
	}

	my $html = $self->{template}->form_actions(@html_buttons);

	return $html;
}

sub _image_button {
	my $button = shift;

	return  "" unless $$button{src};

	my $html="

	$html .= " ALT='$$button{alt}'" if $$button{alt};

	$html .= " SRC='$$button{src}'>";

	return $html;
}

sub _reset_button {
	my $button=shift;

	my $html = "

	$html .= " VALUE='$$button{value}'" if $$button{value};

	$html .= ">";

	return $html;
}

sub _button {
	my $button=shift;

	my $html = "

	$html .= " VALUE='$$button{value}'" if $$button{value};

	$html .= ">";

	return $html;
}

sub _write_fields {
	my $self = shift;
	my $html="";
	$self->{fielderror}="" unless $self->{fielderror};

	for my $field (@_) {

		$$field{description} = ucfirst($$field{name})
				unless $$field{description};
		my $erro=0;
		$erro=1 if $$field{name} eq $self->{fielderror};
		$$field{type}='line' unless $$field{type};
		if ($$field{type} eq "line") {
			$html .= $self->{template}->form_field($$field{description},
						_input_line($field),$$field{needed},$erro);
		} elsif (($$field{type} eq "passwd") or
					($$field{type} eq "password")) {
			$html .= $self->{template}->form_field($$field{description},
						_input_line($field,1),$$field{needed},$erro);
		} elsif (($$field{type} eq "check") or ($$field{type} eq "checkbox")) {
			$html .= $self->{template}->form_field($$field{description},
						_checkbox($field),$$field{needed},$erro);
		} elsif ($$field{type} eq "radio") {
			$html .= $self->{template}->form_field($$field{description},
						_radio($field),$$field{needed},$erro);
		} elsif ($$field{type} eq "list") {
			$html .= $self->{template}->form_field($$field{description},
						_list($field),$$field{needed},$erro);
		} elsif ($$field{type} eq "mlist") {
			$html .= $self->{template}->form_field($$field{description},
						_mlist($field),$$field{needed},$erro);
		} elsif ($$field{type} eq "text") {
			$html .= $self->{template}->form_field($$field{description},
						_textarea($field),$$field{needed},$erro);
		} elsif ($$field{type} eq "file") {
			$html .= $self->{template}->form_field($$field{description},
						_file($field),$$field{needed},$erro);
		} elsif ($$field{type} eq "group") {
			$html .= $self->_group($field);
		} elsif ($$field{type} eq "hidden") {
			$html .= $self->_hidden($field);
		} else {
			$html .= $self->{template}->form_field($$field{description},
                        _input_line($field),$$field{needed},$erro);
		}
	}
	return $html;
}

sub _group {
	my $self = shift;
	my $field = shift;

	$$field{title}="" unless $$field{title};

	my $html = $self->{template}->form_group_init($$field{title});

	$$field{parts} = [] unless $$field{parts};

	$html .= $self->_write_fields(@{$$field{parts}});

	$html .= $self->{template}->form_group_end;

	return $html;
}

sub _hidden {
	my $field = shift;

	return "" unless $$field{name};

	my $html="

	$html .= " VALUE='$$field{value}'" if $$field{value};

	$html .= ">";

	return $html;
}

sub _input_line {
	my $field = shift;
	my $passwd = shift;

	return "" unless $$field{name};

	my $html="";

	$html .= "

	if ($passwd) {
		$html .= " TYPE=PASSWORD";
	} else {
		$html .= " TYPE=TEXT";
	}
	if ($$field{value}) {
		$html .= " VALUE='$$field{value}'";
	}
	if ($$field{size}) {
		$html .= " SIZE=$$field{size}";
	}
	$$field{maxlen}=$$field{maxlength} if $$field{maxlength};
	if ($$field{maxlen}) {
		$html .=" MAXLENGTH=$$field{maxlen}";
	}
	$html .= ">";
	return $html;
}

sub _file {
	my $field = shift;

	return "" unless $$field{name};

	my $html;

	$html = "

	$html .= " ACCEPT='$$field{mime}'" if $$field{mime};

	$html .= " SIZE=$$field{size}" if $$field{size};

	$html .= ">";

	return $html;
}

sub _textarea {
	my $field = shift;

	return "" unless $$field{name};

	my $html;

	$html = "</tr>

<tr>
<td  class="h" >
<a name="739">739</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">   </td>
</tr>

<tr>
<td  class="h" >
<a name="740">740</a>
</td>

<td  class="c0" >

0

</td>

<td  class="c0" >
 <a href="blib-lib-HTML-FormWizard-pm--branch.html#740-1"> 
  0
 </a> 
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

0

</td>

<td class="s"> 	$html .= " COLS=$$field{cols}" if $$field{cols}; </td>
</tr>

<tr>
<td  class="h" >
<a name="741">741</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">   </td>
</tr>

<tr>
<td  class="h" >
<a name="742">742</a>
</td>

<td  class="c0" >

0

</td>

<td  class="c0" >
 <a href="blib-lib-HTML-FormWizard-pm--branch.html#742-1"> 
  0
 </a> 
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

0

</td>

<td class="s"> 	$$field{rows} = $$field{lines} if $$field{lines}; </td>
</tr>

<tr>
<td  class="h" >
<a name="743">743</a>
</td>

<td  class="c0" >

0

</td>

<td  class="c0" >
 <a href="blib-lib-HTML-FormWizard-pm--branch.html#743-1"> 
  0
 </a> 
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

0

</td>

<td class="s"> 	$html .= " ROWS=$$field{rows}" if $$field{rows}; </td>
</tr>

<tr>
<td  class="h" >
<a name="744">744</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> 	 </td>
</tr>

<tr>
<td  class="h" >
<a name="745">745</a>
</td>

<td  class="c0" >

0

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

0

</td>

<td class="s"> 	$html .= ">"; </td>
</tr>

<tr>
<td  class="h" >
<a name="746">746</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">   </td>
</tr>

<tr>
<td  class="h" >
<a name="747">747</a>
</td>

<td  class="c0" >

0

</td>

<td  class="c0" >
 <a href="blib-lib-HTML-FormWizard-pm--branch.html#747-1"> 
  0
 </a> 
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

0

</td>

<td class="s"> 	$html .= $$field{value} if $$field{value}; </td>
</tr>

<tr>
<td  class="h" >
<a name="748">748</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">   </td>
</tr>

<tr>
<td  class="h" >
<a name="749">749</a>
</td>

<td  class="c0" >

0

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

0

</td>

<td class="s"> 	$html .= "";

	return $html;
}

sub _checkbox {
	my $field = shift;

	return "" unless $$field{name};

	my $html;

	if (!ref($$field{value})) {
		$html  = "
		$html .= " CHECKED" if $$field{default};
		$html .= "> $$field{description}";
	} elsif (ref($$field{value}) eq "HASH") {
		$$field{cols} = 4 unless defined($$field{cols});
		$html .= ""; "; \n"; 




768




0





 





 





 





 





0



 		my $col=0; 




769




0





 





 





 





 





0



 		for my $value (sort {$$field{value}->{$a} cmp $$field{value}->{$b}} 




 




0





 





 





 





 





0



   




 




0





 





 





 





 





0



   




770




 





 





 





 





 





 



 				keys %{$$field{value}}) { 




771




0





 





 





 





 





0



 			$html .= "




772




0





 





 





 





 





0



 			$html .= " VALUE=$value"; 




773




0





 





 





 





 





0



 			for (@{$$field{defaults}}) { 




 




0





 





 





 





 





0



   




774




0




  
  0
  




 





 





 





0



 				$html .= " CHECKED" if $value eq $_; 




775




 





 





 





 





 





 



 			} 




776




0





 





 





 





 





0



 			$html .= ">"; 




777




0





 





 





 





 





0



 			$html .= $$field{value}->{$value}; 




778




0





 





 





 





 





0



 			$html .= "




779




0





 





 





 





 





0



 			$col++; 




780




0




  
  0
  




 





 





 





0



 			if ($col==$$field{cols}) { 




781




0





 





 





 





 





0



             	$html .= "




782




0





 





 





 





 





0



 				$col = 0; 




783




 





 





 





 





 





 



 			} 




784




 





 





 





 





 





 



 		} 




785




 





 





 





 





 





 



 		 




786




0





 





 





 





 





0



 		$html .= "";
		my $col=0;
		for my $value (sort {$$field{value}->{$a} cmp $$field{value}->{$b}}
				keys %{$$field{value}}) {
			$html .= "
			$html .= " VALUE=$value";
			for (@{$$field{defaults}}) {
				$html .= " CHECKED" if $value eq $_;
			}
			$html .= ">";
			$html .= $$field{value}->{$value};
			$html .= "
			$col++;
			if ($col==$$field{cols}) {
            	$html .= "
				$col = 0;
			}
		}

		$html .= "
	} elsif (ref($$field{value}) eq "ARRAY") {
        $$field{cols} = 4 unless defined($$field{cols});
        $html .= ""; "; \n"; 




790




0





 





 





 





 





0



         my $col=0; 




791




0





 





 





 





 





0



         for my $value (sort @{$$field{value}}) { 




 




0





 





 





 





 





0



   




792




0





 





 





 





 





0



             $html .= "




793




0





 





 





 





 





0



             $html .= " VALUE=$value"; 




794




0





 





 





 





 





0



             for (@{$$field{defaults}}) { 




 




0





 





 





 





 





0



   




795




0




  
  0
  




 





 





 





0



                 $html .= " CHECKED" if $value eq $_; 




796




 





 





 





 





 





 



             } 




797




0





 





 





 





 





0



             $html .= ">"; 




798




0





 





 





 





 





0



             $html .= ucfirst($value); 




799




0





 





 





 





 





0



             $html .= "




800




0





 





 





 





 





0



             $col++; 




801




0




  
  0
  




 





 





 





0



 			if ($col==$$field{cols}) { 




802




0





 





 





 





 





0



             	$html .= "




803




0





 





 





 





 





0



 				$col = 0; 




804




 





 





 





 





 





 



 			} 




805




 





 





 





 





 





 



         } 




806




 





 





 





 





 





 



   




807




0





 





 





 





 





0



         $html .= "";
        my $col=0;
        for my $value (sort @{$$field{value}}) {
            $html .= "
            $html .= " VALUE=$value";
            for (@{$$field{defaults}}) {
                $html .= " CHECKED" if $value eq $_;
            }
            $html .= ">";
            $html .= ucfirst($value);
            $html .= "
            $col++;
			if ($col==$$field{cols}) {
            	$html .= "
				$col = 0;
			}
        }

        $html .= "
	} else {
		$html = "";
	}
	return $html;
}

sub _mlist {
	my $field = shift;

	return "" unless $$field{name};

	my $html;

	if (ref($$field{value}) eq "HASH") {
		$html = "
		$html .= " SIZE=$$field{size}" if $$field{size};
		$html .= ">";
		for my $value (keys %{$$field{value}}) {
			$html .= "
			for (@{$$field{defaults}}) {
				$html .= " SELECTED" if $value eq $_;
			}
			$html .= ">";
			$html .= $$field{value}->{$value};
		}
		$html .= "";
	} elsif (ref($$field{value}) eq "ARRAY") {
		$html = "
		$html .= " SIZE=$$field{size}" if $$field{size};
		$html .= ">";
		for my $value (@{$$field{value}}) {
			$html .= "
			for (@{$$field{defaults}}) {
				$html .= " SELECTED" if $value eq $_;
			}
			$html .= ">";
			$html .= ucfirst($value);
		}
		$html .= "";
	} else {
		$html = "";
	}

}

sub _list {
	my $field = shift;

	return "" unless $$field{name};

	my $html;

	if (ref($$field{value}) eq "HASH") {
		$html = "";
		for my $value (keys %{$$field{value}}) {
			$html .= "
			$html .= " SELECTED" if $$field{default} eq $value;
			$html .= ">";
			$html .= $$field{value}->{$value};
		}
		$html .= "";
	} elsif (ref($$field{value}) eq "ARRAY") {
		$html = "";
		for my $value (@{$$field{value}}) {
			$html .= "
			$html .= " SELECTED" if $$field{default} eq $value;
			$html .= ">";
			$html .= ucfirst($value);
		}
		$html .= "";
	} else {
		$html = "";
	}
	return $html;
}

sub _radio {
	my $field = shift;

	return "" unless $$field{name};

	my $html;

	if (!ref($$field{value})) {
		$html  = "
		$html .= " CHECKED" if $$field{default};
		$html .= "> $$field{description}";
	} elsif (ref($$field{value}) eq "HASH") {
		$$field{cols} = 4 unless defined($$field{cols});
		$html .= ""; "; \n"; \n" if $col==$$field{cols}; 




898




0





 





 





 





 





0



 		my $col=0; 




899




0





 





 





 





 





0



 		for my $value (sort {$$field{value}->{$a} cmp $$field{value}->{$b}} 




 




0





 





 





 





 





0



   




 




0





 





 





 





 





0



   




900




 





 





 





 





 





 



 				keys %{$$field{value}}) { 




901




0





 





 





 





 





0



 			$html .= "




902




0





 





 





 





 





0



 			$html .= " VALUE=$value"; 




903




0




  
  0
  




 





 





 





0



 			$html .= " CHECKED" if $value eq $$field{default}; 




904




0





 





 





 





 





0



 			$html .= ">"; 




905




0





 





 





 





 





0



 			$html .= $$field{value}->{$value}; 




906




0





 





 





 





 





0



 			$html .= "




907




0





 





 





 





 





0



 			$col++; 




908




0




  
  0
  




 





 





 





0



 			if ($col==$$field{cols}) { 




909




0





 





 





 





 





0



             	$html .= "




910




0





 





 





 





 





0



 				$col = 0; 




911




 





 





 





 





 





 



 			} 




912




0




  
  0
  




 





 





 





0



 			$html .= "




913




 





 





 





 





 





 



 		} 




914




 





 





 





 





 





 



 		 




915




0





 





 





 





 





0



 		$html .= "";
		my $col=0;
		for my $value (sort {$$field{value}->{$a} cmp $$field{value}->{$b}}
				keys %{$$field{value}}) {
			$html .= "
			$html .= " VALUE=$value";
			$html .= " CHECKED" if $value eq $$field{default};
			$html .= ">";
			$html .= $$field{value}->{$value};
			$html .= "
			$col++;
			if ($col==$$field{cols}) {
            	$html .= "
				$col = 0;
			}
			$html .= "
		}

		$html .= "
	} elsif (ref($$field{value}) eq "ARRAY") {
        $$field{cols} = 4 unless defined($$field{cols});
        $html .= ""; "; \n"; 




919




0





 





 





 





 





0



         my $col=0; 




920




0





 





 





 





 





0



         for my $value (sort @{$$field{value}}) { 




 




0





 





 





 





 





0



   




921




0





 





 





 





 





0



             $html .= "




922




0





 





 





 





 





0



             $html .= " VALUE=$value"; 




923




0




  
  0
  




 





 





 





0



             $html .= " CHECKED" if $value eq $$field{default}; 




924




0





 





 





 





 





0



             $html .= ">"; 




925




0





 





 





 





 





0



             $html .= ucfirst($value); 




926




0





 





 





 





 





0



             $html .= "




927




0





 





 





 





 





0



             $col++; 




928




0




  
  0
  




 





 





 





0



 			if ($col==$$field{cols}) { 




929




0





 





 





 





 





0



             	$html .= "




930




0





 





 





 





 





0



 				$col = 0; 




931




 





 





 





 





 





 



 			} 




932




 





 





 





 





 





 



         } 




933




 





 





 





 





 





 



   




934




0





 





 





 





 





0



         $html .= "";
        my $col=0;
        for my $value (sort @{$$field{value}}) {
            $html .= "
            $html .= " VALUE=$value";
            $html .= " CHECKED" if $value eq $$field{default};
            $html .= ">";
            $html .= ucfirst($value);
            $html .= "
            $col++;
			if ($col==$$field{cols}) {
            	$html .= "
				$col = 0;
			}
        }

        $html .= "
	} else {
		$html = "";
	}
	return $html;
}

=head1 Templates

The template must return a complete HTML page with only the folling calls:

	print
	$template->header(),
	$template->form_header($title,$method,$url,$encoding,$erro),
	$template->form_footer(),
	$template->footer();

This must write a complete HTML page.

However, here are still missing some other methods.

The important to remember now is ... Templates don't print, return. Why?

That way it's up to the module when he really must print the HTML, and it
can be  used to print to files, without the file handler been carry for
every single function.

=head2 $template->header;

This method must create the HTML header for every page. This Header is
mustn't open nothing that the footer method will not close.

For example, if the header creates a table to preserve space for something
but the form, the table must be closed on the header itself or in the footer
method.

It can be closed anywhere else.

=cut

sub header {
	return q(


		Magick Form
		 </td>
</tr>

<tr>
<td  class="h" >
<a name="980">980</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> H1 {font-size:24pt; text-align:center; color:blue } </td>
</tr>

<tr>
<td  class="h" >
<a name="981">981</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> H2 {font-size:18pt; text-align:center; color:red } </td>
</tr>

<tr>
<td  class="h" >
<a name="982">982</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> .form_group {font-size:14pt; text-align:center; color:white; font-weight:bold } </td>
</tr>

<tr>
<td  class="h" >
<a name="983">983</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> .form_field {font-size:12pt; text-align:left; color:white } </td>
</tr>

<tr>
<td  class="h" >
<a name="984">984</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">


);
}

=head2 $template->form_header($title,$url[,$meth[,$enctype[,$erro]]]);

This method receive up to five parameters:

=head2 $title

This is the value that should be the heading line for the form.

=head2 $url

The URI where the submission should be done.

=head2 $meth

The HTTP Method to use.

=head2 $enctype

The Encoding that should be used to make the submission.

=head2 $erro

The field description for a invalid field value. Must be used to show
a error message.

=cut

sub form_header {
	shift;
	my $title = shift;
	my $url=shift;
	my $meth=shift;
	my $encod = shift;
	my $erro=shift;
	my $field=shift;
	my $html = qq(		$title);
	$html .= qq(
$erro) if $erro;
	$html .= qq(
The value you introduced in the field '$field' is invalid.)
		if $field and not $erro;
	$html .= qq(

	$html .= " METHOD=$meth" if $meth;
	$html .= " ENCTYPE='$encod'" if $encod;
	$html .= qq(>
		";  




1037




 





 





 





 





 





 



 ); 




1038




6





 





 





 





 





17



 	return $html; 




1039




 





 





 





 





 





 



 } 




1040




 





 





 





 





 





 



   




1041




 





 





 





 





 





 



 =head2 $template->form_field($fieldname,$fieldhtml); 




1042




 





 





 





 





 





 



   




1043




 





 





 





 





 





 



 This method from the template must write a form field. It receive to 




1044




 





 





 





 





 





 



 parameters: 




1045




 





 





 





 





 





 



   




1046




 





 





 





 





 





 



 =head2 $fieldname 




1047




 





 





 





 





 





 



   




1048




 





 





 





 





 





 



 This is a description to the field. It's the label that the user must see 




1049




 





 





 





 





 





 



 associated to the field. 




1050




 





 





 





 





 





 



   




1051




 





 





 





 





 





 



 =head2 $fieldhtml 




1052




 





 





 





 





 





 



   




1053




 





 





 





 





 





 



 This is the HTML to the field. It is the final HTML, no the field 




1054




 





 





 





 





 





 



 properties to write the HTML.  




1055




 





 





 





 





 





 



   




1056




 





 





 





 





 





 



 =cut 




1057




 





 





 





 





 





 



   




1058




 





 





 





 





 





 



 sub form_field { 




1059




6





 





 




  
6
  



  
1
  




8



 	shift; 




1060




6





 





 





 





 





7



 	my $name=shift; 




1061




6





 





 





 





 





7



 	my $field = shift; 




1062




6





 





 





 





 





9



 	my $needed=shift; 




1063




6





 





 





 





 





7



 	my $errado=shift; 




1064




6




  
100
  




 





 





 





19



 	$name="$name" if $needed; 




1065




6




  
100
  




 





 





 





15



 	$name="$name" if $errado; 




1066




 





 





 





 





 





 



 	return  




1067




6





 





 





 





 





41



 qq($name 




1068




 





 





 





 





 





 



 	$field 




1069




 





 





 





 





 





 



  




1070




 





 





 





 





 





 



 ); 




1071




 





 





 





 





 





 



 } 




1072




 





 





 





 





 





 



   




1073




 





 





 





 





 





 



 =head2 $template->form_group_init($group); 




1074




 





 





 





 





 





 



   




1075




 





 





 





 





 





 



 This method receive only the description for the group. The must start the 




1076




 





 





 





 





 





 



 group. The function $template->form_group_end() will be called to end 




1077




 





 





 





 





 





 



 everything form_group_init() leave open. 




1078




 





 





 





 





 





 



   




1079




 





 





 





 





 





 



 =cut 




1080




 





 





 





 





 





 



   




1081




 





 





 





 





 





 



 sub form_group_init { 




1082




0





 





 




  
0
  



  
1
  




0



 	shift; 




1083




0





 





 





 





 





0



 	my $group = shift; 




1084




 





 





 





 





 





 



   




1085




 





 





 





 





 





 



 	return 




1086




0





 





 





 





 





0



 qq($group 




1087




 





 





 





 





 





 



 ); 




1088




 





 





 





 





 





 



 } 




1089




 





 





 





 





 





 



   




1090




 





 





 





 





 





 



 =head2 $template->form_group_end() 




1091




 





 





 





 





 





 



   




1092




 





 





 





 





 





 



 This function get no parameters, and must close any HTML tag that the 




1093




 





 





 





 





 





 



 previous open form_group_init() leave open, or return the HTML to show that 




1094




 





 





 





 





 





 



 the group ends here. 




1095




 





 





 





 





 





 



   




1096




 





 





 





 





 





 



 =cut 




1097




 





 





 





 





 





 



   




1098




 





 





 





 





 





 



 sub form_group_end { 




1099




0





 





 




  
0
  



  
1
  




0



 	return "




1100




 





 





 





 





 





 



 } 




1101




 





 





 





 





 





 



   




1102




 





 





 





 





 





 



 =head2 $template->form_actions() 




1103




 





 





 





 





 





 



   




1104




 





 





 





 





 





 



 This method receive a list of HTML strings, one for each action button or 




1105




 





 





 





 





 





 



 image that the form must have. 




1106




 





 





 





 





 





 



   




1107




 





 





 





 





 





 



 =cut 




1108




 





 





 





 





 





 



   




1109




 





 





 





 





 





 



 sub form_actions { 




1110




6





 





 




  
6
  



  
1
  




5



 	shift; 




1111




6





 





 





 





 





9



 	my $html= 




1112




 





 





 





 





 





 



 q(); 




1113




6





 





 





 





 





32



 	$html .= qq($_) for (@_); 




1114




6





 





 





 





 





11



 	$html .=  




1115




 





 





 





 





 





 



 q( 




1116




 





 





 





 





 





 



 ); 




1117




6





 





 





 





 





11



 	return $html; 




1118




 





 





 





 





 





 



 } 




1119




 





 





 





 





 





 



   




1120




 





 





 





 





 





 



 =head2 $template->form_footer(); 




1121




 





 





 





 





 





 



   




1122




 





 





 





 





 





 



 This must close any HTML tag that the call to $template->form_footer() leave. 




1123




 





 





 





 





 





 



   




1124




 





 





 





 





 





 



 It receive no parameters. 




1125




 





 





 





 





 





 



   




1126




 





 





 





 





 





 



 =cut 




1127




 





 





 





 





 





 



   




1128




 





 





 





 





 





 



 sub form_footer { 




1129




 





 





 





 





 





 



 	return  




1130




6





 





 




  
6
  



  
1
  




23



 q(
);
	return $html;
}

=head2 $template->form_field($fieldname,$fieldhtml);

This method from the template must write a form field. It receive to
parameters:

=head2 $fieldname

This is a description to the field. It's the label that the user must see
associated to the field.

=head2 $fieldhtml

This is the HTML to the field. It is the final HTML, no the field
properties to write the HTML.

=cut

sub form_field {
	shift;
	my $name=shift;
	my $field = shift;
	my $needed=shift;
	my $errado=shift;
	$name="$name" if $needed;
	$name="$name" if $errado;
	return
qq(


);
}

=head2 $template->form_group_init($group);

This method receive only the description for the group. The must start the
group. The function $template->form_group_end() will be called to end
everything form_group_init() leave open.

=cut

sub form_group_init {
	shift;
	my $group = shift;

	return
qq(
);
}

=head2 $template->form_group_end()

This function get no parameters, and must close any HTML tag that the
previous open form_group_init() leave open, or return the HTML to show that
the group ends here.

=cut

sub form_group_end {
	return "
}

=head2 $template->form_actions()

This method receive a list of HTML strings, one for each action button or
image that the form must have.

=cut

sub form_actions {
	shift;
	my $html=
q(
	$html .= qq($_) for (@_);
	$html .=
q(
);
	return $html;
}

=head2 $template->form_footer();

This must close any HTML tag that the call to $template->form_footer() leave.

It receive no parameters.

=cut

sub form_footer {
	return
q(

);
}

=head2 $template->footer

This function must complete the HTML document.

=cut

sub footer {
	return
q(

);
}


sub _print {
	my $self=shift;
	if ($self->{cgi}) {
		$self->{cgi}->print(@_);
	} else {
		print @_;
	}
}

1;

=head1 HTML::FormWizard Properties

The list of properties listed new can be set on new(), or later with set().
See this methods documentation for more informations about them.

=head2 -title

This is the title for the form, the heading that is write by

	$template->form_init();

The value for this property must be a string. For exemple:

	$form->set(-title => 'Simple Test Form');

=head2 -url

This property defines the URL to where the post will be done.

For example:

	$form->set(-url => 'http://www.camelot.co.pt/forms/zbr.html');

=head2 -method

This property defines the HTTP method that will be used to submit the
data. The default to this value is POST.

=head2 -encoding

Encoding is the type of encoding that will be used for submitting the data
from the client to the server. Once this library was written to work with
itself, and CGI accepts "multipart/form-data" without problems,
this is the default value for this property, set it if you will be submitting
data to old CGI, or scripts that do not support that format.

=head2 -template

The property allows the definition of a diferent template for producing the
HTML to the form. The default value for this value is the $self reference.

The template is any object that have the functions listed in the previous
section.

=head2 -cgi

This property must be a reference to CGI or any other lib that can
param() and print in a compatible way with CGI.

If this property is not defined, the values will never be returned and the
form will always printed to STDOUT.

=head2 -fields

This is a reference for a list of form fields. See next section for details.

=head2 -actions

This is a reference to a list of buttons and image inputs.
See after Fields Details for details about actions.

=head1 Fields Details

Diferent field types have diferents properties. The diferent valid types are:

Each Field is an HASH, with the property name as key.
The property that defines the type of field is type.

For example:

	{ type => 'line',
	  name => 'zbr' }

Defines a simple inputbox field named 'zbr'.

=head2 type

This defines the type of field. Valid values for type are:

	line
	passwd or password
	check or checkbox
	radio
	list
	mlist
	text
	file
	hidden

	or

	group

Any other value will be ignored and line type will be created if possible.

=head2 name

Every field must have a property name, or will not be created. This field is
needed to retrieve the data also, so it can't be omitted.

There is only one exception to this: the groups don't need a name.

BUT, if a group don't have name, the field values will be stay on the base
data HASH, and not in a sub HASH.

=head2 description

This property is optional. If not defined, the module will create it with
ucfirst(name).

Used for the field label.

=head2 validate

This property is optional. If used, it must be a function that receives a
string or an arrayref, depending on the type of field, and return false or
an error string to be printed in the form requesting the repost.

=head2 datatype

This property is still experimental, and actually only validates 6 diferent
kind of values:

	email => validate email address;
	phone => validate phone numbers;
	pt_cp => portuguese postal codes;
	us_cp => american postal codes;
	ipv4  => IP addresses;
	ccard => Credit cards.

Others will be implementated as soon as possible.

=head2 Type specific field properties

Some of the properties listed on this section applies to more than one field
type, but may differ on the final result.

=head2 line and passwd

This is normal inputbox (filled with * for passwd).

Its properties are:

	 value

Must be a scalar, and will be the default value for the field.

	 size

Must be a number. Will be assigned to the SIZE property of the INPUT in HTML.

	 maxlen

Maxlen is the max number of character the field will receive. It is assign to
the input box, but will also be verified be validate().

	 minlen

minlen isn't defined by HTML, so it will only be verified by validate
function.

=head2 radio

This can be a single radio button or a group of radio buttons.

	 value

Depending on what you want, the value property for radio fields must be
diferent things too.

If you want s single radio button (I know, it's usual, but...), The value
Property can be a scalar.

If you want a group of radio buttons, the value property can be either an
ARRAY or an HASH. In the first case the each element of the ARRAY will be
used for the value of the radio and for the label associated with it. In the
second case (when value is a HASH), the keys will be used as values and the
values in the HASH will be uses as labels.

	 default

This must be a scalar containning the value initially selected.

	 cols

This sets the number of radio buttons for line.

=head2 checkbox

This is a checkbox or a group of checkboxes. See radio for details about
properties.

	 defaults

This property is used when you have more than one checkbox. This is a list
of all the default checked boxes.


=head1 COPYRIGHT

Copyright 2002 Merlin, The Mage - camelot.co.pt

This library if open source, you can redistribute it and/or modify it under
the same terms as Perl itself.


=head1 AUTHOR

Merlin, The Mage

=cut