Listing 3: A modified version of enter-birthday-info.pl that creates a
cookie and returns it along with the HTTP header.

#!/usr/bin/perl -w

use strict;
use diagnostics;
use CGI;     # see http://www.perl.com/CPAN
use Mysql;

# Create an instance of CGI
my $query = new CGI;

# Grab information the user gave us, and verify it
my $firstname = $query->param("firstname");
my $lastname = $query->param("lastname");

# Make sure that the user has entered a plausible address
my $email = $query->param("email");
&log_and_die("You entered an invalid e-mail address!") 
 unless ($email =~ /@.*\..*/);

# Gather birthday information
my $birthmonth = $query->param("month");
my $birthday = $query->param("day");
my $birthyear = 
 1900 + (10 * $query->param("yeartens")) + $query->param("yearones");

# Create a date string from that information
my $birthdate = "$birthyear-$birthmonth-$birthday";

# Now that we have the basic information, create an SQL query
my $command = "insert into birthdays ";
$command .= "(firstname, lastname, email, birthdate) ";
$command .= "values ";
$command .= "(\"$firstname\", \"$lastname\", \"$email\", \"$birthdate\")";

# Connect to the database server
my $dbh = Mysql->connect("localhost", "test");

# Send the query for processing
my $sth = $dbh->query($command);

# Check for duplication errors, then for other errors
if ($dbh->errno == 2000)
 {
  &log_and_die("There is already an entry in the database for \"$email\". Try another e-mail address!");
 }
elsif (!defined $sth)
 {
  &log_and_die("MySQL error " . $dbh->errno . " on command \"$command\"<P>" . $dbh->errmsg) unless (defined $sth);
 }

# If there were no errors, then send results to the user
else
 {
  # Create the cookie, using person_id from the inserted row
  my $cookie = $query->cookie(-name => "person_id",
				-value => $sth->insertid);

  # Return a header, including the cookie
  print $query->header(-type => "text/html", 
			 -cookie => $cookie);

  print "<pre>", $query->header(-type => "text/html", 
				 -cookie => $cookie), "</pre>\n";

  # Return something to the user
  print "<P>Done!</P>\n"; 
 }

# ------------------------------------------------------------
# Useful subroutine for dying with error messages
sub log_and_die
 {
  my $message = shift;
  
  # First send a MIME header
  print $query->header("text/html");

  # Now send the message
  print $query->start_html(-title => "Error!");
  print "<H1>Error</H1>\n";
  print "<P>$message</P>\n";
  print $query->end_html;
  
  die $message;
 }