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) { my $uniquifyer = sprintf("%.0f",rand()*1000); $newSession = time.$uniquifyer; }
	if ( grep( /$newSession/, keys %sessions ) ) {
		return 0 #failur to create session
	} else {
		print "Adding session ".$newSession." to database\n";
		$sessions{$newSession} = {
			"id" => $newSession,
			"users" => {},
			"decks" => {},
			"pools" => {},
		};

	}
	return $newSession;
}

sub generateSingle {
	my $DDF = shift;
	my @cards = ("");
	for (@$DDF) {
		my @tempcards = ();
		my %datablock = %$_;
		for (@cards) {
			my $current = $_;
			for (@{$datablock{data}}) {
				push(@tempcards,$current.$_);
			}
		}
		@cards = @tempcards;
	}
	return @cards;
}

sub generateDeck {
	my $DDF = from_json(shift);
	if ("ARRAY" eq ref($DDF->[0])) {
		my @deck = ();
		for (@$DDF) {
			push(@deck,generateSingle($_));
		}
		return @deck;
	} else {
		return generateSingle($DDF);
	}
}

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 shuffleDeck {
	my ($sessionID, $deckID) = @_;
	my @cards = @{$sessions{$sessionID}{"decks"}{$deckID}->{cards}};
	$sessions{$sessionID}{"decks"}{$deckID}->{cards} = shuffle(@cards);
}

sub shufflePool {
	my ($sessionID, $poolID) = @_;
	my @cards = @{$sessions{$sessionID}{"pools"}{$poolID}->{cards}};
	@{$sessions{$sessionID}{"pools"}{$poolID}->{cards}} = shuffle(@cards);;
}

sub shuffleHand {
	my ($sessionID, $userID, $handID) = @_;
	my @cards = @{$sessions{$sessionID}{"users"}{$userID}->{hands}{$handID}->{cards}};
	$sessions{$sessionID}{"users"}{$userID}->{hands}{$handID}->{cards} = shuffle(@cards);
}

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

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) = @_;
	delete($sessions{$sessionID}{"decks"}{$deckID});
}

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\nReaped:";
	print join(", ",@reapedCards)."\n";
	return @reapedCards;
}

sub delPool {
	my ($sessionID,$poolID) = @_;
	my @reapedCards = reapCards(\@{$sessions{$sessionID}{"pools"}{$poolID}->{cards}});
	delete($sessions{$sessionID}{"pools"}{$poolID});
	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 getDeckName {
	my ($sessionID, $deckID) = @_;
	return $sessions{$sessionID}{"decks"}{$deckID}{name};
}

sub getUserName {
	my ($sessionID, $userID) = @_;
	return $sessions{$sessionID}{"users"}{$userID}{name};
}

sub getPoolName {
	my ($sessionID, $poolID) = @_;
	return $sessions{$sessionID}{"pools"}{$poolID}{name};
}

sub renameDeck {
	my ($sessionID, $deckID, $newName) = @_;
	unless (defined($newName)) { return print "ERROR: No name provided"; }
	$sessions{$sessionID}{"decks"}{$deckID}{name} = $newName;
}

sub renameUser {
	my ($sessionID, $userID, $newName) = @_;
	unless (defined($newName)) { return print "ERROR: No name provided"; }
	$sessions{$sessionID}{"users"}{$userID}{name} = $newName;
}

sub renamePool {
	my ($sessionID, $poolID, $newName) = @_;
	unless (defined($newName)) { return print "ERROR: No name provided"; }
	$sessions{$sessionID}{"pools"}{$poolID}{name} = $newName;
}

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}});
	delete($sessions{$sessionID}{"users"}{$userID}{hands}{$handID});
	return @leftoverCards;
}

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

sub moveCard {
	my ($originStackRef, $originIndex, $destStackRef, $destIndex) = @_;
	unless(defined($originStackRef)) { return print "ERROR: No Origin Stack\n"; }
	unless(defined($originIndex)) { return print "ERROR: No Origin Index\n"; }
	unless(defined($destStackRef)) { return print "ERROR: No Destination Stack\n"; }
	unless(defined($destIndex)) { return print "ERROR: No Destination Index\n"; }
	my $card = splice(@$originStackRef,$originIndex,1);
	unless(defined($card)) { return print "ERROR: No Card available to be pulled\n"; }
	splice(@$destStackRef,$destIndex,0,$card);
}

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($sessionID,$userID);
	my @reaped = ();
	for (@hands) {
		push(@reaped,delHand($sessionID,$userID,$_));
	}
	delete($sessions{$sessionID}{"users"}{$userID});
	return @reaped;
}

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;