Writing Your Own Form Handling Scripts (Perl CGI), 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 the Willmaster Library index.
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
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
