Writing Your Own Form Handling Scripts (Perl CGI), Part IV
Todays' article is the last installment. 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.
- 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.
- The example form and the script.
- The confirmation page template.
- Displaying the confirmation page.
- The complete script.
If you haven't read the previous sections of this tutorial, do so now. They're linked from the Willmaster Library index.
IV. How to personalize the "thank you"/confirmation page for your form user.
a. The example form and the script.
Retrieve the example form and script from the "Writing Your Own Form Handling Scripts, Part I" and "...Part III" linked at the Willmaster Library index.
The script, with today's modifications incorporated, is also printed at the end of this article.
b. The confirmation page template.
The first thing to do is create an template for the confirmation page. The template will be a regular web page except:
- All URLs in HTML tags (including href's, src's, and form action's) must be complete http://... URLs. Relative URLs don't work when the script is in a different directory than the template. If your template page is in the same directory as the script, relative URLs will probably work okay, but you may want to use complete URLs anyway so you'll be able to move the template without having to redo all the URLs.
- Placeholders are placed where the script will insert form information before displaying the page.
Placeholders for confirmation page templates are the same as for email and database templates, form field names enclosed with double square brackets. Here is an example confirmation page template:
<html> <body> <p> Thank you for your participation, [[username]]! </p> <p> An email has been sent to [[email]] with your new access code. It should arrive soon. </p> </body> </html>
The confirmation page template can have placeholders for any or all of the form information, or even none if you don't want it personalized.
c. Displaying the confirmation page.
Near the top of the script, insert these three lines:
use LWP::Simple; # Use this line only if $Confirmation is 
                 #   a URL (instead of a directory path).
my $Confirmation = 'http://domain.com/thankyou.html';
The $Confirmation variable can contain either a complete http://... URL to your confirmation page template or its server directory path. Here is an example of a server directory path:
my $Confirmation = '/www/htdocs/thankyou.html';
If $Confirmation contains a server directory path, you don't need the "use LWP::Simple..." line. However, instead of removing it, you might just disable it by putting a "#" character at the beginning of the line. That way, if you decide to use a URL sometime in the future, you merely remove that leading "#" character.
Next, put this confirmation page generation subroutine at the bottom of your script.
sub PresentConfirmation
{
   my $next = $Confirmation;
   $next = $In{next} if $In{next} =~ m!^https?://.!;
   my $page;
   if($next =~ m!^https?://!) { $page = get $next; }
   else
   {
      open R,"<$next";
      $page = join '',<R>;
      close R;
   }
   ErrorHTML("<b>$next</b> not found") unless $page =~ /\w/;
   for(keys %In) { $page =~ s/\[\[$_\]\]/$In{$_}/sig; }
   $page =~ s/\[\[.*?\]\]//sig;
   print "Content-Type: text/html\n\n$page";
} # sub PresentConfirmation
The PresentConfirmation subroutine allows you to override the $Confirmation variable if your form has a hidden field named "next" -- but only if the hidden field's value is a URL. A server directory path as the hidden field's value is not acceptable because it is a security risk. If a directory path were possible, crackers could display any file on your server, including password and other files with sensitive data. With URLs, only pages that would also be accessible by browser are available.
For the last edit, at about line 30, replace
ErrorHTML('Script paused here.'); # temporary line
with
&PresentConfirmation;
With that edit, you've finished the script.
V. The complete script.
Here is the complete form handling script:
#!/usr/bin/perl
# By [your name here]
use strict;
use LWP::Simple; # Use this line only if $Confirmation is 
                 #   a URL (instead of a directory path).
my $Confirmation = 'http://domain.com/thankyou.html';
my $AuthorizedDomain = 'mydomain.com';
my $DBtemplate = "[[username]]\tlf@willbontrager.com\t[[message]]\n";
my $DatabaseFile = 'data.txt';
my $EmailTemplateFile = 'template.txt';
my $Mailer = '/sbin/sendmail -t';
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;
&SendEmail;
&PresentConfirmation;
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,4}|[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
sub SendEmail
{
   open R,$EmailTemplateFile;
   my $email = join '',<R>;
   close R;
   for(keys %In) { $email =~ s/\[\[$_\]\]/$In{$_}/sig; }
   $email =~ s/\[\[.*?\]\]//sig;
   open MAIL,"|$Mailer";
   print MAIL $email;
   close MAIL;
} # sub SendEmail
sub PresentConfirmation
{
   my $next = $Confirmation;
   $next = $In{next} if $In{next} =~ m!^https?://.!;
   my $page;
   if($next =~ m!^https?://!) { $page = get $next; }
   else
   {
      open R,"<$next";
      $page = join '',<R>;
      close R;
   }
   ErrorHTML("<b>$next</b> not found") unless $page =~ /\w/;
   for(keys %In) { $page =~ s/\[\[$_\]\]/$In{$_}/sig; }
   $page =~ s/\[\[.*?\]\]//sig;
   print "Content-Type: text/html\n\n$page";
} # sub PresentConfirmation
There it is, a form handling script of less than 200 lines that sends custom emails, maintains a database, and presents personalized "thank you" pages. More than just a skeleton, it has professional features such as restricting use to your own domain, allowing formatted dates to be in any written language, and verifying that email addresses are provided and correctly formatted.
Great job!
Will Bontrager

 
 



 
 
 
     
 
     
 
     
 
     
 
     
 
     

