#!/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 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 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) = @_; my $card = splice(@$originStackRef,$originIndex,1); 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($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;