#!/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, "connections" => {}, "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) = @_; if (grep( /$userID/, keys %{$sessions{$sessionID}{"users"}})) { print "ERROR: Duplicate user\n"; return 0; } $sessions{$sessionID}{"users"}{$userID} = { name => "$userID", hands => {} }; addHand($sessionID,$userID,"default"); return 1; } 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 delPool { my ($sessionID,$poolID) = @_; my @reapedCards = splice(@{$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 = splice(@{$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 scalar @{$sessions{$sessionID}{"decks"}{$deckID}->{cards}}; } sub getPoolTop { my ($sessionID, $poolID) = @_; return @{$sessions{$sessionID}{"pools"}{$poolID}->{cards}}[0]; } ########################Game Logic ends here############################# #########################Server Logic below############################## my $origin = 'ws://localhost'; sub joinSession { my ($sessionID, $userID) = @_; unless (defined($sessions{$sessionID})) { print $sessionID." does not exsist, attempting to create...\n"; if (generateSession($sessionID)) { print "Session ".$sessionID." has been created.\n"; } else { print "ERROR: Could not create session ".$sessionID."\n"; return 0; } } unless (addUser($sessionID,$userID)) { #assume rejoining user } return 1; } 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) = @_; $conn->send_utf8('{"request":"user"}'); $conn->send_utf8('{"request":"session"}'); }, utf8 => sub { my ($conn, $msg) = @_; my $sessionID = $conn->{"currentSession"}{"id"}; my $messageData = ""; eval { $messageData = from_json($msg) }; if ($@) { $conn->send_utf8('{"error":100, "message":"ERROR: Invalid json"}'); return 0;} if (defined($messageData->{user})) { $conn->{user} = $messageData->{user}; # Need to check if userID is unique $conn->send_utf8('{"info":"user success"}'); } if (defined($messageData->{session})) { unless(defined($conn->{user})) { $conn->send_utf8('{"error":200, "message":"Could not join session, no user defined", "request":"user"}'); $conn->send_utf8('{"request":"session"}'); return 0; } $conn->{session} = $messageData->{session}; $conn->send_utf8('{"info":"session success", "request":"join"}'); } if (defined($messageData->{action})) { if ($messageData->{action} =~ /join/ ) { if (joinSession($conn->{session},$conn->{user})) { $conn->send_utf8('{"info":"join success", "request":"update"}'); } } if ($messageData->{action} =~ /update/ ) { my $sessionID = $conn->{session}; for ($conn->server->connections) { if ($_->{session} == $conn->{session}) { #This might be a lot to do at once, might need to break it up in the future. # Update all connections joined to this session. # User List my @users = getUsers($sessionID); my @userNames; my $current = $_; for (@users) { push(@userNames,getUserName($sessionID,$_)); } $current->send_utf8('{"users":["'.join('","',@userNames).'"]}'); # Deck List my @decks = getDecks($sessionID); my %deckStats = (); for (@decks) { $deckStats{$_}{name} = $sessions{$sessionID}{"decks"}{$_}{name}; $deckStats{$_}{size} = getDeckSize($sessionID,$_); } $current->send_utf8('{"decks":'.to_json(\%deckStats).'}'); # Pool List my @pools = getPools($sessionID); my %poolStats = (); for (@pools) { $poolStats{$_}{name} = $sessions{$sessionID}{"pools"}{$_}{name}; $poolStats{$_}{top} = getPoolTop($sessionID,$_); } $current->send_utf8('{"pools":'.to_json(\%poolStats).'}'); # Users Hands my @hands = getHands($sessionID,$_->{user}); my %handStats = (); for (@hands) { $handStats{$_}{name} = $_; $handStats{$_}{cards} = []; } $current->send_utf8('{"hands":'.to_json(\%handStats).'}'); # for each hand for (@hands) { my $handID = $_; my @hand = @{$sessions{$sessionID}{"users"}{$current->{user}}{hands}{$handID}{cards}}; # each card (so we scale better) if (@hand) { for (@hand) { my $card = $_; $current->send_utf8('{"action":"addCard","hand":"'.$handID.'", "card":"'.$card.'"}'); }} } }}} if ($messageData->{action} =~ /draw/) { drawCard($conn->{session},$messageData->{deck},$conn->{user},$messageData->{hand}); $conn->send_utf8('{"info":"card drawn", "request":"update"}'); } if ($messageData->{action} =~ /play/) { playCard($conn->{session},$conn->{user},$messageData->{hand},$messageData->{cardID},$messageData->{pool}); $conn->send_utf8('{"info":"card played", "request":"update"}'); } if ($messageData->{action} =~ /clear/) { my @cards = delPool($conn->{session},$messageData->{pool}); addCards($conn->{session},$messageData->{deck},\@cards); addPool($conn->{session},$messageData->{pool}); $conn->send_utf8('{"info":"pool cleared", "request":"update"}'); } } }, disconnect => sub { my ($conn, $code, $reason) = @_; } ); } ); my $ses = generateSession(50); addDeck($ses,"default"); my @tCards = generateDeck('[{"data":["Male ","Female "]},{"data":["Ardvark ","Platipus ","Cat "]},{"data":["Jumping","Falling","Flying"]}]'); addCards($ses,"default",\@tCards); addPool($ses,"default"); addUser($ses,"Sergiy"); drawCard($ses,"default","Sergiy","default"); drawCard($ses,"default","Sergiy","default"); playCard($ses,"Sergiy","default",0,"default"); $server->start;