Writing Your Own Form Handling Scripts, Part II
Todays' article is the second of four installments. Here is
a table of contents for the entire series:
- How to put information from the form into the
script.
- How to store the form information in a database
file on your server -- in any plain text format,
including tab- and comma-delimited formats that
can be imported into Excel and other spreadsheet
and database programs.
- The example form and the script.
- The database template.
- Handling multi-line and multi-value form
fields.
- Multi-line textarea fields.
- Duplicate name and multi-value checkbox
and select box selections.
- Formatting date and time fields.
- Updating the database file.
- The script up to this point.
- How to send the form information to yourself in
an email -- formatted however you please,
including HTML.
- How to personalize the "thank you"/confirmation
page for your form user.
If you haven't read Part I of this tutorial, do so now. It
is linked from /library/
II. How to store the form information in a database file
on your server -- in any plain text format, including
tab- and comma-delimited formats that can be imported
into Excel and other spreadsheet and database programs.
a. The example form and the script.
So you don't have to refer to Part I just to review the
example form and the form handling script this tutorial
uses, they're printed here.
The example form:
<form method="POST" action="myscript.cgi">
<input type="hidden" name="Subject" value="testing...">
Name:
<input type="text" name="username">
<br><br>
Email:
<input type="text" name="email">
<br><br>
Gender:
<input type="radio" name="gender" value="female">Female
<input type="radio" name="gender" value="male">Male
<br><br>
Favorite Color (select one):
<select name="favorite color">
<option value="white">White</option>
<option value="red">Red</option>
<option value="yellow">Yellow</option>
<option value="blue">Blue</option>
<option value="purple">Purple</option>
<option value="orange">Orange</option>
<option value="green">Green</option>
<option value="black">Black</option>
</select>
<br><br>
Favorite Color Runner-ups (select any):<br>
<input type="checkbox" name="c2" value="white">White<br>
<input type="checkbox" name="c2" value="red">Red<br>
<input type="checkbox" name="c2" value="yellow">Yellow<br>
<input type="checkbox" name="c2" value="blue">Blue<br>
<input type="checkbox" name="c2" value="purple">Purple<br>
<input type="checkbox" name="c2" value="orange">Orange<br>
<input type="checkbox" name="c2" value="green">Green<br>
<input type="checkbox" name="c2" value="black">Black<br>
<br>
Your Message:<br>
<textarea name="message" cols="22" rows="5"></textarea>
<br><br>
<input type="submit" value="Send Form Info">
</form>
<!-- END OF EXAMPLE FORM -->
The form handling script:
#!/usr/bin/perl
# By [your name here]
use strict;
my $AuthorizedDomain = 'mydomain.com';
my %In = ();
my $FormDomain = lc $ENV{HTTP_REFERER};
$FormDomain =~ s!^https?://(?:www\.)?(.*?)(?:/.*)$!$1!;
unless($FormDomain eq lc $AuthorizedDomain)
{ ErrorHTML('Unauthorized access.'); }
unless(ParsePost())
{ ErrorHTML('Unauthorized access.'); }
unless($In{email})
{ ErrorHTML('An email address is required.'); }
unless(ValidEmail($In{email}))
{ ErrorHTML('Sorry, invalid email address format.'); }
if(length($In{message}) > 250)
{ $In{message} = substr($In{message},0,250); }
ErrorHTML('Script paused here.'); # temporary line
Exit();
sub ParsePost
{
return 0 unless $ENV{REQUEST_METHOD} =~ /POST/i;
my $buffer;
read(STDIN,$buffer,$ENV{CONTENT_LENGTH});
my @p = split(/&/,$buffer);
foreach(@p)
{
$_ =~ tr/+/ /;
my ($n,$v) = split(/=/,$_,2);
$n =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
$v =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
$v =~ s/(\<.*?)(embed|object|script|applet)(.*?\>)/$1$3/gis;
if($In{$n}) { $In{$n} .= "\t$v"; }
else { $In{$n} = $v; }
}
return 1;
} # sub ParsePost
sub ValidEmail
{
if($_[0]=~/([\.\-\_]{2,})|(@[\.\-\_])|([\.\-\_]@)|(\A\.)/)
{ return 0; }
if($_[0]=~/^[\w\.\-\_]+\@\[?[\w\.\-\_]+\.([\w\.\-\_]{2,3}|[0-9])\]?$/)
{ return 1; }
return 0;
} # sub ValidEmail
sub ErrorHTML
{
my $s = join("\n<li>",@_);
print "Content-type: text/html\n\n";
print <<HTML;
<html><body bgcolor="white">
<blockquote><blockquote>
<h4>Message:</h4>
<ul>
<li>$s
</ul>
</blockquote></blockquote>
</body></html>
HTML
Exit();
} # sub ErrorHTML
sub Exit { exit; }
# END OF FORM HANDLING SCRIPT
b. The database template.
The first thing to do is create a database template. The
template will be the database record's format with
placeholders where the script will insert form information
before updating the database file.
Placeholders can be anything we create them to be. For this
tutorial, placeholders is the form field name enclosed with
double square brackets. Our example form has seven field
names, which results in these placeholders:
[[Subject]]
[[username]]
[[email]]
[[gender]]
[[favorite color]]
[[c2]]
[[message]]
You can store any or all of the form information in your
database. For now, let's assume you will be storing the
form user's name, email address, and any message that was
left.
For a tab-delimited database importable by stand-alone
spreadsheet and database programs with import functions,
the program line with the template would be:
my $DBtemplate = "[[username]]\t[[email]]\t[[message]]\n";
The 2-character sequence \t tells the script to insert a
tab character. And the 2-character sequence \n tells the
script to insert a line break. Both tab- and comma-delimited
databases are one record per line, which is why the \n needs
to be at the end of the template.
For a comma-delimited database importable by stand-alone
spreadsheet and database programs with import functions,
the program line with the template would be:
my $DBtemplate = "\"[[username]]\",\"[[email]]\",\"[[message]]\"\n";
Because the template is between quotes, any quotes within
the template must be specified with the 2-character
sequence \" (Fields are enclosed in quotes so any comma
that may be in the field's data is not mistaken as a field
separating comma.)
For a multi-line database, your template could be something
like this:
my $DBtemplate = "[[username]]\n[[email]]\n[[message]]\n\n";
In the above example, line breaks are specified between each
placeholder. And there is an extra \n at the end of the
template to generate a blank line between records.
We'll use the tab-delimited database template in this
tutorial's form handling script. Insert the $DBtemplate
template assignment statement at about line 6, below the
$AuthorizedDomain assignment statement. I.E.:
my $AuthorizedDomain = 'mydomain.com';
my $DBtemplate = "[[username]]\t[[email]]\t[[message]]\n";
c. Handling multi-line and multi-value form fields.
i. Multi-line textarea fields.
Tab- and comma-delimited databases must be one record per
line. The textarea field name="message" could contain
multiple lines. The line break characters must be removed
or replaced with another character or characters. This
function will do that for you:
sub MakeOneLine
{
my $s = shift;
my $replacement = '<br>';
if($s =~ /\n/) { $s =~ s/\r//gs; }
else { $s =~ s/\r/\n/gs; }
$s =~ s/\n/$replacement/gs;
return $s;
} # sub MakeOneLine
To replace line breaks with something else (in the above
function), replace <br> in the
my $replacement = '<br>';
line with your custom line break replacement. If you want
to remove the line breaks (replace them with nothing), put
nothing between the apostrophes.
A note on the if... and else... lines: It's possible that
this script will run on UNIX/Linux, Macintosh, and/or NT
servers. Each possibility must be taken into consideration.
UNIX/Linux computers use \n (named "newline") as a line
break. Macintosh computers use \r (named "carriage return").
And NT servers use both: \n\r
The subroutine MakeOneLine replaces the \n 2-character
sequence with whatever you specify for the value of
$replacement. Therefore, if it is an NT, the \r characters
must be removed. But if it is a Macintosh, then the \r
characters must be converted to \n
The if... statement checks to see if any \n characters are
present. If a \n character is present, it's not a Macintosh
server and any \r characters can be deleted. else... it is
a Macintosh and \r characters are converted to \n
To use subroutine MakeOneLine, your statement would be
something like this:
$In{message} = MakeOneLine($In{message});
Put the MakeOneLine subroutine at the bottom of your
current script.
ii. Duplicate name and multi-value checkbox and select
box selections.
There are several situations where the same form field name
can hold multiple values:
- A set of checkboxes have the same field name
(like the example form).
- A select list box has the "multiple" attribute.
- Any form field has the same name as another.
Whenever a form field name holds more than one value, that
value is separated with a tab character. (The subroutine
ParsePost makes sure this is so.)
Okay, if you're going to include a tab-separated list into
a tab-delimited database, you're in trouble. First, the tab
characters must be removed or replaced with another
character or characters. This function will do that for you:
sub ConvertTabValueSeparaters
{
my $s = shift;
my $replacement = ' -- ';
$s =~ s/\t/$replacement/gs;
return $s;
} # sub ConvertTabValueSeparaters
In the above function, tabs are replaced with a long dash.
To customize, put your own replacement between the
apostrophes in
my $replacement = ' -- ';
If you want to remove the tabs (replace them with nothing),
put nothing between the apostrophes.
To use subroutine ConvertTabValueSeparaters, your statement
would be something like this:
$In{c2} = ConvertTabValueSeparaters($In{c2});
Put the ConvertTabValueSeparaters subroutine at the bottom
of your current script.
d. Formatting date and time fields.
In some situations, you might want to put the date and/or
time into your database records. Here are two subroutines
that will return a formatted date and a formatted time,
respectively:
sub GetFormattedDate
{
my @Weekday = qw(
Sunday
Monday
Tuesday
Wednesday
Thursday
Friday
Saturday);
my @Month = qw(
January
February
March
April
May
June
July
August
September
October
November
December);
my ($sc,$mn,$hr,$mday,$mon,$yr,$wday,$yday,$dst) = localtime;
$yr += 1900;
return "$Weekday[$wday], $Month[$mon] $mday, $yr";
} # sub GetFormattedDate
sub GetFormattedTime
{
my ($sc,$mn,$hr,$mday,$mon,$yr,$wday,$yday,$dst) = localtime;
my $s = '';
$s .= $hr < 10 ? "0${hr}:" : "${hr}:";
$s .= $mn < 10 ? "0${mn}:" : "${mn}:";
$s .= $sc < 10 ? "0${sc}" : $sc;
return $s;
} # sub GetFormattedTime
With the above subroutines, the date will be formatted as
Weekday, Month d, yyyy
and the time will be formatted according to a 24-hour clock as
hh:mm:ss
The date and time will be the date and time on your server.
To use the subroutines, your statements would be something
like this:
$In{Date} = &GetFormattedDate;
$In{Time} = &GetFormattedTime;
You can now add the following placeholders to your list:
[[Date]]
[[Time]]
Put the subroutines at the bottom of your current script.
e. Updating the database file.
You'll need to assign a file name for the script to update.
Use variable $DatabaseFile and put the assignment under the
$DBtemplate assignment statement at about line 7. You'll
end up with:
my $AuthorizedDomain = 'mydomain.com';
my $DBtemplate = "[[username]]\t[[email]]\t[[message]]\n";
my $DatabaseFile = 'data.txt';
The following subroutine will insert form information into
the template and update the database:
sub UpdateDatabase
{
my $t_message = $In{message};
my $t_c2 = $In{c2};
$In{message} = MakeOneLine($In{message});
$In{c2} = ConvertTabValueSeparaters($In{c2});
$In{Date} = &GetFormattedDate;
$In{Time} = &GetFormattedTime;
for(keys %In) { $DBtemplate =~ s/\[\[$_\]\]/$In{$_}/i; }
$DBtemplate =~ s/\[\[.*?\]\]//i;
if(-e $DatabaseFile) { open W,">>$DatabaseFile"; }
else { open W,">$DatabaseFile"; }
print W $DBtemplate;
close W;
$In{c2} = $t_c2;
$In{message} = $t_message;
} # sub UpdateDatabase
Notice that the first two lines of the subroutine store
the contents of $In{message} and $In{c2} into temporary
variables. Those hold the values of form fields named
"message" and "c2", respectively. The values will be changed
to be acceptable for the database. ("c2" isn't actually used
in the current template, but is included as an example.)
The last two lines of the subroutine, then, restore the
values to $In{message} and $In{c2} from the temporary
variables.
Although the date and time aren't used in the current
database format, their initialization is included here
as examples.
About mid-subroutine, you'll see
for(keys %In) { $DBtemplate =~ s/\[\[$_\]\]/$In{$_}/i; }
That line replaces the template placeholders with form
field values. Notice the "i" near the end of that line,
just before the semi-colon. That "i" tells the script to
consider the form field names to be case insensitive ("name"
and "Name" and "NAME" are considered the same). If you want
the field names to be case sensitive ("name" and "Name" and
"NAME" are all different), then just remove the "i" from
that line.
The next line removes any placeholders that weren't replaced
with form information.
The if... and else... lines check to see if your database
file already exists. If yes, the file is opened so any
writes are appended. If no, the file is created.
Following the if... and else... lines, the script prints the
information to the file and then closes it.
To use the UpdateDatabase subroutine, your statement would
be:
&UpdateDatabase;
Put the UpdateDatabase subroutine at the bottom of your
current script.
f. The script up to this point.
Here is the form handling script up to this point:
#!/usr/bin/perl
# By [your name here]
use strict;
my $AuthorizedDomain = 'mydomain.com';
my $DBtemplate = "[[username]]\t[[email]]\t[[message]]\n";
my $DatabaseFile = 'data.txt';
my %In = ();
my $FormDomain = lc $ENV{HTTP_REFERER};
$FormDomain =~ s!^https?://(?:www\.)?(.*?)(?:/.*)$!$1!;
unless($FormDomain eq lc $AuthorizedDomain)
{ ErrorHTML('Unauthorized access.'); }
unless(ParsePost())
{ ErrorHTML('Unauthorized access.'); }
unless($In{email})
{ ErrorHTML('An email address is required.'); }
unless(ValidEmail($In{email}))
{ ErrorHTML('Sorry, invalid email address format.'); }
if(length($In{message}) > 250)
{ $In{message} = substr($In{message},0,250); }
&UpdateDatabase;
ErrorHTML('Script paused here.'); # temporary line
Exit();
sub ParsePost
{
return 0 unless $ENV{REQUEST_METHOD} =~ /POST/i;
my $buffer;
read(STDIN,$buffer,$ENV{CONTENT_LENGTH});
my @p = split(/&/,$buffer);
foreach(@p)
{
$_ =~ tr/+/ /;
my ($n,$v) = split(/=/,$_,2);
$n =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
$v =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
$v =~ s/(\<.*?)(embed|object|script|applet)(.*?\>)/$1$3/gis;
if($In{$n}) { $In{$n} .= "\t$v"; }
else { $In{$n} = $v; }
}
return 1;
} # sub ParsePost
sub ValidEmail
{
if($_[0]=~/([\.\-\_]{2,})|(@[\.\-\_])|([\.\-\_]@)|(\A\.)/)
{ return 0; }
if($_[0]=~/^[\w\.\-\_]+\@\[?[\w\.\-\_]+\.([\w\.\-\_]{2,3}|[0-9])\]?$/)
{ return 1; }
return 0;
} # sub ValidEmail
sub ErrorHTML
{
my $s = join("\n<li>",@_);
print "Content-type: text/html\n\n";
print <<HTML;
<html><body bgcolor="white">
<blockquote><blockquote>
<h4>Message:</h4>
<ul>
<li>$s
</ul>
</blockquote></blockquote>
</body></html>
HTML
Exit();
} # sub ErrorHTML
sub Exit { exit; }
sub MakeOneLine
{
my $s = shift;
my $replacement = '<br>';
if($s =~ /\n/) { $s =~ s/\r//gs; }
else { $s =~ s/\r/\n/gs; }
$s =~ s/\n/$replacement/gs;
return $s;
} # sub MakeOneLine
sub ConvertTabValueSeparaters
{
my $s = shift;
my $replacement = ' -- ';
$s =~ s/\t/$replacement/gs;
return $s;
} # sub ConvertTabValueSeparaters
sub GetFormattedDate
{
my @Weekday = qw(
Sunday
Monday
Tuesday
Wednesday
Thursday
Friday
Saturday);
my @Month = qw(
January
February
March
April
May
June
July
August
September
October
November
December);
my ($sc,$mn,$hr,$mday,$mon,$yr,$wday,$yday,$dst) = localtime;
$yr += 1900;
return "$Weekday[$wday], $Month[$mon] $mday, $yr";
} # sub GetFormattedDate
sub GetFormattedTime
{
my ($sc,$mn,$hr,$mday,$mon,$yr,$wday,$yday,$dst) = localtime;
my $s = '';
$s .= $hr < 10 ? "0${hr}:" : "${hr}:";
$s .= $mn < 10 ? "0${mn}:" : "${mn}:";
$s .= $sc < 10 ? "0${sc}" : $sc;
return $s;
} # sub GetFormattedTime
sub UpdateDatabase
{
my $t_message = $In{message};
my $t_c2 = $In{c2};
$In{message} = MakeOneLine($In{message});
$In{c2} = ConvertTabValueSeparaters($In{c2});
$In{Date} = &GetFormattedDate;
$In{Time} = &GetFormattedTime;
for(keys %In) { $DBtemplate =~ s/\[\[$_\]\]/$In{$_}/i; }
$DBtemplate =~ s/\[\[.*?\]\]//i;
if(-e $DatabaseFile) { open W,">>$DatabaseFile"; }
else { open W,">$DatabaseFile"; }
print W $DBtemplate;
close W;
$In{c2} = $t_c2;
$In{message} = $t_message;
} # sub UpdateDatabase
The "Script paused here." message in the above code will be
removed when the script is completed.
Part III of this series shows you how to take the information
in the %In variable and email it to yourself (or to anybody
else).
See you then :)
Will Bontrager
©2001 Bontrager Connection, LLC
Please note:
Articles on this website are presented "as is". However -
If you have a question about a CGI script, HTML, CSS, PHP, or JavaScript
Ask one of our Experts and you'll have your answer!
Click here for details.
