deckard-and-company/Server/server.pl

#!/usr/bin/perl -w
use strict;
use warnings;
use POSIX;
use Net::WebSocket::Server;
use JSON;

use Data::Dumper; # For debuging only, REMOVE WHEN INITIAL CODE IS FINISH

#########################Game Logic starts here##########################

my %sessions = ();

sub generateSession {
	my $newSession = shift;
	unless (defined $newSession) { $newSession = time; }
	if ( grep( /$newSession/, keys %sessions ) ) {
		generateSession();
	} else {
		print "Adding session ".$newSession." to database\n";
		$sessions{$newSession} = ();
		$sessions{$newSession}{"id"} = $newSession;
		$sessions{$newSession}{"users"} = ();
		$sessions{$newSession}{"decks"} = ();
		$sessions{$newSession}{"pools"} = ();

	}
	return $newSession;
}

sub generateDeck {
	my $DDF = from_json(shift);
# Add proper handling for reading of DDFs
}

sub shuffle {
	my @deck = @_;
	my $index = 0;
	for (@deck) {
		my $swapCardIndex = floor(rand() * @deck);
		my $swapCard = $deck[$swapCardIndex];
		$deck[$swapCardIndex] = $_;
		$deck[$index] = $swapCard;
		$index++;
	}
	return @deck;
}

sub addUser {
	my ($sessionID,$userID) = @_;
	%{$sessions{$sessionID}{"users"}{$userID}} = (
		name => "$userID",
		hands => ()
	);
}

sub addCards {
	my ($sessionID,$deckID, $cards) = @_;
	push(@{$sessions{$sessionID}{"decks"}{$deckID}->{cards}}, @$cards);
}

sub addDeck {
	my ($sessionID,$deckID) = @_;
	%{$sessions{$sessionID}{"decks"}{$deckID}} = ( name => "$deckID", cards => [] );
}

sub delDeck {
	my ($sessionID,$deckID) = @_;
	$sessions{$sessionID}{"decks"}{$deckID} = undef;
}

sub uploadDDF {
	my ($sessionID, $deckID, $DDF) = @_;
	addCards($sessionID,$deckID,\@{generateDeck($DDF)});
}

sub addPool {
	my ($sessionID,$poolID) = @_;
	%{$sessions{$sessionID}{"pools"}{$poolID}} = ( name => "$poolID", cards => [] );
}

sub reapCards {
	my $arrayRef = $_[0];
	my @reapedCards = [];
	print "Reaping cards";
	while(@{$arrayRef}) {
		push(@reapedCards,shift(@{$arrayRef}));
		print ".";
	}
	print "Done\n";
	return @reapedCards;
}

sub delPool {
	my ($sessionID,$poolID) = @_;
	my @reapedCards = reapCards(\@{$sessions{$sessionID}{"pools"}{$poolID}->{cards}});
	$sessions{$sessionID}{"pools"}{$poolID} = undef;
	return @reapedCards;
}

sub getUsers {
	my $sessionID = $_[0];
	return keys %{$sessions{$sessionID}{"users"}};
}

sub getDecks {
	my $sessionID = $_[0];
	return keys %{$sessions{$sessionID}{"decks"}};
}

sub getPools {
	my $sessionID = $_[0];
	return keys %{$sessions{$sessionID}{"pools"}};
}

sub addHand {
	my ($sessionID, $userID, $handID) = @_;
	%{$sessions{$sessionID}{"users"}{$userID}->{hands}{$handID}} = ( cards => [] );
}

sub delHand {
	my ($sessionID, $userID, $handID) = @_;
	my @leftoverCards = reapCards(\@{$sessions{$sessionID}{"users"}{$userID}->{hands}{$handID}->{cards}});
	$sessions{$sessionID}{"users"}{$userID}->{hands}{$handID} = undef;
	return @leftoverCards;
}

sub getHands {
	my ($sessionID, $userID) = @_;
	return keys %{$sessions{$sessionID}{"users"}{$userID}->{hands}};
}

sub moveCard {
	my ($originStackRef, $originIndex, $destStackRef, $destIndex) = @_;
	# splice card out of one deck, and into the other. 
}

sub drawCard {
	my ($sessionID, $deckID, $userID, $handID) = @_;
	moveCard(
		\@{$sessions{$sessionID}{"decks"}{$deckID}->{cards}}, 0,
		\@{$sessions{$sessionID}{"users"}{$userID}->{hands}{$handID}->{cards}}, 0
	);
}

sub playCard {
	my ($sessionID, $userID, $handID, $cardIndex, $poolID) = @_;
	moveCard(
		\@{$sessions{$sessionID}{"users"}{$userID}->{hands}{$handID}->{cards}}, $cardIndex,
		\@{$sessions{$sessionID}{"pools"}{$poolID}->{cards}},0
	);
}

sub delUser {
	my ($sessionID,$userID) = @_;
	my @hands = getHands($sessions{$sessionID}{"users"}{$userID}->{hands});
	for (@hands) {
		delHand($sessionID,$userID,$_);
	}
	$sessions{$sessionID}{"users"}{$userID} = undef;
}

sub getDeckSize {
	my ($sessionID, $deckID) = @_;
	return length $sessions{$sessionID}{"decks"}{$deckID}->{cards};
}

########################Game Logic ends here#############################

#########################Server Logic below##############################

my $origin = 'ws://localhost';

sub joinSession {
}

my $server = Net::WebSocket::Server->new(
    listen => 8080,
    on_connect => sub {
        my ($serv, $conn) = @_;
        $conn->on(
	    handshake => sub {
	    	my ($conn,$handshake) = @_;
		$conn->{"initHand"} = $handshake;
	    },
            ready => sub {
                my ($conn) = @_;
		#strip the / off of the resource request and then assign just the request to $session
		#Check for game ID, if none generate one and send it then disconnect.
		#Check for user ID, if none $conn->disconnect("noid",generateUser());
            },
            utf8 => sub {
                my ($conn, $msg) = @_;
		my $sessionID = $conn->{"currentSession"}{"id"};
		my $messageData = "";
		eval { $messageData = from_json($msg) };
		if ($@) { $conn->send_utf8('{"error":1, "message":"ERROR: Invalid json"}'); return 0;}
            },
	    disconnect => sub {
		my ($conn, $code, $reason) = @_;
	    }
	);
    }
);

$server->start;