#!/usr/local/bin/perl5

# ___________ documentation __________________________________________
#
# author: Doug Sanderson
#
# This perl script controls all screens and forms associated with the
# "sports date" program.  Users can register their sports interests
# and query for other registered users with similar interests.  The
# data is kept in an ascii file, with one line per registered user, and
# the backquote character used to separate field tokens on one line.
# Output data is initially written to a tmp file, and when complete,
# the contents of the tmp file are sent to the client.  If an error
# is encountered part-way through the creation of a new page, only the
# error message will be returned to the user, and the partially constructed
# page will be disgarded.




# ___________ global stuff ___________________________________________

use Text::ParseWords;

@INPUT_DATA;   # holds values passed into this program by the 
               # REQUEST_METHOD
@page_types = ("TOP", "TOP_QUERY", "QUERY_PREFERENCES", "SEND_EMAIL", 
               "TOP_ADD", "ADD_ME", "TOP_NUKE", "NUKE_ME");
$page_type;    # TOP, QUERY_PREFERENCES, etc
$io_dir=".";   # holds temp i/o files
$dat_file="$io_dir/date.dat"; # holds the database data
$out_file="";  # output will initially be redirected into this file, and
               # if there are no errors, we will cat file to stdout
               # (the actual filename will be determined by a random
               #  number generator)

# Each line of the dat file will have these tokens, with the ` (backslash)
# character acting as the separator between tokens:
#   nickname (user defined nickname, not the user's actual name)
#   email (user's email address)
#   sport (such as "whitewater kayaking" or "hiking")
#   level (0 to 10, where 0=no_experience, 10=expert)
#   age (user's age)
#   sex (m or f)
#   want_sex (male (user looking for male companion), female, or either)
#   want_level_min (0 to 10; looking for at least this much experience)
#   want_level_max (0 to 10; looking for not more than this much experience)
#   want_age_min (looking for a person at least this old)
#   want_age_max (looking for a person not older than this)
#   city
#   state (2 letter abbreviation)
#   greeting (optional personal greeting)
# NOTE: any line beginning with a # will be considered a comment.

@field_name = ("nickname", "email", "sport", "level", "age", "sex",
               "want_sex", "want_level_min", "want_level_max",
               "want_age_min", "want_age_max", "city",
               "state", "greeting");
foreach $field (@field_name)
  {
  $searcher{$field} = "";  # the "searcher" associative array contains data 
                           # from the user who submitted the query or request
  $db{$field} = "";        # the "db" associative array contains data 
                           # from-or-going-to the database
  }
$content_type = "<META HTTP-EQUIV=\"Content-Type\" CONTENT=\"text/html; charset=iso-8859-1\">";
$author = "<META NAME=\"Author\" CONTENT=\"Doug Sanderson\">";
@sexual_preference = ("either", "male", "female");




# ___________ the "main" perl code starts here _______________________

srand; # used to randomly select tmp filenames

&open_out_file ();
&parse_input_data ();
&validate_page_type();

if ( $page_type eq TOP )
  { &create_top(); }
elsif ( $page_type eq TOP_QUERY )
  { &create_query_options(); }
elsif ( $page_type eq QUERY_PREFERENCES )
  { &create_query_results(); }
elsif ( $page_type eq SEND_EMAIL )
  { &email_to_nickname(); }
elsif ( $page_type eq TOP_ADD )
  { &create_add_form(); }
elsif ( $page_type eq ADD_ME )
  { &add_new_user(); }
elsif ( $page_type eq TOP_NUKE )
  { &create_nuke_form(); }
elsif ( $page_type eq NUKE_ME )
  { &nuke_old_user(); }

close (OUT_MAIN);
print `/bin/cat $out_file`;
unlink $out_file;

exit 0;

# ___________________________________________________________________

sub open_out_file
{

# all non-error output will be loaded into a temp file; if there are no
# errors, this file will be printed to stdout (back to client)

$i = ( rand() * 100 ) % 100;
$out_file = "$io_dir/tmp_$i";
open (OUT_MAIN, ">$out_file") || 
    &fatal_error("open_out_file", "failed to open $out_file");
}

# ___________________________________________________________________

sub parse_input_data
{

# All the parameters passed into this program will be placed in the
# key-value array INPUT_DATA.  Also, the variable page_type will be
# assigned a value.

local ( $request_method, $query_string, @key_value_pairs,
        $key_value, $key, $value, $new_data);

$new_data = "no";
$page_type = TOP; # invoke the main greeting screen unless told otherwise

# is the request method valid?

$request_method = $ENV{'REQUEST_METHOD'};
if ($request_method eq "GET")
    { 
    $query_string = $ENV{'QUERY_STRING'};
    if ( $query_string ne "" )
        { $new_data = "yes"; }
    }
elsif ($request_method eq "POST")
    { 
    read (STDIN, $query_string, $ENV{'CONTENT_LENGTH'});
    if ( $query_string ne "" )
        { $new_data = "yes"; }
    }

if ($new_data eq "yes")
    {

    # split the whole query_string into key_value_pairs (the '&'
    # character separates pairs)

    @key_value_pairs = split (/&/, $query_string);
    foreach $key_value (@key_value_pairs)
        {

        # the '=' character separates the key from the value

        ($key, $value) = split (/=/, $key_value);

        # the '+' was used to get rid of blanks (put them back now)

        $value =~ tr/+/ /;

        # translate any special characters from hex (0-9 and a-f)
        # to the ascii equivalent

        $value =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack ("C", hex ($1))/eg;

        # if we got scrolled list that looks like this:
        #     Numbers=One&Numbers=Two&Numbers=Three
        # then turn it into something that looks like this:
        #     key=NUMBERS   value=One\0Two\0Three

        if (defined($INPUT_DATA{$key}))
            {
            $INPUT_DATA{$key} = join ("\0", $INPUT_DATA{$key}, $value);
            }
        else
            {
            $INPUT_DATA{$key} = $value;
            }
        }

    # if there was a query_string, then page_type had better be one 
    # of the data values

    $page_type = $INPUT_DATA{page_type};
    if ( $page_type eq "" )
        {
        
        # its an error; it will cause a fatal_error call soon

        $page_type = "none-supplied";
        }
    }
}

# ___________________________________________________________________

sub validate_page_type

{

$found = nope;
foreach $page_value (@page_types)
    {
    if ($page_value eq $page_type)
        {
        $found = yes;
        last;
        }
    }
if ($found eq nope)
    {
    &fatal_error("validate_page_type",
                 "invalid page type $page_type");
    }
}

# ____________________________________________________________________
#
# This function is called in response to a request to display the toplevel
# page of the sports date senerio.

sub create_top

{
local ($title="<TITLE>welcome to sports date</TITLE>");

print OUT_MAIN "Content-type: text/html\n";
print OUT_MAIN "\n";
print OUT_MAIN "<HTML>\n<HEAD>\n$content_type\n$author\n$title\n</HEAD>\n";
print OUT_MAIN "<BODY BGCOLOR=\"white\">\n";

print OUT_MAIN "<IMG SRC=\"s_date.gif\" HEIGHT=200 WIDTH=600>\n";
print OUT_MAIN "<TABLE BORDER=0 CELLSPACING=0 CELLPADDING=0 WIDTH=\"100%\" >\n";
print OUT_MAIN "<TR>\n";
print OUT_MAIN "<TD><A HREF=\"date.cgi?page_type=TOP_QUERY\"><IMG BORDER=0 SRC=\"query.jpg\" HEIGHT=100 WIDTH=100></TD>\n";
print OUT_MAIN "<TD>Query the <B><I>Sports Date</I></B> database to see who is doing what \n";
print OUT_MAIN "in your area. If you see someone you would like to <I>\"share the \n";
print OUT_MAIN "experience\"</I> with, you can contact the person via <B><I>Sports Date</I></B> \n";
print OUT_MAIN "email. Be sure to register yourself before you try to contact other \n";
print OUT_MAIN "<B><I>Sports Date</I></B> members.</TD>\n";
print OUT_MAIN "</TR>\n";
print OUT_MAIN "<TR>\n";
print OUT_MAIN "<TD><A HREF=\"date.cgi?page_type=TOP_ADD\"><IMG BORDER=0 SRC=\"add.jpg\" HEIGHT=100 WIDTH=100></TD>\n";
print OUT_MAIN "<TD>Register yourself in the <B><I>Sports Date</I></B> database. \n";
print OUT_MAIN "You can specify who you are, which sport you enjoy, and who you would like \n";
print OUT_MAIN "to <I>\"share the experience\" </I>with.&nbsp; Register more than once for \n";
print OUT_MAIN "more than one sports interest.</TD> \n";
print OUT_MAIN "</TR>\n";
print OUT_MAIN "<TR>\n";
print OUT_MAIN "<TD><A HREF=\"date.cgi?page_type=TOP_NUKE\"><IMG BORDER=0 SRC=\"delete.jpg\" HEIGHT=100 WIDTH=100></TD>\n";
print OUT_MAIN "<TD>Remove one or more of your prior Sports Date registrations.</TD>\n";
print OUT_MAIN "</TR>\n";
print OUT_MAIN "</TABLE>\n";
print OUT_MAIN "<P>This page designed and maintained by <A HREF=\"mailto:douglas\@eskimo.com\">Doug Sanderson</A>.\n";
print OUT_MAIN "</BODY>\n";
print OUT_MAIN "</HTML>\n";
}

# ____________________________________________________________________
#
# This function is called when the user wants to look at the database
# entries.  We will return a form that allows the user to indicate
# her areas of interest.

sub create_query_options

{
local ($title="<TITLE>sports date query options</TITLE>");

print OUT_MAIN "Content-type: text/html\n";
print OUT_MAIN "\n";
print OUT_MAIN "<HTML>\n<HEAD>\n$content_type\n$author\n$title\n\n";
print OUT_MAIN "</HEAD>\n";

print OUT_MAIN "<BODY>\n";

print OUT_MAIN "<H1>Look For A Sports Date</H1>\n";

print OUT_MAIN "<p>Use the selections below to specify which sport you are \n";
print OUT_MAIN "interested in, and what kind of person you would like to \n";
print OUT_MAIN "<I>\"share the experience\"</I> with.\n";

print OUT_MAIN "<form method=GET action=http://www.eskimo.com/~douglas/cgi-bin/date.cgi>\n";

print OUT_MAIN "<input type=hidden name=page_type value=\"QUERY_PREFERENCES\">\n";

print OUT_MAIN "<p>\n";
print OUT_MAIN "name of sport: ";
print OUT_MAIN "<input type=text name=sport size=20>";
print OUT_MAIN "(optional field; its ok to abbreviate sport name)\n";

print OUT_MAIN "<br>\n";
print OUT_MAIN "your sexual preference: ";
print OUT_MAIN "<select name=want_sex>";
$array_length = @sexual_preference;
for ($i = 0; $i < $array_length; ++$i)
  { print OUT_MAIN "<option value=@sexual_preference[$i]>@sexual_preference[$i] "; }
print OUT_MAIN "</select>\n";

print OUT_MAIN "<br>\n";
print OUT_MAIN "his/her minimum skill level: ";
print OUT_MAIN "<select name=want_level_min>";
for ($i = 0; $i <= 10; ++$i)
  { print OUT_MAIN "<option value=$i>$i "; }
print OUT_MAIN "</select>\n";
print OUT_MAIN "(the minimum skill level of interest; 0=beginner)\n";

print OUT_MAIN "<br>\n";
print OUT_MAIN "his/her maximum skill level: ";
print OUT_MAIN "<select name=want_level_max>";
for ($i = 0; $i < 10; ++$i)
  { print OUT_MAIN "<option value=$i>$i "; }
print OUT_MAIN "<option value=10 selected>10 ";
print OUT_MAIN "</select>\n";
print OUT_MAIN "(the maximum skill level of interest; 10=expert)\n";

print OUT_MAIN "<br>\n";
print OUT_MAIN "his/her minimum age: ";
print OUT_MAIN "<select name=want_age_min>";
print OUT_MAIN "<option value=15 selected>15 ";
for ($i = 20; $i <= 85; $i = $i + 5)
  { print OUT_MAIN "<option value=$i>$i "; }
print OUT_MAIN "</select>\n";

print OUT_MAIN "<br>\n";
print OUT_MAIN "his/her maximum age: ";
print OUT_MAIN "<select name=want_age_max>";
for ($i = 15; $i < 85; $i = $i + 5)
  { print OUT_MAIN "<option value=$i>$i "; }
print OUT_MAIN "<option value=85 selected>85 ";
print OUT_MAIN "</select>\n";

print OUT_MAIN "<br>\n";
print OUT_MAIN "his/her city: ";
print OUT_MAIN "<input type=text name=city size=30>\n";
print OUT_MAIN "(optional field)\n";

print OUT_MAIN "<br>\n";
print OUT_MAIN "his/her state: ";
print OUT_MAIN "<input type=text name=state size=2>\n";
print OUT_MAIN "(optional field)\n";

print OUT_MAIN "<br>\n";
print OUT_MAIN "<input type=submit name=decision value=ok>\n";
print OUT_MAIN "<input type=submit name=decision value=cancel>\n";

print OUT_MAIN "</form>\n";
print OUT_MAIN "</BODY>\n";
print OUT_MAIN "</HTML>\n";
}

# ____________________________________________________________________
#
# This function generates a html page filled with entries from the
# database which match the search parameters input by the user.

sub create_query_results
{
local $found_match = "no";
local $matching_nickname;
local @all_matches;
local $all_length = 0;

if ($INPUT_DATA{decision} ne "ok")
  { &create_top(); }
else
  {

  # I'm going to use java script to pre-validate fields, so lets assume 
  # everything is cool by the time it gets to us.

  foreach $field (@field_name)
    { $searcher{$field} = $INPUT_DATA{$field}; }

  open (DB_FILE, "$dat_file") ||
      &fatal_error("create_query_results", "failed to open $dat_file");
  print OUT_MAIN "Content-type: text/html\n";
  print OUT_MAIN "\n";
  print OUT_MAIN "<HTML>\n<HEAD>\n$content_type\n$author\n$title\n\n";

  # add JavaScript error checking

  print OUT_MAIN "<SCRIPT LANGUAGE=\"JavaScript\">\n";
  # print OUT_MAIN "<!--hiding from old browsers\n";
  print OUT_MAIN "function check_it(form)\n";
  print OUT_MAIN "{\n";
  print OUT_MAIN "var msg = \"\";\n";

  print OUT_MAIN "if (form.nickname_target.value == \"\")\n";
  print OUT_MAIN "  msg = msg + \"You must include the nickname you wish to contact.\\n\";\n";

  print OUT_MAIN "if (form.nickname.value == \"\")\n";
  print OUT_MAIN "  msg = msg + \"You must include your nickname.\\n\";\n";

  print OUT_MAIN "if (form.email.value == \"\")\n";
  print OUT_MAIN "  msg = msg + \"You must include your email address.\\n\";\n";

  print OUT_MAIN "if (msg != \"\")\n";
  print OUT_MAIN "  {\n";
  print OUT_MAIN "  alert(msg);\n";
  print OUT_MAIN "  return false;\n";
  print OUT_MAIN "  }\n";
  print OUT_MAIN "}\n";
  # print OUT_MAIN "//--done hiding>\n";
  print OUT_MAIN "</SCRIPT>\n";
  print OUT_MAIN "</HEAD>\n";

  print OUT_MAIN "<BODY>\n";
  while ( <DB_FILE> )
    {
    $matching_nickname = &query_check("$_");
    if ($matching_nickname ne "")
      {
      if ($found_match eq "no")
        {
        $found_match = "yes";
        print OUT_MAIN "<H1>Matches From The Sports Date Database</H1>\n";
        }
      $all_matches[$all_length] = $matching_nickname;
      ++$all_length;
      &write_query_match("$_");
      }
    }
  close DB_FILE;
  if ($found_match eq "yes")
    { &add_contact_information(@all_matches); }
  else
    { &write_query_no_match(); }

  print OUT_MAIN "<hr>\n";
  print OUT_MAIN "<A HREF=\"date.cgi\"><IMG BORDER=0 SRC=\"home.jpg\"></A>\n";
  print OUT_MAIN "<A HREF=\"date.cgi?page_type=TOP_QUERY\"><IMG BORDER=0 SRC=\"query.jpg\"></A>\n";
  print OUT_MAIN "<A HREF=\"date.cgi?page_type=TOP_ADD\"><IMG BORDER=0 SRC=\"add.jpg\"></A>\n";
  print OUT_MAIN "<A HREF=\"date.cgi?page_type=TOP_NUKE\"><IMG BORDER=0 SRC=\"delete.jpg\"></A>\n";

  print OUT_MAIN "</BODY></HTML>\n";
  }
}

# ____________________________________________________________________

sub query_check
{
local ($db_line) = @_;
local $i = 0;
local $outcome = "match";
local $matching_nickname = "";

if ( $db_line =~ /^ *#/ )                    # ignore comment lines
  { $outcome = "no match"; }
else
  {
  @tokens = split(/`/, $db_line);           # use ' as field delimeter
  foreach $field (@field_name)
    { $db{$field} = @tokens[$i]; ++$i; }

  if ( $searcher{sport} ne "" )
    {
    if ( $db{sport} !~ /$searcher{sport}/ )
      { $outcome = "no match"; }
    }

  if ( ($searcher{want_level_min} > $db{level}) ||
       ($searcher{want_level_max} < $db{level}) )
    { $outcome = "no match"; }

  if ( ($searcher{want_age_min} > $db{age}) ||
       ($searcher{want_age_max} < $db{age}) )
    { $outcome = "no match"; }

  if ( $searcher{want_sex} ne "either" )
    {
    if ( $searcher{want_sex} ne $db{sex} )
      { $outcome = "no match"; }
    }

  if ( $searcher{city} ne "" )
    {
    if ( $db{city} !~ /$searcher{city}/ )
      { $outcome = "no match"; }
    }

  if ( $searcher{state} ne "" )
    {
    if ( $db{state} !~ /$searcher{state}/ )
      { $outcome = "no match"; }
    }
  }

if ($outcome eq "match")
  { $matching_nickname = $db{nickname};}

$matching_nickname;
}


# ____________________________________________________________________

sub write_query_match

{
print OUT_MAIN "<H2>$db{nickname}</H2>\n";
print OUT_MAIN "<B>$db{nickname}</B> is a $db{age} year old \n";
if ($db{sex} eq "male")
  { print OUT_MAIN "male \n"; }
else
  { print OUT_MAIN "female \n"; }
print OUT_MAIN "from $db{city}, $db{state}. $db{nickname} has achieved \n";
print OUT_MAIN "skill level $db{level} in $db{sport}, and would like to \n";
print OUT_MAIN "meet a \n";
if ($db{want_sex} eq "male")
  { print OUT_MAIN "male \n"; }
elsif ($db{want_sex} eq "female")
  { print OUT_MAIN "female \n"; }
else
  { print OUT_MAIN "male or female \n"; }
print OUT_MAIN "between the ages of $db{want_age_min} and \n";
print OUT_MAIN "$db{want_age_max} with a skill level between \n";
print OUT_MAIN "$db{want_level_min} and $db{want_level_max}. \n";
print OUT_MAIN "Here is a personal greeting from $db{nickname}: \n";
print OUT_MAIN "<I>$db{greeting}</I>\n";
}

# ____________________________________________________________________

sub add_contact_information
{

local (@all_nicknames) = @_;
local $all_length = @all_nicknames;
local $i;

print OUT_MAIN "<P><HR><H1>Contact One Of The Above People</H1>\n";
print OUT_MAIN "Fill out the information below, and click on <I>ok</I>. \n";
print OUT_MAIN "An email message will then be sent to the person you \n";
print OUT_MAIN "selected.  This message will contain your email address \n";
print OUT_MAIN "from the <I><B>Sports Date </I></B> database. \n";
print OUT_MAIN "You must already be registered in the <I><B>Sports Date </I></B>\n";
print OUT_MAIN "database before you can contact another <I><B>Sports Date </I></B>member.\n";

print OUT_MAIN "<form method=GET action=http://www.eskimo.com/~douglas/cgi-bin/date.cgi>\n";

print OUT_MAIN "<input type=hidden name=page_type value=SEND_EMAIL>\n";

print OUT_MAIN "<p>\n";
print OUT_MAIN "nickname of person you wish to contact: ";
print OUT_MAIN "<select name=nickname_target>";
for ($i = 0; $i < $all_length; ++$i)
  { print OUT_MAIN "<option value=\"$all_nicknames[$i]\">$all_nicknames[$i] "; }
print OUT_MAIN "</select>\n";

print OUT_MAIN "<p>\n";
print OUT_MAIN "nickname: ";
print OUT_MAIN "<input type=text name=nickname size=20>\n";
print OUT_MAIN "(your nickname, as registered in the Sports Date database)\n";

print OUT_MAIN "<p>\n";
print OUT_MAIN "email: ";
print OUT_MAIN "<input type=text name=email size=20>\n";
print OUT_MAIN "(your email address, as registered in the Sports Date database)\n";

print OUT_MAIN "<br>\n";
print OUT_MAIN "<input type=submit name=decision value=ok onClick=\"return check_it(this.form)\">\n";
print OUT_MAIN "<input type=submit name=decision value=cancel>\n";

print OUT_MAIN "</form>\n";
}

# ____________________________________________________________________

sub write_query_no_match
{

print OUT_MAIN "<H1>No Matches Found</H1>\n";
print OUT_MAIN "There were no matches in the current <I><B>Sports Date</I></B> \n";
print OUT_MAIN "database that matched these parameters:\n";
print OUT_MAIN "<UL>\n";

if ( $searcher{sport} ne "" )
  {
  if ( $db{sport} !~ /$searcher{sport}/ )
    { print OUT_MAIN "<LI>sport = $searcher{sport}</LI>\n"; }
  }

print OUT_MAIN "<LI>minimum skill level = $searcher{want_level_min}</LI>\n";
print OUT_MAIN "<LI>maximum skill level = $searcher{want_level_max}</LI>\n";
print OUT_MAIN "<LI>minimum age = $searcher{want_age_min}</LI>\n";
print OUT_MAIN "<LI>maximum age = $searcher{want_age_max}</LI>\n";

if ( $searcher{want_sex} eq "male" )
  { print OUT_MAIN "<LI>desired sex = male</LI>\n"; }
elsif ( $searcher{want_sex} eq "female" )
  { print OUT_MAIN "<LI>desired sex = female</LI>\n"; }
else
  { print OUT_MAIN "<LI>desired sex = male or female</LI>\n"; }

if ( $searcher{city} ne "" )
  { print OUT_MAIN "<LI>city = $searcher{city}</LI>\n"; }

if ( $searcher{state} ne "" )
  { print OUT_MAIN "<LI>state = $searcher{state}</LI>\n"; }
}

# ____________________________________________________________________

sub email_to_nickname

{
local $outcome;

if ($INPUT_DATA{decision} ne "ok")
  { &create_top(); }
else
  {
  $outcome = &validate_user();
  if ($outcome eq "ok")
    { &send_query_email(); }
  else
    { &send_query_reject(); }
  }
}

# ____________________________________________________________________
#
# See if the user's nickname and email address appear in the database.

sub validate_user
{
local $outcome = "err";
local $i = 0;
local $user_nickname;
local $user_email;
local @tokens;

# I'm going to use java script to pre-validate fields, so lets assume 
# everything is cool by the time it gets to us.

$user_nickname = $INPUT_DATA{nickname};
$user_email = $INPUT_DATA{email};

open (DB_FILE, "$dat_file") ||
    &fatal_error("validate_user", "failed to open $dat_file");
#while ( (<DB_FILE>) && ($outcome eq "err") )
while (<DB_FILE>)
  {
  if ( $db_line =~ /^ *#/ )            # ignore comment lines
    { next; }
  @tokens = split(/`/, $_);           # use ' as field delimeter
  $i = 0;
  foreach $field (@field_name)
    { $db{$field} = @tokens[$i]; ++$i; }

  if ( ($user_nickname eq $db{nickname}) && ($user_email eq $db{email}) )
    {
    $outcome = "ok";
    last;
    }
  }
close DB_FILE;

$outcome;
}

# ____________________________________________________________________

sub send_query_email

{

local ($title="<TITLE>sports date email sent</TITLE>");
local $target_nickname = $INPUT_DATA{nickname_target};
local $user_nickname = $INPUT_DATA{nickname};
local $user_email = $INPUT_DATA{email};
local $target_email = &find_target_email($target_nickname);

print OUT_MAIN "Content-type: text/html\n";
print OUT_MAIN "\n";
print OUT_MAIN "<HTML>\n<HEAD>\n$content_type\n$author\n$title\n</HEAD>\n";
print OUT_MAIN "<BODY>\n";
print OUT_MAIN "Since this is a demo program, no email will actually be sent.\n";
print OUT_MAIN "However, this is a summary of what the email would look like:\n";

print OUT_MAIN "<P>\n";
print OUT_MAIN "<TABLE BORDER>\n";
print OUT_MAIN "<TR>\n";
print OUT_MAIN "<TD>TO</TD>\n";
print OUT_MAIN "<TD>$target_email</TD>\n";
print OUT_MAIN "</TR>\n";
print OUT_MAIN "\n";
print OUT_MAIN "<TR>\n";
print OUT_MAIN "<TD>SUBJECT</TD>\n";
print OUT_MAIN "<TD>sports date reply for $target_nickname</TD>\n";
print OUT_MAIN "</TR>\n";
print OUT_MAIN "\n";
print OUT_MAIN "<TR>\n";
print OUT_MAIN "<TD>BODY</TD>\n";
print OUT_MAIN "<TD>Hi $target_nickname.\n";
print OUT_MAIN "<P> $user_nickname would like to set up a sports date with you. \n";
print OUT_MAIN "You can contact $user_nickname by sending email to \n";
print OUT_MAIN "$user_email \n";
print OUT_MAIN "<P>This email was automatically generated by the sports date web page.\n";
print OUT_MAIN "</TD>\n";
print OUT_MAIN "</TR>\n";
print OUT_MAIN "</TABLE>\n";

print OUT_MAIN "<hr>\n";
print OUT_MAIN "<A HREF=\"date.cgi\"><IMG BORDER=0 SRC=\"home.jpg\"></A>\n";
print OUT_MAIN "<A HREF=\"date.cgi?page_type=TOP_QUERY\"><IMG BORDER=0 SRC=\"query.jpg\"></A>\n";
print OUT_MAIN "<A HREF=\"date.cgi?page_type=TOP_ADD\"><IMG BORDER=0 SRC=\"add.jpg\"></A>\n";
print OUT_MAIN "<A HREF=\"date.cgi?page_type=TOP_NUKE\"><IMG BORDER=0 SRC=\"delete.jpg\"></A>\n";

print OUT_MAIN "</BODY>\n";
print OUT_MAIN "</HTML>\n";
}

# ____________________________________________________________________

sub find_target_email

{
local ($user_nickname) = @_;
local $user_email = "";
local @tokens;

open (DB_FILE, "$dat_file") ||
    &fatal_error("find_target_email", "failed to open $dat_file");
while (<DB_FILE>)
  {
  if ( /^ *#/ )           # ignore comment lines
    { next; }
  @tokens = split(/`/, $_);           # use ' as field delimeter
  $i = 0;
  foreach $field (@field_name)
    { $db{$field} = @tokens[$i]; ++$i; }

  if ($user_nickname eq $db{nickname})
    {
    $user_email = $db{email};
    last;
    }
  }
close DB_FILE;

if ($user_email eq "")
    { &fatal_error("find_target_email", "failed to find $user_nickname"); }

$user_email;
}

# ____________________________________________________________________

sub send_query_reject

{

local ($title="<TITLE>sports date query reject</TITLE>");
local $user_nickname = $INPUT_DATA{nickname};

print OUT_MAIN "Content-type: text/html\n";
print OUT_MAIN "\n";
print OUT_MAIN "<HTML>\n<HEAD>\n$content_type\n$author\n$title\n</HEAD>\n";
print OUT_MAIN "<BODY>\n";
print OUT_MAIN "Your request can not be processed. Your nickname and email address must first \n";
print OUT_MAIN "be registered with the sports date web page.\n";

print OUT_MAIN "<hr>\n";
print OUT_MAIN "<A HREF=\"date.cgi\"><IMG BORDER=0 SRC=\"home.jpg\"></A>\n";
print OUT_MAIN "<A HREF=\"date.cgi?page_type=TOP_QUERY\"><IMG BORDER=0 SRC=\"query.jpg\"></A>\n";
print OUT_MAIN "<A HREF=\"date.cgi?page_type=TOP_ADD\"><IMG BORDER=0 SRC=\"add.jpg\"></A>\n";
print OUT_MAIN "<A HREF=\"date.cgi?page_type=TOP_NUKE\"><IMG BORDER=0 SRC=\"delete.jpg\"></A>\n";

print OUT_MAIN "</BODY>\n";
print OUT_MAIN "</HTML>\n";
}

# ____________________________________________________________________

sub create_add_form

{
local ($title="<TITLE>sports date registration</TITLE>");

print OUT_MAIN "Content-type: text/html\n";
print OUT_MAIN "\n";
print OUT_MAIN "<HTML>\n<HEAD>\n$content_type\n$author\n$title\n\n";

# add JavaScript error checking

print OUT_MAIN "<SCRIPT LANGUAGE=\"JavaScript\">\n";
# print OUT_MAIN "<!--hiding from old browsers\n";
print OUT_MAIN "function check_it(form)\n";
print OUT_MAIN "{\n";
print OUT_MAIN "var msg = \"\";\n";

print OUT_MAIN "if (form.nickname.value == \"\")\n";
print OUT_MAIN "  msg = msg + \"You must invent a nickname for yourself.\\n\";\n";

#print OUT_MAIN "if (form.age.value == \"\")\n";
#print OUT_MAIN "  msg = msg + \"You must include your age.\\n\";\n";

print OUT_MAIN "if (form.email.value == \"\")\n";
print OUT_MAIN "  msg = msg + \"You must include your email address.\\n\";\n";

print OUT_MAIN "if (form.sport.value == \"\")\n";
print OUT_MAIN "  msg = msg + \"You must specify which sport you want.\\n\";\n";

print OUT_MAIN "if (form.city.value == \"\")\n";
print OUT_MAIN "  msg = msg + \"You must specify the name of your city.\\n\";\n";

print OUT_MAIN "if (form.state.value == \"\")\n";
print OUT_MAIN "  msg = msg + \"You must specify the name of your state.\\n\";\n";

print OUT_MAIN "if (msg != \"\")\n";
print OUT_MAIN "  {\n";
print OUT_MAIN "  alert(msg);\n";
print OUT_MAIN "  return false;\n";
print OUT_MAIN "  }\n";
print OUT_MAIN "}\n";
# print OUT_MAIN "//--done hiding>\n";
print OUT_MAIN "</SCRIPT>\n";
print OUT_MAIN "</HEAD>\n";

print OUT_MAIN "<BODY>\n";

print OUT_MAIN "<H1>Add Yourself To The Sports Date Database</H1>\n";
print OUT_MAIN "<p>To add yourself to the <B><I>Sports Date</B></I> \n";
print OUT_MAIN "database, fill out the information below, and click on ok. \n";
print OUT_MAIN "If you are interested in several different sports, you \n";
print OUT_MAIN "will have to register once for each sport.  Each entry in \n";
print OUT_MAIN "the database must have a unique combination of \n";
print OUT_MAIN "<I>nickname</I> and <I>email address</I>.  So, if you want \n";
print OUT_MAIN "to register for several different sports, use a slightly \n";
print OUT_MAIN "different nickname for each registration.  Your email \n";
print OUT_MAIN "address will only be given to people who you specifically \n";
print OUT_MAIN "ask to contact.\n";

print OUT_MAIN "<form method=GET action=http://www.eskimo.com/~douglas/cgi-bin/date.cgi>\n";

print OUT_MAIN "<input type=hidden name=page_type value=ADD_ME>\n";

print OUT_MAIN "<p>\n";
print OUT_MAIN "invent a nickname for yourself: ";
print OUT_MAIN "<input type=text name=nickname size=20>\n";
print OUT_MAIN "(do NOT use your actual name)\n";

print OUT_MAIN "<br>\n";
print OUT_MAIN "your age: ";
print OUT_MAIN "<input type=text name=age size=2>\n";

print OUT_MAIN "<br>\n";
print OUT_MAIN "your sex: ";
print OUT_MAIN "<select name=sex>";
$array_length = @sexual_preference;
for ($i = 0; $i < $array_length; ++$i)
  { 
  if (@sexual_preference[$i] ne "either")
    { print OUT_MAIN "<option value=@sexual_preference[$i]>@sexual_preference[$i] "; }
  }
print OUT_MAIN "</select>\n";

print OUT_MAIN "<br>\n";
print OUT_MAIN "your email address: ";
print OUT_MAIN "<input type=text name=email size=20>\n";

print OUT_MAIN "<br>\n";
print OUT_MAIN "name of sport: ";
print OUT_MAIN "<input type=text name=sport size=20>\n";
print OUT_MAIN "(do a different registrtion for different sports)\n";

print OUT_MAIN "<br>\n";
print OUT_MAIN "your current skill level: ";
print OUT_MAIN "<select name=level>";
for ($i = 0; $i <= 10; ++$i)
  { print OUT_MAIN "<option value=$i>$i "; }
print OUT_MAIN "</select>\n";
print OUT_MAIN "(0=beginner, 10=expert)\n";

print OUT_MAIN "<br>\n";
print OUT_MAIN "sexual preference: ";
print OUT_MAIN "<select name=want_sex>";
$array_length = @sexual_preference;
for ($i = 0; $i < $array_length; ++$i)
  { print OUT_MAIN "<option value=@sexual_preference[$i]>@sexual_preference[$i] "; }
print OUT_MAIN "</select>\n";

print OUT_MAIN "<br>\n";
print OUT_MAIN "your partner's minimum skill level: ";
print OUT_MAIN "<select name=want_level_min>";
for ($i = 0; $i <= 10; ++$i)
  { print OUT_MAIN "<option value=$i>$i "; }
print OUT_MAIN "</select>\n";
print OUT_MAIN "(the minimum skill level of interest; 0=beginner)\n";

print OUT_MAIN "<br>\n";
print OUT_MAIN "your partner's maximum skill level: ";
print OUT_MAIN "<select name=want_level_max>";
for ($i = 0; $i < 10; ++$i)
  { print OUT_MAIN "<option value=$i>$i "; }
print OUT_MAIN "<option value=10 selected>10 ";
print OUT_MAIN "</select>\n";
print OUT_MAIN "(the maximum skill level of interest; 10=expert)\n";

print OUT_MAIN "<br>\n";
print OUT_MAIN "your partner's minimum age: ";
print OUT_MAIN "<select name=want_age_min>";
print OUT_MAIN "<option value=15 selected>15 ";
for ($i = 20; $i <= 85; $i = $i + 5)
  { print OUT_MAIN "<option value=$i>$i "; }
print OUT_MAIN "</select>\n";
print OUT_MAIN "(your sports partner should be at least this old)\n";

print OUT_MAIN "<br>\n";
print OUT_MAIN "your partner's maximum age: ";
print OUT_MAIN "<select name=want_age_max>";
for ($i = 15; $i < 85; $i = $i + 5)
  { print OUT_MAIN "<option value=$i>$i "; }
print OUT_MAIN "<option value=85 selected>85 ";
print OUT_MAIN "</select>\n";
print OUT_MAIN "(your sports partner should not be older than this)\n";

print OUT_MAIN "<br>\n";
print OUT_MAIN "your city: ";
print OUT_MAIN "<input type=text name=city size=30>\n";

print OUT_MAIN "<br>\n";
print OUT_MAIN "your state: ";
print OUT_MAIN "<input type=text name=state size=3 maxlength=2>\n";

print OUT_MAIN "<br>\n";
print OUT_MAIN "your personal greeting (optional): ";
print OUT_MAIN "<textarea name=greeting cols=40 rows=4>\n";
print OUT_MAIN "</textarea>\n";

print OUT_MAIN "<br>\n";
print OUT_MAIN "<input type=submit name=decision value=ok onClick=\"return check_it(this.form)\">\n";
print OUT_MAIN "<input type=submit name=decision value=cancel>\n";

print OUT_MAIN "</form>\n";

print OUT_MAIN "</BODY>\n";
print OUT_MAIN "</HTML>\n";

print OUT_MAIN "</form>\n";
}

# ____________________________________________________________________

sub add_new_user

{
local $field;

if ($INPUT_DATA{decision} ne "ok")
  { &create_top(); }
else
  {
  if ( &check_duplicate_user($INPUT_DATA{nickname}, $INPUT_DATA{email}) 
    eq "duplicate" )
    { &return_duplicate_msg($INPUT_DATA{nickname}, $INPUT_DATA{email}); }
  else
    {
    open (DB_FILE, ">>$dat_file") ||
        &fatal_error("add_new_user", "failed to open $dat_file");

    # make the personal greeting one long string

    $INPUT_DATA{greeting} =~ s/\r//g;
    $INPUT_DATA{greeting} =~ s/\n/ /g;

    foreach $field (@field_name)
      { print DB_FILE "$INPUT_DATA{$field}`"; }
    print DB_FILE "\n";
    close DB_FILE;
    &return_added_msg($INPUT_DATA{nickname});
    }
  }
}

# ____________________________________________________________________

sub check_duplicate_user

{
local ($nick_name, $email_address) = @_;
local $outcome = "no dups";
local $i = 0;
local @tokens;

open (DB_FILE, "$dat_file") ||
    &fatal_error("check_duplicate_user", "failed to open $dat_file");
while (<DB_FILE>)
  {
  if ( $db_line =~ /^ *#/ )            # ignore comment lines
    { next; }
  @tokens = split(/`/, $_);            # use ' as field delimeter
  $i = 0;
  foreach $field (@field_name)
    {
    $db{$field} = @tokens[$i];
    ++$i;
    }

  if ( ($nick_name eq $db{nickname}) &&
       ($email_address eq $db{email}) )
    {
    $outcome = "duplicate";
    last;
    };
  }
close DB_FILE;

$outcome;
}

# ____________________________________________________________________

sub return_duplicate_msg

{
local ($title="<TITLE>sports date duplicate user</TITLE>");
local ($nick_name, $email_address) = @_;

print OUT_MAIN "Content-type: text/html\n";
print OUT_MAIN "\n";
print OUT_MAIN "<HTML>\n<HEAD>\n$content_type\n$author\n$title\n</HEAD>\n";
print OUT_MAIN "<BODY>\n";
print OUT_MAIN "The combination of nickname $nick_name and email address \n";
print OUT_MAIN "$email_address already exists in the sports date database. \n";
print OUT_MAIN "Please try again.\n";

print OUT_MAIN "<hr>\n";
print OUT_MAIN "<A HREF=\"date.cgi\"><IMG BORDER=0 SRC=\"home.jpg\"></A>\n";
print OUT_MAIN "<A HREF=\"date.cgi?page_type=TOP_QUERY\"><IMG BORDER=0 SRC=\"query.jpg\"></A>\n";
print OUT_MAIN "<A HREF=\"date.cgi?page_type=TOP_ADD\"><IMG BORDER=0 SRC=\"add.jpg\"></A>\n";
print OUT_MAIN "<A HREF=\"date.cgi?page_type=TOP_NUKE\"><IMG BORDER=0 SRC=\"delete.jpg\"></A>\n";

print OUT_MAIN "</BODY>\n";
print OUT_MAIN "</HTML>\n";
}

# ____________________________________________________________________

sub return_added_msg

{
local ($nick_name) = @_;
local ($title="<TITLE>sports date user added</TITLE>");

print OUT_MAIN "Content-type: text/html\n";
print OUT_MAIN "\n";
print OUT_MAIN "<HTML>\n<HEAD>\n$content_type\n$author\n$title\n</HEAD>\n";
print OUT_MAIN "<BODY>\n";
print OUT_MAIN "$nick_name has been added to the sports date database.\n";

print OUT_MAIN "<hr>\n";
print OUT_MAIN "<A HREF=\"date.cgi\"><IMG BORDER=0 SRC=\"home.jpg\"></A>\n";
print OUT_MAIN "<A HREF=\"date.cgi?page_type=TOP_QUERY\"><IMG BORDER=0 SRC=\"query.jpg\"></A>\n";
print OUT_MAIN "<A HREF=\"date.cgi?page_type=TOP_ADD\"><IMG BORDER=0 SRC=\"add.jpg\"></A>\n";
print OUT_MAIN "<A HREF=\"date.cgi?page_type=TOP_NUKE\"><IMG BORDER=0 SRC=\"delete.jpg\"></A>\n";

print OUT_MAIN "</BODY>\n";
print OUT_MAIN "</HTML>\n";
}

# ____________________________________________________________________

sub create_nuke_form

{
local ($title="<TITLE>sports date delte user</TITLE>");

print OUT_MAIN "Content-type: text/html\n";
print OUT_MAIN "\n";
print OUT_MAIN "<HTML>\n<HEAD>\n$content_type\n$author\n$title\n\n";

# add JavaScript error checking

print OUT_MAIN "<SCRIPT LANGUAGE=\"JavaScript\">\n";
# print OUT_MAIN "<!--hiding from old browsers\n";
print OUT_MAIN "function check_it(form)\n";
print OUT_MAIN "{\n";
print OUT_MAIN "var msg = \"\";\n";

print OUT_MAIN "if (form.nickname.value == \"\")\n";
print OUT_MAIN "  msg = msg + \"You must include your nickname.\\n\";\n";

print OUT_MAIN "if (form.email.value == \"\")\n";
print OUT_MAIN "  msg = msg + \"You must include your email address.\\n\";\n";

print OUT_MAIN "if (msg != \"\")\n";
print OUT_MAIN "  {\n";
print OUT_MAIN "  alert(msg);\n";
print OUT_MAIN "  return false;\n";
print OUT_MAIN "  }\n";
print OUT_MAIN "}\n";
# print OUT_MAIN "//--done hiding>\n";
print OUT_MAIN "</SCRIPT>\n";
print OUT_MAIN "</HEAD>\n";

print OUT_MAIN "<BODY>\n";

print OUT_MAIN "<H1>Delete Yourself From The Database</H1>\n";

print OUT_MAIN "<p>To delete yourself from the <B><I>Sports Date</I></B> \n";
print OUT_MAIN "database, fill out the fields below and click <I>ok</I>. \n";
print OUT_MAIN "If you are registered more than once, you must fill out \n";
print OUT_MAIN "this form once for each registration in order to \n";
print OUT_MAIN "completely remove yourself from the database.\n";

print OUT_MAIN "<form method=GET action=http://www.eskimo.com/~douglas/cgi-bin/date.cgi>\n";

print OUT_MAIN "<input type=hidden name=page_type value=NUKE_ME>\n";

print OUT_MAIN "<p>\n";
print OUT_MAIN "your nickname: ";
print OUT_MAIN "<input type=email name=nickname size=20>\n";

print OUT_MAIN "<p>\n";
print OUT_MAIN "your email address: ";
print OUT_MAIN "<input type=email name=email size=20>\n";

print OUT_MAIN "<br>\n";
print OUT_MAIN "<input type=submit name=decision value=ok onClick=\"return check_it(this.form)\">\n";
print OUT_MAIN "<input type=submit name=decision value=cancel>\n";

print OUT_MAIN "</form>\n";

print OUT_MAIN "</BODY>\n";
print OUT_MAIN "</HTML>\n";
}

# ____________________________________________________________________

sub nuke_old_user

{
local $outcome;
local $i = 0;
local $j = 0;
local $max;
local $user_nickname = $INPUT_DATA{nickname};

if ($INPUT_DATA{decision} ne "ok")
  { &create_top(); }
else
  {
  $outcome = &validate_user();
  if ($outcome ne "ok")
    { &send_nuke_reject($user_nickname); }
  else
    { 
    open (DB_FILE, "$dat_file") ||
        &fatal_error("nuke_old_user", "failed to open $dat_file for read");
    while (<DB_FILE>)
      {
        if ( $_ =~ /^ *#/ )           # keep any comment lines
        {
        @tmp[$i] = $_;
        ++$i;
        next;
        }
      @tokens = split(/`/, $_);           # use ' as field delimeter
      $j = 0;
      foreach $field (@field_name)
        { $db{$field} = @tokens[$j]; ++$j; }
      
      if ( ($INPUT_DATA{nickname} ne $db{nickname}) ||
           ($INPUT_DATA{email} ne $db{email}) )
        {
        @tmp[$i] = $_;
        ++$i;
        }
      }
    close DB_FILE;
  
    unlink ("$dat_file") ||
        &fatal_error("nuke_old_user", "failed to remove $dat_file");

    open (DB_FILE, ">$dat_file") ||
        &fatal_error("nuke_old_user", "failed to open $dat_file for write");

    $max = $i;
    for ($i = 0; $i < $max; ++$i)
      {
      print DB_FILE "$tmp[$i]";
      }
    close DB_FILE;
  
    &send_nuke_ok($user_nickname);
    }
  }
}

# ____________________________________________________________________

sub send_nuke_ok

{
local ($nick_name) = @_;
local ($title="<TITLE>sports date user removed</TITLE>");

print OUT_MAIN "Content-type: text/html\n";
print OUT_MAIN "\n";
print OUT_MAIN "<HTML>\n<HEAD>\n$content_type\n$author\n$title\n</HEAD>\n";
print OUT_MAIN "<BODY>\n";
print OUT_MAIN "$nick_name has been removed from the sports date database.\n";

print OUT_MAIN "<hr>\n";
print OUT_MAIN "<A HREF=\"date.cgi\"><IMG BORDER=0 SRC=\"home.jpg\"></A>\n";
print OUT_MAIN "<A HREF=\"date.cgi?page_type=TOP_QUERY\"><IMG BORDER=0 SRC=\"query.jpg\"></A>\n";
print OUT_MAIN "<A HREF=\"date.cgi?page_type=TOP_ADD\"><IMG BORDER=0 SRC=\"add.jpg\"></A>\n";
print OUT_MAIN "<A HREF=\"date.cgi?page_type=TOP_NUKE\"><IMG BORDER=0 SRC=\"delete.jpg\"></A>\n";

print OUT_MAIN "</BODY>\n";
print OUT_MAIN "</HTML>\n";
}

# ____________________________________________________________________

sub send_nuke_reject

{
local ($nick_name) = @_;
local ($title="<TITLE>sports date user not removed</TITLE>");

print OUT_MAIN "Content-type: text/html\n";
print OUT_MAIN "\n";
print OUT_MAIN "<HTML>\n<HEAD>\n$content_type\n$author\n$title\n</HEAD>\n";
print OUT_MAIN "<BODY>\n";
print OUT_MAIN "$nick_name was not removed from the sports date database.\n";
print OUT_MAIN "Both the nickname and email address must pre-exist \n";
print OUT_MAIN "in the sports date database\n";

print OUT_MAIN "<hr>\n";
print OUT_MAIN "<A HREF=\"date.cgi\"><IMG BORDER=0 SRC=\"home.jpg\"></A>\n";
print OUT_MAIN "<A HREF=\"date.cgi?page_type=TOP_QUERY\"><IMG BORDER=0 SRC=\"query.jpg\"></A>\n";
print OUT_MAIN "<A HREF=\"date.cgi?page_type=TOP_ADD\"><IMG BORDER=0 SRC=\"add.jpg\"></A>\n";
print OUT_MAIN "<A HREF=\"date.cgi?page_type=TOP_NUKE\"><IMG BORDER=0 SRC=\"delete.jpg\"></A>\n";

print OUT_MAIN "</BODY>\n";
print OUT_MAIN "</HTML>\n";
}

# ____________________________________________________________________

sub fatal_error

{
local ($function_name, $error_message) = @_;

print "Content-type: text/html\n";
print "\n";
print "<HTML><HEAD><TITLE>fatal error</TITLE></HEAD>\n";
print "<BODY>\n";
print "fatal error encountered<BR>\n";
print "function_name = $function_name<BR>\n";
print "error_message = $error_message<BR>\n";
print "send flames to douglas\@eskimo.com<BR>\n";
print "</BODY></HTML>\n";
if ( -e $out_file )
    {
    unlink $out_file;
    }
exit 1;
}