=pod

this is the Wheels server, version SINGLE1.07

implementation goals:  

	read decks from decks.dat file

	Accept a single connection and run it, with no
	threading at all

	game handling:  lay, discard, NN, NNNN, win, status


	
=cut

package WheelsServer;

$Version = '1.07';

use Socket;
use Fcntl ':flock';
use IO::Handle;
use IO::Socket;
use Carp;
require "ctime.pl";


=pod

The Log function writes a line to the log file

=cut

open LOG,">>Logfile";
$TFH = select(LOG); $|=1; select $TFH;

sub Log(@){
	print LOG join("\n",time, @_);
};

print "Log defined\n";

Log "Logging enabled";

=pod

Open the server socket for the doormen to receive connections on

=cut

sub Door();

print "opening server socket for listen\n";
Door; 	# accept new incoming connections 
print "server socket listen now open\n";


$message = "Server starting ".`date`;
chomp($message); 
Log($message);

=pod

The server reads the decks in from the decks.dat file which exists in the
current directory.

=cut

open DECKS,"decks.dat" or die "Run ./shuffle.pl first\n"; 
chomp(@StandardDecks = (<DECKS>));
Log("Read in $#StandardDecks decks");

=pod

Every line in passwd is username:password, there is no encryption
Doorman will see if the data it gets appears in $PasswdHash
before passing the socket to Usher

=cut

open PASSWD, "passwd" or die "Need to create ./passwd file\n";
my ($pline,$ptally);
foreach $pline (<PASSWD>){ $ptally++; chomp $pline; $PasswdHash{$pline} = 1}; 
Log("Read in $ptally passwords");
Log keys %PasswdHash;

=pod

Have one fresh table

=cut

sub TablePrep();
Log "Starting tableprep";
TablePrep; 	# prepare new game table


package WClient;
@ISA = qw{ WheelsServer };

sub Log(@){&WheelsServer::Log( @_ )};
#use WheelsServer 'Log';

sub New{
	Log "WCLIENT:::NEW";
	my ($pack, $name, $sock) = @_;
	Log "new WClient for <$name> connecting from",
		&WheelsServer::SockData( $sock );
	my $Self = {};
	$$Self{'name'} = $name;
	$$Self{'sock'} = $sock;
	bless $Self;
};


package WTable;

@ISA = qw{ WheelsServer };
sub Log(@){&WheelsServer::Log( @_);};

$Tally = 0;


sub PlayAway{
	my $Table = shift;
	ref($Table) eq 'WTable' or Croak("Weird table");
	my $Sock = $$Table{'sock'};
	$SockData = &WheelsServer::SockData( $Sock );
=pod

provide the Stateful Wheels Protocol interface to
the client connected to the other end of $Sock
using the game state object $Table

=cut

	$Sock->autoflush(1);
	my $line;
	my @Commands;
	while( $line = <$Sock> ){
		@Commands = split(/\W+/, $line);
		foreach $cmd (@Commands){
			close $Sock if $cmd eq 'close';
			my $Result = $Table->Obey($cmd);
			print $Sock "$Result\n";
		};
		if(defined($$Table{'COMPLETE'})){
			Log "Closing connection for",$$Table{'name'};
			print "Closing connection for $$Table{'name'}\n";
			close $Sock;
			$main::COMPLETEs++ unless defined ($$Table{'notedCOMPLETION'});
			$$Table{'notedCOMPLETION'} = 1;
			return;
		};
	};
	Log "Reading $SockData produced error $!";
	close $Sock;
};

sub New{
	my $Self = {};
	$$Self{'TableNo'} = ++$Tally;
	#print "building table number $$Self{'TableNo'}\n";
	Log "building table number $$Self{'TableNo'}";

	$$Self{'Decks'} = 1 + $#WheelsServer::StandardDecks; 
	$$Self{'DeckNo'} = 1; 
	#Log "we are on Deck number",$$Self{'DeckNo'},'of',$$Self{'Decks'};

	$$Self{'DeckList'} = [@WheelsServer::StandardDecks]; 
	my $FirstDeck = shift @{$$Self{'DeckList'}};
	#print "FirstDeck is <$FirstDeck>\n";
	$$Self{'Deck'} = [split /\W+/, $FirstDeck];
	#Log "The deck in hand is",@{$$Self{'Deck'}};

	my $n;
	for $n (0..3){
		@{$$Self{"Pile$n"}}=();
	};

	$$Self{'Round'} = $$Self{'Move'} = 0;

	bless $Self;
};

sub dump{
	my $Self = shift;
	# print out the entire game state
	Log "Table $$Self{'TableNo'} on Deck $$Self{'DeckNo'} of $$Self{'Decks'}";
	Log "deck  :",@{$$Self{'Deck'}};
	my $n;
	for $n (0..3){
		Log "Pile $n:",@{$$Self{"Pile$n"}};
	};
};

sub PileTops($){
	my $Self = shift;
	my $pile0 = ${$$Self{"Pile0"}}[0] || '__';
	my $pile1 = ${$$Self{"Pile1"}}[0] || '__';
	my $pile2 = ${$$Self{"Pile2"}}[0] || '__';
	my $pile3 = ${$$Self{"Pile3"}}[0] || '__';
	return "$pile0 $pile1 $pile2 $pile3";
};

sub status{
	my $Self = shift;
	my $piletops = PileTops($Self);
	my $elapsed = time - $$Self{'connectedat'};
	my $D =  $$Self{'DeckNo'};
	my $DD =  $$Self{'Decks'};
	my $R =  $$Self{'Round'};
	my $M =  $$Self{'Move'};
	my $C = ($#{$$Self{'Deck'}} + 1) /4 ;
	#Log "giving status for table $$Self{'TableNo'}";
	return "OK $piletops time $elapsed round $R move $M $C sets left in deck $D of $DD decks"; 
};
$CommandHash{'status'} = \&status;

sub pickup{
	my ($Self, $order) = @_;
	my @order = split '',$order;
	return "ERR cannot pickup $order" unless join('',sort @order) eq '0123';

=pod

	this routine gathers the piles of cards on the table,
	and adds them to the bottom of the deck.

	The cards will come off the deck in the order that they are listed
	in the instruction, left to right.

=cut
	
	# uncomment this line see that the above paragraph is accurate $Self->dump;
	$$Self{'Deck'} = [
		@{$$Self{"Pile$order[3]"}},
		@{$$Self{"Pile$order[2]"}},
		@{$$Self{"Pile$order[1]"}},
		@{$$Self{"Pile$order[0]"}},
		@{$$Self{'Deck'}}
	];
 	my $n;
        for $n (0..3){
                @{$$Self{"Pile$n"}}=();
        };
	$$Self{'Round'}++;
	# this one too $Self->dump;
	return $Self->status;
};

sub move{
	my ($Self, $order0) = @_;
	my ($order) = $order0 =~ m/([0123]{2})/ or return "ERR cannot move $order0";
	my ($origin, $destination) = split '',$order;
	unless(defined($origin) and defined($destination)){
		Log "Very odd happening; move for $$Self{'name'} took arg of $order0";
		return "ERR cannot move $order0";
	};
	return "ERR cannot move $order0" unless $origin gt $destination;

	return "ERR cannot move $order0" unless defined ${$$Self{"Pile$destination"}}[0] ;
	return "ERR cannot move $order0" unless defined ${$$Self{"Pile$origin"}}[0] ;
	return "ERR cannot move $order0" unless substr(${$$Self{"Pile$destination"}}[0],0,1) eq substr( ${$$Self{"Pile$origin"}}[0],0,1);
	unshift @{$$Self{"Pile$destination"}}, shift @{$$Self{"Pile$origin"}};
	$$Self{'Move'}++;

	return $Self->status;
};

sub lay{
	my $Self = shift;
	unless (@{$$Self{'Deck'}}){
		return $Self->pickup(3210) if 3 < $$Self{'OUTOFCARDS'}++;
		return "ERR out of cards --  $$Self{'OUTOFCARDS'}";
	};
	unshift @{$$Self{"Pile0"}}, pop @{$$Self{'Deck'}};
	unshift @{$$Self{"Pile1"}}, pop @{$$Self{'Deck'}};
	unshift @{$$Self{"Pile2"}}, pop @{$$Self{'Deck'}};
	unshift @{$$Self{"Pile3"}}, pop @{$$Self{'Deck'}};
	return $Self->status;
};
$CommandHash{'lay'} = \&lay;
$CommandHash{'dump'} = \&dump;

sub discard{
	my $Self = shift;
	my $pile0 = ${$$Self{"Pile0"}}[0] || '__';
	my $pile1 = ${$$Self{"Pile1"}}[0] || '__';
	my $pile2 = ${$$Self{"Pile2"}}[0] || '__';
	my $pile3 = ${$$Self{"Pile3"}}[0] || '__';

	return "ERR cannot discard" if $pile3 eq '__';
	return "ERR cannot discard" if substr($pile3,0,1) ne substr($pile2,0,1) ;
	return "ERR cannot discard" if substr($pile0,0,1) ne substr($pile1,0,1) ;
	return "ERR cannot discard" if substr($pile1,0,1) ne substr($pile2,0,1) ;

	shift @{$$Self{"Pile0"}};
	shift @{$$Self{"Pile1"}};
	shift @{$$Self{"Pile2"}};
	shift @{$$Self{"Pile3"}};
	return $Self->status;
};

$CommandHash{'discard'} = \&discard;
sub win{
	my $Self = shift;
	my @deck = (	@{$$Self{'Deck'}},
		@{$$Self{"Pile0"}},
		@{$$Self{"Pile1"}},
		@{$$Self{"Pile2"}},
		@{$$Self{"Pile3"}}
	);
	return "ERR there are still cards in this deck" if @deck;

        my $FirstDeck = shift @{$$Self{'DeckList'}};

	if (!$FirstDeck){
		${$$Self{"Pile0"}}[0] = 'FI';
		${$$Self{"Pile1"}}[0] = 'NI';
		${$$Self{"Pile2"}}[0] = 'SH';
		${$$Self{"Pile3"}}[0] = 'ED';
	
		$$Self{"COMPLETE"} = 1;	

	}else{

	        $$Self{'Deck'} = [split /\W+/, $FirstDeck];
		Log "$$Self{'name'} completed deck $$Self{'DeckNo'} of $$Self{'Decks'}.";
		$$Self{'DeckNo'}++;

	};

	my $WinRes = $Self->status;
	Log $WinRes;
	return $WinRes;
};
$CommandHash{'win'} = \&win;

sub sclose{
	 my $Self = shift;
	close($$Self{'sock'});
};
$CommandHash{'close'} = \&sclose;

sub echo{
	my $Self = shift;
	my $arg = shift;
	"OK, synching $arg";
};

sub Obey{
	my ($Self,$command) = @_;
	#Log "trying to Obey $command";
	#$Self->dump;
	#return "OK the function is getting called allright -- this time with $command";

	return $Self->pickup($command) if $command =~ m/\d\d\d\d/;
	return $Self->move($command) if $command =~ m/\d\d/;
	return $Self->echo($command) if $command =~ m/^sync/;

	unless (defined $CommandHash{$command}){
		Log "trying to Obey $command";
		return "ERR what is \"$command\"?  I know: status lay win discard NN NNNN sync... close";
	};
	return &{$CommandHash{$command}}($Self) ;


};

package WheelsServer;

sub Door(){

        my $PortNumber  = $ENV{'SWP_SERVERPORT'} || 5200;

	$door = IO::Socket::INET->new(
				Proto     => 'tcp',
                                LocalPort => $PortNumber,
                                Listen    => SOMAXCONN,
                                Reuse     => 1
	);

 	die "can't setup server" unless $door;
 	Log "Server accepting clients";
}

sub FreeTable(){
	$main::NewTable = &WTable::New;
}

sub TablePrep(){
		FreeTable ;
};


TablePrep;
Log "Table ready";
print "Table ready";

sub SockData($){
	my $client = shift;
    	my $hersockaddr    = getpeername($client);
    	my ($port, $iaddr) = unpack_sockaddr_in($hersockaddr);
    	my $herhostname    = gethostbyaddr($iaddr, AF_INET);
    	my $herstraddr     = inet_ntoa($iaddr);
	return "$herhostname $herstraddr";
};

sub Ush($$);
# The Doorman
sub Doorman(){
	Log "Doorman waiting for client";
	my $client;
	until(	$client = $door->accept()){
		print "Accepted false socket $!";
	};
	Log "Doorman got client";
	$client->autoflush();
	print $client "Stateful Wheels Protocol Server version $Version: Authenticate yourself please\n";
	my $Data = <$client>;
	my($Name,$Pass) =  $Data =~ m/^(\w+):(\w*)/;
	if($PasswdHash{"$Name\:$Pass"}){
		print $client "OK password matched\n";
		Log "Good auth $Data";
		print "Received connection from $Name\n";
		Ush($Name,$client);
		Log "returned from playing";
	}else{
		Log "Received bad auth data <$Data>";
		Log "closing connection from", SockData $client;
		print $client "ERR sorry, ", SockData $client ," password mismatch\n";
		close $client;
	};
	Log "Doorman  quitting";
};

# The Usher
sub Ush($$){
	my ($name, $Sock) = @_;
=pod

Take sockets from the $LineForUshers queue and issue them
a table from the Tables queue or reattach them with their
table should they have lost their connection.

=cut
	my $ThisTable;
	my $SockData = SockData $Sock;
	Log "Ushing $name from", $SockData;
	Log "Assigning table for $name, game $main::games";
	$ThisTable = $main::NewTable;

	Log "Got the table";
	$$ThisTable{'name'} = $name;
	$$ThisTable{'sock'} = $Sock;
	$$ThisTable{'connectedat'} = time;
	$ThisTable->PlayAway(); 
	Log "usher returned from UseTable: $main::games games, $main::COMPLETEs complete ";
};

Doorman;
print "Done\n\n";