#!/usr/bin/perl 

$VERSION="v0.9.7.1";

package Server;

require"site_config.pl";

chdir($SERVER_DIR);
#chdir("/web/mitbdt/www/openimpetus");

require 5.002;
require"ctime.pl";
require"server_stats.pl";

$DB::profile=0;
$DB::drop_zeros=1;

BEGIN {$ENV{PATH}='/usr/ucb:/bin'}
use Socket;
# use Carp;
use FileHandle;
# use strict;

#use lib "/web/mitbdt/www/openimpetus";
use lib $SERVER_LIB;

use Competitor;
use Constants;
use Couple;
use Dance;
use Error;
use General;
use Hashtable;
use Mail;
use MultiDance;
use Number;
use SingleDance;
use Vector;

# Dispatch codes
# 00 hello server
#
# 01 addCouple($coup, $school, $dance)
# 02 addCoupleToDance($dance, $coup)
# 03 addCoupleToSchools($coup)
# 04 removeCouple($coup)
# 05 removeCoupleFromDance($dance, $coup)
# 
# 10 getCompetitorsBySchool
# 11 getFollowers
# 12 getLeaders
# 13 getNumberOfCompetitors
# 14 getNumberOfCouplesInDance
# 15 getDancesByCouple
# 16 getEmailAddresses
# 17 getNameSortedCompetitors
# 18 getNameSortedCompetitorsBySchool
# 19 getNameSortedCouples
# 20 getNumberSortedCouples
# 21 getNameSortedCouplesByDance
# 22 getNumberSortedCouplesByDance
# 23 getSchools
# 24 getSortedSchools
# 25 isLeader
# 26 isFollower
#
# 90 do_stats
# 91 scrub_db
# 92 loadComp
# 93 destroyComp
# 97 close client
# 98 write logfile and exit
# 99 exit immediately
#
#     non-public
# sanity_check
# is_db_open
# loadDB
# openDBLogfile
# closeDBLogfile


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

$|=1;

local ($Server::debug=1);
my $log="/tmp/.openimpetus_server_log";

my %MASTERCOMP; # key=comp dir name, value=array of references
my $COMP; # the dir name of the comp, and the key into %MASTERCOMP

# These are the Global(TM) variables that are used below.
# They are basically convenient global variables that make for faster
# access, since they're often used repeatedly in a routine.
# 
# Each value of %MASTERCOMP is an array of the following.
#
# IF YOU CHANGE THIS, YOU MUST ALSO MODIFY GET_GLOBALS() AND LOADDB().
my (@competitors, # Vector
    $by_dance,    # Hashtable: key=Dance, value=Vector(Couple)
    $by_school,   # Hashtable: key=String(school), value=Vector(Competitor)
    $by_couple,   # Hashtable: key=Couple, value=Vector(Dance)
    $by_leader,   # Hashtable: key=Competitor, value=Vector(Competitor)
    $by_follower, # Hashtable: key=Competitor, value=Vector(Competitor)
    $hundreds, $tens, $ones,
    @takenNumbers,
    $LOG, $db_open);

my ($coup, $school, $dance, $leader, $follower, $compname, $comp,
    $paddr, $get_new_client, $port, $proto, $iaddr, $name, $dispatch,
    $sender_address, $compname);

sub get_globals {
# IF YOU CHANGE THIS, YOU MUST ALSO MODIFY LOADDB().
  my $ref=$MASTERCOMP{$_[0]};
  my @thiscomp=@$ref;
  $ref=$thiscomp[0];
  @competitors=@$ref;
  $by_dance=$thiscomp[1];
  $by_school=$thiscomp[2];
  $by_couple=$thiscomp[3];
  $by_leader=$thiscomp[4];
  $by_follower=$thiscomp[5];
  $hundreds=$thiscomp[6];
  $tens=$thiscomp[7];
  $ones=$thiscomp[8];
  $ref=$thiscomp[9];
  @takenNumbers=@$ref;
  $LOG=$thiscomp[10];
  $db_open=$thiscomp[11];
}

# sub addCouple {
#   my ($coup, $school, $dance)=@_;
# 
#   &addCoupleToDance($dance, $coup);
#   &addCouple($coup);
#   &addCoupleToSchools($coup);
# }
# 
# sub addCouple2 {
#   my ($coup, $school, @dances)=@_;
# 
#   foreach $_ (@dances) {
#     &addCoupleToDance($_, $coup);
#   }
#   &addCouple($coup);
#   &addCoupleToSchools($coup);
# }

sub addCoupleToDance {
  my ($dance, $coup)=@_;
  my ($couples_ref, @vec, $couple, @dances, $i, $tba, $other,
      $conflict_exists, $dumb_bunny, $extra, $victim);

  $couples_ref=$by_dance->get($dance);
#logmsg("sizeof couples_ref: ",$#$couples_ref," for dance: ",
#       $dance->getFullName());
  if ($#$couples_ref>-1) {
    $conflict_exists=0;

# okay, here's the deal.
# We want to make sure that a request for a registration doesn't already
# conflict.
# But -- if someone has registered themselves with TBA, then we should
# silently delete the TBA entry and put the new one in.
#
# the dumb_bunny is the person who just tried to register; the victim is
# the person who is being attempted to double-registered with.  the extra
# is who the victim is originally registered with.
    for ($i=0;$i<=$#$couples_ref;$i++) {
      $couple=$$couples_ref[$i];
      if ($couple->containsCouple($coup)) {
	  if ($couple->getLeader()->equals($coup->getLeader())) {
	  next if $couple->getLeader()->isTBA();
	  if ($couple->getFollower()->isTBA() &&
	      (!($coup->getFollower()->isTBA()))) {
	    $conflict_exists=1;
	    last;
	  }
	  $dumb_bunny=$coup->getLeader()->getName();
	  $extra=$couple->getFollower()->getName();
	  $victim=$coup->getFollower()->getName();
	} elsif ($couple->getFollower()->equals($coup->getFollower())) {
	  next if $couple->getFollower()->isTBA();
	  if ($couple->getLeader()->isTBA() &&
	      (!($coup->getLeader()->isTBA()))) {
	    $conflict_exists=1;
	    last;
	  }
	  $dumb_bunny=$coup->getFollower()->getName();
	  $extra=$couple->getLeader()->getName();
	  $victim=$coup->getLeader()->getName();
	} elsif ($couple->getLeader()->equals($coup->getFollower())) {
	  next if $couple->getLeader()->isTBA();
	  $dumb_bunny=$coup->getFollower()->getName();
	  $extra=$coup->getLeader()->getName();
	  $victim=$couple->getFollower()->getName();
	} else { # $couple->getFollower()->equals($coup->getLeader())) 
	  next if $couple->getFollower()->isTBA();
	  $dumb_bunny=$coup->getLeader()->getName();
	  $extra=$coup->getFollower()->getName();
	  $victim=$couple->getLeader()->getName();
	}
	&send_error("AlreadyRegistered",
		    $dumb_bunny." ".
		    Constants::get("ERROR_MSG9")." ".
		    $extra." ".
		    Constants::get("ERROR_MSG10")." ".
		    $dance->getFullName()." ".
		    Constants::get("ERROR_MSG11")." ".
		    $dumb_bunny." ".
		    Constants::get("ERROR_MSG12")." ".
		    $victim." ".
		    Constants::get("ERROR_MSG13")."<p>".
		    Constants::get("ERROR_MSG14")."<p>");
      } # if contains
    } # LOOP for
    
    if ($conflict_exists) {
      # TBAs don't conflict with each other
      # This is hopefully rare, so we won't obfuscate/optimize it.
      if (!(($couple->getLeader()->equals($coup->getLeader()) &&
	     $couple->getLeader()->isTBA()) ||
	    ($couple->getFollower()->equals($coup->getFollower()) &&
	     $couple->getFollower()->isTBA()))) {
	if ($couple->getLeader()->isTBA() || $couple->getFollower()->isTBA()) {
	  logmsg("Extracting couple: ".$couple->getNames());
	  &removeCoupleFromDance($dance, $couple);
	  if ($i==$#$couples_ref) {
	    pop(@$couples_ref);
	  } else {
	    $$couples_ref[$i]=pop(@$couples_ref);
	  }
	}
      }
    } # conflict_exists
  } # if ($#$couples_ref>-1)

#  if ($i>$#$couples_ref) { # this couple doesn't exist yet
    # This can happen if the delete all their newcomer events and then
    # (in the same post) add beginner events.
#logmsg("redoing aCtS for ".$coup->getNames());
#    &addCoupleToSchools($coup);
#  }

  &log(2, $coup, 0, $dance);
  # remember, we're pushing a vector of stuff, not just stuff, which
  # is why we can't push: we need to get the vector, push into THAT,
  # and then store it.

  $by_dance->push_into_array($dance, $coup);
  $by_couple->push_into_array($coup, $dance);

  &send_success;
} # addCoupleToDance()

# Really initalizeCouple
sub addCoupleToSchools {
  my $coup=$_[0];
  my ($comp, $school, $vec_ref, $leader, $follower);

  &log(3, $coup, 0, 0);

  $leader=$coup->getLeader();
  $school=$leader->getSchool();
  $vec_ref=$by_school->get($school);
  if (!(Vector::contains($vec_ref, $leader))) {
    push(@competitors, $leader);
    $by_school->push_into_array($school, $leader);
  }

  $follower=$coup->getFollower();
  $school=$follower->getSchool();
  $vec_ref=$by_school->get($school);
  if (!(Vector::contains($vec_ref, $follower))) {
    push(@competitors, $follower);
    $by_school->push_into_array($school, $follower);
  }

  $vec_ref=$by_leader->get($leader);
  if (!(Vector::contains($vec_ref, $follower))) {
    $by_leader->push_into_array($leader, $follower);
  }

  $vec_ref=$by_follower->get($follower);
  if (!(Vector::contains($vec_ref, $leader))) {
    $by_follower->push_into_array($follower, $leader);
  }
  &send_success;
} # addCoupleToSchools

sub getCompetitorsBySchool {
  my $school=$_[0];

  return($by_school->get($school));
} # getCompetitorsBySchool

sub getFollowers {
  my $leader=$_[0];

  return($by_leader->get($leader));
} # getFollowers

sub getLeaders {
  my $follower=$_[0];

  return($by_follower->get($follower));
} # getLeaders

sub getNumberOfCompetitors {
  return($#competitors+1);
} # getNumberOfCompetitors

sub getNumberOfCouplesInDance {
  my $dance=$_[0];
  my $vec_ref;

  $vec_ref=$by_dance->get($dance);

  return($#$vec_ref+1);
} # getNumberOfCouplesInDance

sub getDancesByCouple {
  my ($coup)=$_[0];
  my $retval;

  return($by_couple->get($coup));
} # getDancesByCouple

sub getEmailAddresses {
  my ($i, %email, @ret);

  for ($i=0;$i<=$#competitors;$i++) {
    $email{$competitors[$i]->getEmail()}=1;
  }
  foreach $_ (keys(%email)) {
    push(@ret, $_);
  }
  return(\@ret);
} # getEmailAddresses

sub getNameSortedCompetitors {
  my (%foo, @ret, @comps, $i, $comp);

  @ret=();
  print "number of competitors: $#competitors\n";
  print "comp[0]=".$competitors[0]."\n";
  print "ref(comp[0])=".ref($competitors[0])."\n";
  for ($i=0;$i<=$#competitors;$i++) {
    $comp=$competitors[$i];
    $foo{$comp->getSortName()}=$comp;
  }
  foreach $_ (sort(keys(%foo))) {
    push(@ret, $foo{$_});
  }
  return(\@ret);
} # getNameSortedCompetitors

sub getNameSortedCompetitorsBySchool {
  my $school=$_[0];
  my ($vec, @school_data, %foo, @ret, $i, $comp);

  $vec=$by_school->get($school);
  if ($#$vec==-1) {return(0);}
  for ($i=0;$i<=$#$vec;$i++) {
    $comp=$$vec[$i];
    $foo{$comp->getSortName()}=$comp;
  }
  @ret=();
  foreach $_ (sort(keys(%foo))) {
    push(@ret, $foo{$_});
  }
  return(\@ret);
} # getNameSortedCompetitorsBySchool

sub getNameSortedCouples {
  my (%foo, @ret, $vec_ref, $i, $coup);

  $vec_ref=$by_couple->keys();
  if ($#$vec==-1) {return(0);}
  for ($i=0;$i<=$#$vec;$i++) {
    $coup=$$vec[$i];
    $foo{$coup->getLeader()->getSortName}=$coup;
  }
  foreach $_ (sort(keys(%foo))) {
    push(@ret, $foo{$_});
  }
  return(\@ret);
} # getNameSortedCouples

sub getNumberSortedCouples {
  my (%foo, @ret, $vec_ref, $i, $coup);

  $vec_ref=$by_couple->keys();
  if ($#$vec==-1) {return(0);}
  for ($i=0;$i<=$#$vec;$i++) {
    $coup=$$vec[$i];
    $foo{$coup->getLeader()->getNumber()}=$_;
  }
  foreach $_ (sort(keys(%foo))) {
    push(@ret, $foo{$_});
  }
  return(\@ret);
} # getNumberSortedCouples

sub getNameSortedCouplesByDance {
  my $dance=$_[0];
  my (%foo, @ret, $vec, $i, $coup);

  $vec=$by_dance->get($dance);
  if ($#$vec==-1) {return(0);}
  for ($i=0;$i<=$#$vec;$i++) {
    $coup=$$vec[$i];
    $foo{$coup->getLeader()->getSortName()}=$coup;
  }
  foreach $_ (sort(keys(%foo))) {
    push(@ret, $foo{$_});
  }
  return(\@ret);
} # getNameSortedCouplesByDance

sub getNumberSortedCouplesByDance {
  my $dance=$_[0];
  my ($vec_ref, @vec, %foo, @ret, $i, $coup);

  $vec_ref=$by_dance->get($dance);
  if ($#$vec==-1) {return(0);}
  for ($i=0;$i<=$#$vec;$i++) {
    $coup=$$vec[$i];
    $foo{$coup->getLeader()->getSortName()}=$coup;
  }
  foreach $_ (sort(keys(%foo))) {
    push(@ret, $foo{$_});
  }
  return(\@ret);
} # getNumberSortedCouplesByDance

sub getSchools {
  return($by_school->keys());
}

sub getSortedSchools {
  my ($vec, %foo, @ret, $i);

  $vec=$by_school->keys();
  if ($#$vec==-1) {
    return(0);
  }
  for ($i=0;$i<=$#$vec;$i++) {
    $foo{$$vec[$i]}=1;
  }
  foreach $_ (sort(keys(%foo))) {
    push(@ret, $_) if ($_ ne "");
  }
  return(\@ret);
} # getSortedSchools

sub is_db_open {
  return($db_open);
}

sub isLeader {
  return($by_leader->contains($_[0]));
}

sub isFollower {
  return($by_follower->contains($_[0]));
}

sub sanity_check {
  my $keys_ref=$by_couple->{KEYS};
  my $values_ref=$by_couple->{VALUES};

  logmsg("ref keys[0]: ".ref($$keys_ref[0])."\t".
	 "ref values[0]: ".ref($$values_ref[0]));
}

sub scrub_db {
  # OK, here's the deal.
  #
  # We read in the DB, parse it all, and then write it back out.
  # Hopefully, a lot of add/delete pairs are excised this way.
  # Likewise, if we assign numbers, we can write out the AddCouple info
  # with their numbers.
  #
  # We'll save the original db, just to be safe.

  my ($crap, $reg_status, @constants, @orig_constants, $i, $db, $new_db,
      $timestamp, $coup, $dances_ref, @crap, $couples_ref,
      $j);

  logmsg("scrubbing db...");

  # First step is to close Registration while we're doing this.
  open(CONSTANTS, Constants::getConstantsFilename());
  while(<CONSTANTS>) {
    if (/REGISTRATION_OPEN/) {
      ($crap,$reg_status)=split('=', $_);
      if ($reg_status) {
	push(@constants, "REGISTRATION_OPEN=0\n");
      } else {
	last;
      }
    } else {
      push(@constants, $_);
    }
    push(@orig_constants, $_);
  }
  close(CONSTANTS);
  if ($reg_status) {
    open(CONSTANTS, ">".Constants::getConstantsFilename());
    for ($i=0;$i<=$#constants;$i++) {
      print CONSTANTS $constants[$i];
    }
    close(CONSTANTS);
  }

  $db=Constants::get("DATABASE");

  # Right.  Move the database to database.timestamp.
  $timestamp=&ctime(time);
  @crap=split(' ', $timestamp);
  $timestamp=$crap[1].$crap[2]."_".$crap[3];
  $timestamp=~s/://g;
  $new_db=$db."-".$timestamp;
  system("cp $db $new_db");

  # And we're off!
  # Information is always added by couple, so we'll grovel over %by_couple
  # and, per couple, issue:
  # * addCoupleToSchools($coup)
  # * addCoupleToDance($dance, $coup)
  open(LOG, ">$db") || Error::CantOpenFile($db);
  $LOG=\*LOG;
  $couples_ref=$by_couple->keys();
  for ($i=0;$i<=$#$couples;$i++) {
    $coup=$$couples[$i];
    &log(3, $coup, 0, 0);   # addCoupleToSchools
    $dances_ref=$by_couple->get($coup);
    for ($j=0;$j<=$#$dances;$j++) {
      &log(2, $coup, 0, $$dances[$j]); # addCoupleToDance
    }
  }
  &closeDBLogfile($LOG);

  # OK, reopen registration if necessary
  if ($reg_status) {
    open(CONSTANTS, ">".Constants::getConstantsFilename());
    for ($i=0;$i<=$#orig_constants;$i++) {
      print CONSTANTS $orig_constants[$i];
    }
    close(CONSTANTS);
  }
  logmsg("scrubbing db: done");

} # scrub_db

sub loadComp {
  my $compname=$_[0];
  logmsg("loading comp: $compname");
  print "\nfetching constants...\n";
  Constants::fetch_constants($compname);
  print "\nloading database...\n";
  loadDB($compname, Constants::get("DATABASE"));
} # loadComp

sub destroyComp {
  $MASTERCOMP{$_[0]}=undefined;
  # and hope the gc unwraps it all...  there's a way to force the gc
  # to destroy these objects; should look it up.
} # destroyComp

sub loadDB {
  my ($dispatch, $coup, $school, $dance, $error, $numCouples, @in, $idx,
      $in_length, $date, $savecoup, $crap, $numDances, $filename, $x,
      $file_size);
  my @IN;
  my $linenumber=0;

  $COMP=$_[0];
  $filename=$_[1];

  $DB::profile=1;
  $date=&ctime(time);
  logmsg("Server::loadDB: $date\nloading '$COMP' from '$filename'");
  $db_open=0;

  @competitors=();
  $by_dance=Hashtable->new();
  $by_school=Hashtable->new();
  $by_couple=Hashtable->new();
  $by_leader=Hashtable->new();
  $by_follower=Hashtable->new();

  $numCouples=0;
  $savecoup=0;
  select(STDOUT);
  $|=1;
  $file_size=0;

  print "Processing database...\n";

#  if (open(IN, "$filename")) {
#    print "Reading database...\n";
#    while(<IN>) {
#      push(@IN, $_);
#      $file_size++;
#    }
#    print "done.\n";
#  } else {
#    Error::CantOpenFile($filename);
#  }

  if (open(WC, "/usr/bin/wc -l $filename|")) {
    $_=<WC>;
    s/^\s*//g;
    ($file_size, $crap)=split('\s', $_);
#die "wc=$file_size, filename=$filename\n";

    # 80 chars long
    #      123456789 123456789 123456789 123456789 123456789 123456789 
    print "0%                25%                 50%                 75%               100%\n" if $file_size;
  }
  $x=0;
  if (!($file_size)) {
    print "Can't read database size; not displaying loading meter.\n";
    $file_size=100000;
  }

  if (!open(IN, "$filename")) {
    Error::CantOpenFile($filename);
  }
  select(STDOUT);
  $|=1;
  while(<IN>) {

#  while($#IN>-1) {
#    $_=shift(@IN);

    $linenumber++;
    $numCouples++;
    chop; # this is the dispatch

    if ($file_size) {
	while($linenumber>$x) {
	    print "x";
	    $x+=$file_size/80.0;
	}
    }
    ($dispatch, $crap)=split(/\s*\#/, $_);
    
#    $coup=Couple->newFromDB(\@IN);
    $coup=Couple->newFromDB(\*IN);
    $linenumber+=14;
    
#    $_=shift(@IN);    chop;
    $_=<IN>;    chop;
    $linenumber++;
    ($school, $crap)=split(/\s*\#/, $_);
    
#    $_=shift(@IN);    chop;
    $_=<IN>;    chop;
    ($numDances, $crap)=split(/\s*\#/, $_);
    if ($numDances==1) {
#      $dance=SingleDance->newFromDB(\@IN);
      $dance=SingleDance->newFromDB(\*IN);
      $linenumber+=3;
    } elsif ($numDances>1) { 
#      $dance=MultiDance->newFromDB(\@IN, $numDances);
      $dance=MultiDance->newFromDB(\*IN, $numDances);
      $linenumber+=3*$numDances;
    }      
    
#    if ($dance!=0) {
#      logmsg("dispatch=$dispatch\tcoup=".$coup->getNames().
#	     ", school=$school, dance=".$dance->getAbbrev())
#	if $Server::debug;
#    } else {
#      logmsg("dispatch=$dispatch\tcoup=".$coup->getNames().
#	     ", school=$school, dance=null")
#	if $Server::debug;
#    }
    
    if ($dispatch==1) {
      &addCouple($coup);
    } elsif ($dispatch==2) {
      &addCoupleToDance($dance, $coup);
    } elsif ($dispatch==3) {
      &addCoupleToSchools($coup);
#      &debug;
    } elsif ($dispatch==4) {
      &removeCouple($coup);
    } elsif ($dispatch==5) {
      &removeCoupleFromDance($dance, $coup);
    } else {
      Error::Croak("Bad dispatch code '$dispatch' in Server::loadDB() near line $linenumber!\n");
    }
  }

  print "\ndone.\n";
  $date=&ctime(time);
  logmsg("\nnumCouples read: $numCouples, $date\n");
  close(IN);
  logmsg("Opening DB for writing\n");
  &openDBLogfile($filename);
  $db_open=1;
  logmsg("Storing into MASTERCOMP\n");

  # IF YOU CHANGE THIS, YOU MUST ALSO MODIFY GET_GLOBALS().
  @competitors=();
  @takenNumbers=();
  my @foo=(\@competitors,  #  0 competitors
	   $by_dance,      #  1
	   $by_school,     #  2
	   $by_couple,     #  3
	   $by_leader,     #  4
	   $by_follower,   #  5
	   -1,             #  6 hundreds
	   -1,             #  7 tens
	   -1,             #  8 ones
	   \@takenNumbers, #  9
	   $LOG,           # 10
	   $db_open);      # 11
  $MASTERCOMP{$compname}=\@foo;
  
  logmsg("DB ready.\n");

  &debug_globals;
}

sub openDBLogfile {
  my $filename=$_[0];
  logmsg("opening DB logfile ($filename)");
#  $LOG=new FileHandle ">>$filename" || Error::CantOpenFile($filename);
  if (!(open(LOG, ">>$filename"))) {
    if (!(open(LOG, ">$filename"))) {
      logmsg("Can't open database!");
      Error::CantOpenFile($filename);
    }
  }
  local($oldfh)=select(LOG);
  $|=1;
  $LOG=\*LOG;
  select($oldfh);
  logmsg("done");
}

sub closeDBLogfile {
  close($LOG);
}

sub removeCouple {
  my $coup=$_[0];
  my ($v, $leader, $follower, $keys_ref, $dance, $i, $j,
      $dances_ref, @testvec1, @testvec2);

  &log(4, $coup, 0, 0);
  $leader=$coup->getLeader();
  $follower=$coup->getFollower();

  Vector::removeElement(\@competitors, $leader);
  Vector::removeElement(\@competitors, $follower);

  $dances_ref=$by_couple->get($coup);

  $by_couple->remove($coup);

  $v=$by_school->get($leader->getSchool());
  Vector::removeElement($v, $leader);
  $v=$by_school->get($follower->getSchool());
  Vector::removeElement($v, $follower);

  $keys_ref=$by_dance->keys();
  LOOP1: for ($i=0;$i<=$#$keys_ref;$i++) {
    for ($j=0;$j<=$#$dances_ref;$j++) {
      if ($$keys_ref[$i]->equals($$dances_ref[$j])) {
	$v=$by_dance->get($$dances_ref[$j]);
	Vector::removeElement($v, $coup);
	$by_dance->put($$dances_ref[$j], $v); # may be unecessary
	$by_dance->get($$dances_ref[$j]);
	next LOOP1;
      }
    }
  }
  &send_success;
} # removeCouple()

sub removeCoupleFromDance {
  my ($dance, $coup)=@_;
  my $vec_ref;

  &log(5, $coup, 0, $dance);

# logmsg("removeCoupleFromDance begin ".$coup->getNames().", ".$dance->getAbbrev());

  # Need to remove them from by_dance; need to remove the entry in their
  # by_couple entry.

  # Modify by_couple; if the have no more dances left, then do a
  # removeCouple() on them.

  $vec_ref=$by_couple->get($coup);
  Vector::removeElement($vec_ref, $dance);
  $by_couple->put($coup, $vec_ref); # probably unnecessary

  # OK, the rest of this...

  $vec_ref=$by_dance->get($dance);
  Vector::removeElement($vec_ref, $coup);
  $by_dance->put($dance, $vec_ref); # probably unnecssary
  &send_success;
} # removeCoupleFromDance(0

  # ################ private methods ################ #

  # Why the hell isn't this in the jdk?!?
  # Quicksort: pick a pivot.  Sort everything else into left and right array.
  # Pivot is now in the correct position.  Recurse on left and right array.

  # Write to logfile, plus rebuild the DB
  # dispatch code:
  # 1=addCouple(coup)
  # 2=addCouple(dance, coup)
  # 3=addCoupleToSchools(coup)
  # 4=removeCouple(coup)
  # 5=removeCoupleFromDance(dance, coup)

sub log {
  my ($dispatch, $coup, $school, $dance)=@_;
  my ($numDances, $i, $tmpdance);

  # obj is either a couple or a competitor

  # dispatch
  # school (String)
  # singledance->new(level, continent, name, abbrev, style, dance_abbrev)
  # multidance->new(dance1, dance2, dance3, dance4, dance5, numDances)
  # Competitor->new(lfname, fname, school, email, email_exists)
  # Couple->new(leader, follower)

  if ($db_open) {
    if ($dance==0) {
      logmsg("logging: $dispatch, ".$coup->getNames().", $school, ");
    } else {
      logmsg("logging: $dispatch, ".$coup->getNames().", $school, ".
		   $dance->getName());
    }

    print $LOG "$dispatch\t# dispatch code\n";

    $coup->write($LOG);

    print $LOG "$school\t# school\n";

    if ($dance==0) {
      print $LOG "0\t# null dance\n";
    } else {
      $dance->write($LOG);
    }
  }
}

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

sub logmsg {
  print Server::SERVER_LOG "$0 $$: @_ at ", scalar localtime, "\n"
}

sub recv_scalar {
  my ($char, $line, $length);
  my $limit=0;

  local($debug=1);

  $length="";
#  print "Client exists\n" if defined(Server::Client) and $debug;
  recv(Server::Client, $char, 1, 0);
#  print "1st char read: '$char'\n" if $debug;
#  while(($char ne '!') and ($limit<100)) {
  while($char ne '!') {
    $length.=$char;
#    $limit++;
    recv(Server::Client, $char, 1, 0);
#    print "next char read: '$char'\n" if $debug;
  }
#  print "scalar length: $length\n" if $debug;
  recv(Server::Client, $line, $length, 0);
#  print "scalar read: $line\n" if $debug;
  return($line);
}

sub send_scalar {
  print Server::Client $_[0],"\n";
}

sub send_vector {
  # OK, crack open the vector and send it down the line.
  my ($vec_ref, $i);
  $vec_ref=$_[0];

  print "sending vector ($#$vec_ref): ";
  for ($i=0;$i<=$#$vec_ref;$i++) {
    if (ref($$vec_ref[$i]) eq "") {
#      print "sending: '".$$vec_ref[$i]."'\n";
      print Server::Client $$vec_ref[$i]."\n";
    } else {
      $$vec_ref[$i]->write(Server::Client);
    }
  }
  print "done.\n";
  print Server::Client "\n";
}

sub send_success {
  logmsg("sending success");
  send_scalar("SUCCESS");
}

sub send_error {
  logmsg("Error 0: ",$_[0],"\nError 1: ",$_[1]);
  send_scalar($_[0]);
  send_scalar($_[1]);
}

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

# Startup
$compname="";
if ($#ARGV!=0) {
  die "Usage: $0 compname\n";
} else {
  $compname=shift(@ARGV);
}

print "Starting server: '$compname'.\n";

open(SERVER_LOG, ">$log") || die "Can't open log '$log'!\n";
select(SERVER_LOG); $|=1; select(STDOUT);

$port=shift||4565;
$proto=getprotobyname('tcp');
socket(Server, Socket::PF_INET, Socket::SOCK_STREAM, $proto) ||
  die "socket: $!\n";
setsockopt(Server, Socket::SOL_SOCKET, Socket::SO_REUSEADDR, 1) ||
  die "setsockopt: $!\n";
bind(Server, Socket::sockaddr_in($port, Socket::INADDR_ANY)) ||
  die "bind: $!\n";
listen(Server, Socket::SOMAXCONN) || die "listen: $!\n";
use strict;
logmsg "server started on port ".$port;
&loadComp($compname);
print "\n\nServer is ready.\n";

$SIG{CHLD}=\&REAPER;

# Run mode
#for (; $paddr=accept(Client,Server); close Client) {
$get_new_client=1;
while(1) {
  if ($get_new_client) {
    $paddr=accept(Client,Server);
    ($port, $iaddr)=Socket::sockaddr_in($paddr);
    $name=gethostbyaddr($iaddr, Socket::AF_INET);
    
    logmsg "connection from $name [", Socket::inet_ntoa($iaddr), "] at port $port";
    print "connection from $name [", Socket::inet_ntoa($iaddr), "] at port $port\n" if $Server::debug;

    $get_new_client=0;
    my $oldfh=select Client;  $|=1;  select $oldfh;
  }


  $sender_address=recv(Client, $dispatch, 2, 0);
  if (!defined($sender_address)) {
    print "Error reading dispatch!\n";
    next;
  }
  # NOTE: the COMP is sent at the same time as the dispatch
  $COMP=&recv_scalar;
  &get_globals($COMP);

#  &debug_globals;

  print "COMP='$COMP'\tdispatch='$dispatch'\n" if $Server::debug;

  if ($dispatch eq "00") {
    print Client "Hello there, $name, it's now ", scalar localtime, "\n";
    print Client "";
  } elsif ($dispatch eq "01") { # 01 addCouple($coup, $school, $dance)
    $coup=recv_couple();
    $school=recv_school();
    $dance=recv_dance();
    addCouple($coup, $school, $dance);
  } elsif ($dispatch eq "02") { # 02 addCoupleToDance($dance, $coup)
    $dance=recv_dance();
    $coup=recv_couple();
    addCoupleToDance($dance, $coup);
  } elsif ($dispatch eq "03") { # 03 addCoupleToSchools($coup)
    $coup=recv_couple();
    print "ref(coup->getLeader)=".ref($coup->getLeader())."\n";
    addCoupleToSchools($coup);
  } elsif ($dispatch eq "04") { # 04 removeCouple($coup)
    $coup=recv_couple();
    removeCouple($coup);
  } elsif ($dispatch eq "05") { # 05 removeCoupleFromDance($dance, $coup)
    $dance=recv_dance();
    $coup=recv_couple();
    removeCoupleFromDance($dance, $coup);
  } elsif ($dispatch eq "10") { # 10 getCompetitorsBySchool($school)
    $school=recv_school();
    send_vector(getCompetitorsBySchool($school));
  } elsif ($dispatch eq "11") { # 11 getFollowers($leader)
    $leader=recv_competitor();
    send_vector(getFollowers($leader));
  } elsif ($dispatch eq "12") { # 12 getLeaders($follower)
    $follower=recv_competitor();
    send_vector(getLeaders($follower));
  } elsif ($dispatch eq "13") { # 13 getNumberOfCompetitors()
    send_scalar(getNumberOfCompetitors());
  } elsif ($dispatch eq "14") { # 14 getNumberOfCouplesInDance($dance)
    $dance=recv_dance();
    send_scalar(getNumberOfCouplesInDance($dance));
  } elsif ($dispatch eq "15") { # 15 getDancesByCouple($couple)
    $coup=recv_couple();
    send_vector(getDancesByCouple($coup));
  } elsif ($dispatch eq "16") { # 16 getEmailAddresses()
    send_vector(getEmailAddresses());
  } elsif ($dispatch eq "17") { # 17 getNameSortedCompetitors()
    send_vector(getNameSortedCompetitors());
  } elsif ($dispatch eq "18") { # 18 getNameSortedCompetitorsBySchool($school)
    $school=recv_school();
    send_vector(getNameSortedCompetitorsBySchool($school));
  } elsif ($dispatch eq "19") { # 19 getNameSortedCouples()
    send_vector(getNameSortedCouples());
  } elsif ($dispatch eq "20") { # 20 getNumberSortedCouples()
    send_vector(getNumberSortedCouples());
  } elsif ($dispatch eq "21") { # 21 getNameSortedCouplesByDance($dance)
    $dance=recv_dance();
    send_vector(getNameSortedCouplesByDance($dance));
  } elsif ($dispatch eq "22") { # 22 getNumberSortedCouplesByDance($dance)
    $dance=recv_dance();
    send_vector(getNumberSortedCouplesByDance($dance));
  } elsif ($dispatch eq "23") { # 23 getSchools()
    send_vector(getSchools());
  } elsif ($dispatch eq "24") { # 24 getSortedSchools()
    send_vector(getSortedSchools());
  } elsif ($dispatch eq "25") { # 25 isLeader($comp)
    $comp=recv_competitor();
    send_scalar(isLeader($comp));
  } elsif ($dispatch eq "26") { # 26 isFollower($comp)
    $comp=recv_competitor();
    send_scalar(isFollower($comp));
  } elsif ($dispatch eq "90") { # 90 do_stats()
    print "Redoing stats...\n";
    &do_stats;
    print "done.\n";
  } elsif ($dispatch eq "91") { # 91 scrub_db()
    scrub_db();
  } elsif ($dispatch eq "92") { # 92 loadComp
    $compname=recv_scalar();
    &loadComp($compname);
#    close(Client);
#    $get_new_client=1;
  } elsif ($dispatch eq "93") { # 93 destroyComp
    &destroyComp;
  } elsif ($dispatch eq "97") { # 97 close client
    print "closing connection.\n\n";
    close(Client);
    $get_new_client=1;
  } elsif ($dispatch eq "98") { # 98 exit gracefully
    print "Exiting.\n";
    exit(0);
  } elsif ($dispatch eq "99") { # 99 crash stop
    print "Exiting immediately.\n";
    exit(1); # :)
  } else {
    print "Unknown dispatch '$dispatch'; closing connection and continuing...\n\n";
    close(Client);
  }

# OK, we were trying to be clever here and keep the connection persistent.
# But the problem is that the Server process then hangs :)
# It needs to be asynchronous, and that's a bit of a step away.

#  close(Client);
#  $get_new_client=1;
}

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

sub debug { # called after db is loaded
  return;

#   my ($ref, $i, $ref2, $j);
#   $ref=$by_school->keys();
#   for ($i=0;$i<=$#$ref;$i++) {
#     print "school: ".$$ref[$i]."\n";
#     $ref2=$by_school->get($$ref[$i]);
#     for ($j=0;$j<=$#$ref2;$j++) {
#       print "\t".$$ref2[$j]->getName()."\n";
#     }
#   }

#  my ($keys_ref, $x, $i, $couple, $ref);
#  $keys_ref=$by_couple->keys();
#  for ($x=0;$x<=$#$keys_ref;$x++) {
#    $couple=$$keys_ref[$x];
#    print "couple: ".$couple->getNames()."\n";
#    $ref=$by_couple->get($couple);
#    print "ref ref: ".ref($ref)."\n";
#    for ($i=0;$i<=$#$ref;$i++) {
#      print "ref(".$$ref[$i].")=".ref($$ref[$i])."\n";
#      print "\t".$$ref[$i]->getAbbrev()."\n";
#    }
#  }  
#  print "\n\n";

#   print "**************** by_leader:\n";
#   my ($ret, $i, $ret2, $j);
#   $ret=$by_leader->keys();
#   for ($i=0;$i<=$#$ret;$i++) {
#     print "key: ".$$ret[$i]->getName()."\n";
#     $ret2=$by_leader->get($$ret[$i]);
#     if ($ret2) {
#       for ($j=0;$j<=$#$ret2;$j++) {
# 	print "\t".$$ret2[$j]->getName()."\n";
#       }
#     }
#   }
# 
#   print "**************** by_follower:\n";
#   my ($ret, $i, $ret2, $j);
#   $ret=$by_follower->keys();
#   for ($i=0;$i<=$#$ret;$i++) {
#     print "key: ".$$ret[$i]->getName()."\n";
#     $ret2=$by_follower->get($$ret[$i]);
#     if ($ret2) {
#       for ($j=0;$j<=$#$ret2;$j++) {
# 	print "\t".$$ret2[$j]->getName()."\n";
#       }
#     }
#   }
} 

sub debug2 { # called after a aCtD
  return;
  my ($coup, $dance)=@_;
  my $ref=$by_couple->get($coup);
  my $i;

  print "couple: ".$coup->getNames()."\tdance=".$dance->getAbbrev()."\n";
#  print "ref ref: ".ref($ref)."\n";
  if (ref($ref) eq "ARRAY") {
    print "sizeof ref: $#$ref\n";
    for ($i=0;$i<=$#$ref;$i++) {
      print "\t'".$$ref[$i]->getAbbrev()."'";
    }
    print "\n";
  }
}

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

# package Network, which due to scoping, can't be split off for now
# (well, we can put it all in main::, but then that means that main::recv_foo
# just points to Database::recv_foo, which isn't very optimal.  Maybe perl
# optimizes this, but I doubt it.

sub recv_couple {
  my ($leader, $follower);
#  print "reading leader...\n";
  $leader=recv_competitor();
#  print "reading follower...\n";
  $follower=recv_competitor();
#  print "done.\n";
  
#  return(Couple->new($leader, $follower));
  
  my $couple=Couple->new($leader, $follower);
#  print "leader name: ".$couple->getLeader()->getName()."\n";
#  print "follower name: ".$couple->getFollower()->getName()."\n";
  return($couple);
}

sub recv_school {
  return(recv_scalar());
}

sub recv_dance {
  my ($dance, $numDances, @dances, $level, $continent, $cons_name, $i);
  $numDances=recv_scalar();
  if ($numDances eq "") {
    return(undef);
  }
  $level=recv_scalar();
  $continent=recv_scalar();
  $cons_name=recv_scalar();
  $dance=SingleDance->new($level, $continent, $cons_name);
  if ($numDances==1) {
    return($dance);
  } else {
    @dances=(0, 0, 0, 0, 0, 0);
    $dances[1]=$dance;
    for ($i=2;$i<=$numDances;$i++) {
      $level=recv_scalar();
      $continent=recv_scalar();
      $cons_name=recv_scalar();
      $dance=SingleDance->new($level, $continent, $cons_name);
      $dances[$i]=$dance;
    }
    return(MultiDance->new($dances[1], $dances[2], $dances[3], $dances[4],
			   $dances[5], $numDances));
  }
}

sub recv_competitor {
  my ($lname, $fname, $school, $email, $email_exists, $number, $tba);

  $lname=recv_scalar();
  $fname=recv_scalar();
  $school=recv_scalar();
  $email=recv_scalar();
  $email_exists=recv_scalar();
  $number=recv_scalar();
  $tba=recv_scalar();
  return(Competitor->new2($lname, $fname, $school, $email, $email_exists,
			  $number, $tba));
} # recv_competitor

sub debug_globals {
  my ($key, @globals, $ref, $i);

  print "---------- DEBUG GLOBALS ----------\n";
  foreach $key (sort(keys(%MASTERCOMP))) {
    print "\tkey: $key\n";
    $ref=$MASTERCOMP{$key};
    @globals=@$ref;
    print "sizeof globals: $#globals\n";
    print "competitors=".$globals[0]."\n";
    print "by_dance=".$globals[1]."\n";
    print "by_school=".$globals[2]."\n";
    print "by_couple=".$globals[3]."\n";
    print "by_leader=".$globals[4]."\n";
    print "by_follower=".$globals[5]."\n";
    print "hundreds=".$globals[6]."\n";
    print "tens=".$globals[7]."\n";
    print "ones=".$globals[8]."\n";
    print "takenNumbers=".$globals[9]."\n";
    print "LOG=".$globals[10]."\n";
    print "db_open=".$globals[11]."\n";
  }
  print "---done---\n";
} # debug_globals

1;
