#! /usr/local/bin/perl
#############################################################################
#
#   File: cyberpals.pl
#
#   Author:  Paul Coddington
#
#   Version: 0.2
#
#   Date: December 9, 1995
#
#   Input: CGI input ('QUERY_STRING')
#          QUERY_STRING: filename (HIDDEN)
#                        name, sex, age, town, state, country,
#                        email, homepage, entry
#
#   Output: Output: Form for entering personal ad.
#
#
#############################################################################
#
#   MAIN FUNCTION
#
#############################################################################

%in = ();
&ParseArg(*in);                 # parse arguments passed by http server
&UpdateFile();


#############################################################################
#  
#   SUBROUTINES
#
#############################################################################


sub UpdateFile {          

  $name = $in{'name'};
  $age = $in{'age'};
  $sex = $in{'sex'};
  $town = $in{'town'};
  $state = $in{'state'};
  $country = $in{'country'};
  $email = $in{'email'};
  $homepage = $in{'homepage'};
  $entry = $in{'entry'};
  $filename = $in{'filename'};
  $database = $in{'database'};
  
# $filename = "/home/K4/empireweb/public_html/studentcenter/college-list.html";
# $database = "/home/K4/empireweb/public_html/studentcenter/college-list.data";

#
# Do an "in place" edit to update the database file
#
  $^I = "~"; 
  @ARGV = ($database);
  $first = 1;
  while (<>) {    
    if ($first) {
      $first = 0;
      print "name: $name\n";
      print "age: $age\n";
      print "sex: $sex\n";
      print "town: $town\n";
      print "state: $state\n";
      print "country: $country\n";
      print "email: $email\n";
      print "homepage: $homepage\n";
      print "entry: $entry\n";
      print "\n";
    }
    print;
  }

  if (!open(FILE, $filename) ) {
	&PrintHeader;
 	print "cannot open $filename";
 	return 0;
  }
  close(FILE);

#
# Do an "in place" edit on the answers file, i.e. copy $filename
# to $filename~ and create a new $filename with the answer appended
#
  $^I = "~"; 
  @ARGV = ($filename);
  $found = 0;
  while (<>) {    
    if (/<DL>/) {  # beginning of list of answers
      print;
      &Append;
      $found = 1;
    }
    else {
      if ((/ENDLIST/) && !($found)) {  # This is the first post
        print "<DL>\n";
        &Append;
        print "</DL>\n";
      }
      else { 
        print;
      }
    }
  }

  &PrintHeader;
  if (!open(FILE, $filename) ) {
	&PrintHeader;
 	print "cannot open $filename";
 	return 0;
  }
  while (<FILE>) {    
    print;
  }
  close(FILE);
  
  return 1;

}



sub Append {

  # Add the new entry to the file 
  print "<P>\n";
  print "<DT>\n From <B>";
  if ($homepage eq "") {
     print "$name ";
  } 
  else {
     print "<A HREF=\"$homepage\">$name</A> ";
  } 
  if ($email eq "") {
     print "(<i>$email</i>) ";
  } 
  else {
     print "(<A HREF=\"mailto:$email\"><i>$email</i></A>) ";
  } 
  print "</B>\n";
  print "$sex age $age \n";
  print "from $town $state $country \n";
  $date = `date '+at %H:%M:%S on %m/%d/%y'`;
  chop $date;
  print " $date: \n";
  print "<P>\n";
  print "<DD>\n $entry \n";
  print "<P><HR WIDTH=50% SIZE=5 ALIGN=CENTER> \n";
}



##########################################################################

# Standard CGI interface stuff

sub PrintHeader {                      # Print out the Header for HTML
  print "Content-type: text/html\n\n";
  print "\n";
}


sub ParseArg {                        # reads the passed arguments
    local ($i, $loc, $key, $val);
    local (*in) = @_;

    if ($ENV{'REQUEST_METHOD'} eq "GET") {                      # Read in text
       $in = $ENV{'QUERY_STRING'};
    } elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
      for ($i = 0; $i < $ENV{'CONTENT_LENGTH'}; $i++) {
        $in .=getc;
      }
    }

    @in = split(/&/,$in);

    foreach $i (0 .. $#in) {
      $in[$i] =~ s/\+/ /g;                          # Convert plus's to spaces
      $in[$i] =~ s/%(..)/pack("c",hex($1))/ge;
                                # Convert %XX from hex numbers to alphanumeric
      $loc = index($in[$i], "=");                  # Split onto key and value.
      $key = substr($in[$i],0,$loc);
      $val = substr($in[$i],$loc+1);
      $in{$key} .= '\0' if (defined($in{$key})); # \0 is the multiple separator
      $in{$key} .= $val;
   }
}
1;



