",
-manual => 0, -customLabel => "text",
-optionsTypes => [
{ -Type => "searchBox", -Label => "state", -Value => "AZ", -data => [ "AZ", "AR", "HI", "IL", "MO", "MS" ], -isSorted => 1, -displayEmpty => 1, -displayHelp => 1 },
{ -Type => "select", -Label => "select", -Value => "Two", -Options => \%testOptions },
{ -Type => "datePicker", -Label => "date", -Value => "2005-05-21", -year => "2005" },
{ -Type => "colorPicker", -Label => "color", -Value => "transparent", },
],
-debugLevel => 0, -displayLabels => 0, -displayColumnHeaders => 1, -columnHeaders => ["First Name", "Select", "Date", "Color"], -ReadOnly => 0, -ReadOnlyMode => "DOM", },
%{$result{data}},
);
# create the order array that specifies the order form items should be processed by createTemplate().
my @order = qw( useTemplate fname mname lname state color color2 color3 startDate endDate num1 num2 num3 calc1 comment check1 check2 check3 check4 );
foreach my $entry (@{$result{order}})
{
push @order, $entry;
}
# build up the profile to pass to the Data::FormValidator for validation
# of the input when the form is submitted back to us.
my %profile = ( required => [ qw( fname lname state color color2 color3 startDate endDate command formSubmitted calc1 ) ],
optional => [ qw( mname comment check1 check2 check3 check4 useTemplate ) ],
constraints => { fname => qr/^.+$/,
mname => qr/^.$/,
lname => qr/^.+$/,
color3 => qr/^((#([A-Fa-f0-9]){6})|transparent|inherit)( !important)?$/,
command => sub { my $value = shift; return (exists $commands{$value} ? $value : 0); },
},
);
foreach my $entry (@{$result{profile}->{required}})
{
push @{$profile{required}}, $entry;
}
my $template = <<"END_OF_FORM";
END_OF_FORM
my $doc = HTMLObject::Normal->new();
my $formObj = HTMLObject::Form->new();
$template .= $doc->br() . $doc->hr(width => "50%") . "\n";
$doc->setTitle("HTMLObject::Form test script");
# setup the JavaScript error handler support.
my $email = "changeme\@your.domain";
$doc->enableJavascriptErrorHandler(email => $email, prgName => "form.cgi", prgVersion => "1.0");
use vars qw ( %input %clientFileNames %fileContentTypes %serverFileNames );
HTMLObject::CGILib::ReadParse(*input, \%clientFileNames,
\%fileContentTypes, \%serverFileNames);
my %form = (); # the variable that holds the generated form data.
my $displayForm = 0; # signal when we need to display the form.
my $updateData = 0; # signal when the data is ok to work with
if (exists $input{formSubmitted})
{
# validate the submitted form
my $result = $formObj->validate(input => \%input, profile => \%profile, data => \%data);
if ($formObj->error)
{
# display the error message.
die $formObj->errorMessage;
}
if (!$result)
{
$displayForm = 1;
}
else
{
# we have a valid form filled out.
# update the database and continue, etc.
# use the valid entries from the $formObj instance.
$displayForm = 1;
$updateData = 1;
}
}
else
{
$displayForm = 1;
}
if ($displayForm)
{
my %extraArgs = ();
$extraArgs{template} = $template if (exists $input{useTemplate});
%form = $formObj->generate(
data => \%data, %extraArgs,
name => "mainForm", action => "",
method => "post", profile => \%profile,
order => \@order, onsubmit => $result{html}{onsubmit});
if ($formObj->error)
{
# display the error message
die $formObj->errorMessage;
}
$form{javascript} .= $result{html}->{javascript};
push @{$form{link}}, $result{html}->{link};
}
if ($updateData)
{
# output the found entries
$form{body} .= $doc->br() . $doc->br() . "Valid Entries:" . $doc->br() . "\n";
foreach my $f ($formObj->getValid)
{
my $value = $formObj->getValidEntry($f);
$form{body} .= "$f = '" . (ref($value) eq "ARRAY" ? $doc->formEncode(join(", ", @{$value})) : $doc->formEncode($value)) . "'" . $doc->br() . "\n";
}
$form{body} .= $doc->br() . "Unknown Entries:" . $doc->br() . "\n";
foreach my $f ($formObj->getUnknown)
{
my $value = $formObj->getUnknownEntry($f);
$form{body} .= "$f = '" . (ref($value) eq "ARRAY" ? $doc->formEncode(join(", ", @{$value})) : $doc->formEncode($value)) . "'" . $doc->br() . "\n";
}
}
# at this time, print the form into your document.
$doc->print(%form);
# test the new setBodyAttribute() method.
#$doc->setBodyAttribute(onblur => "alert('blurring!');");
# test the new optionsBuilder() method.
$doc->print($doc->br . "optionsBuilder test: " . $doc->select(name => "color2", -content => $doc->optionsBuilder(options => getColors(), selected => $input{color2})));
$doc->print(bodyStyle => "color: purple;");
$doc->setBodyID("myBody");
$doc->display();
exit 0;
# returns a hashref with names and values entries that
# are anonymous arrays containg the pairs of data
# to put in the options tags for a select box.
sub getColors
{
# do a database lookup, etc.
my %result = ();
$result{names} = [ qw( Red Blue Green Yellow Black White ) ];
$result{values} = [ qw( red blue green yellow black white ) ];
return \%result;
}