bluesaxman/deckard-and-company
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fixed all syntax issues, still needs functional tests.

Browse Source
This commit is contained in:
bluesaxman 2020-09-03 12:05:01 -06:00
parent 2671799407
commit 1181c3a2e8
1 changed files with 18 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
Server/server.pl
View File

@ -29,7 +29,7 @@ sub generateSession {
} }
sub generateDeck { sub generateDeck {
$DDF = from_json(shift); my $DDF = from_json(shift);
# Add proper handling for reading of DDFs # Add proper handling for reading of DDFs
} }
@ -38,8 +38,8 @@ sub shuffle {
my $index = 0; my $index = 0;
for (@deck) { for (@deck) {
my $swapCardIndex = floor(rand() * @deck); my $swapCardIndex = floor(rand() * @deck);
my $swapCard = @deck[$swapCardIndex]; my $swapCard = $deck[$swapCardIndex];
@deck[$swapCardIndex] = $_; $deck[$swapCardIndex] = $_;
$deck[$index] = $swapCard; $deck[$index] = $swapCard;
$index++; $index++;
} }
@ -48,7 +48,7 @@ sub shuffle {
sub addUser { sub addUser {
my ($sessionID,$userID) = @_; my ($sessionID,$userID) = @_;
$sessions{$sessionID}{"users"}{$userID} = ( %{$sessions{$sessionID}{"users"}{$userID}} = (
name => "$userID", name => "$userID",
hands => () hands => ()
); );
@ -61,7 +61,7 @@ sub addCards {
sub addDeck { sub addDeck {
my ($sessionID,$deckID) = @_; my ($sessionID,$deckID) = @_;
$sessions{$sessionID}{"decks"}{$deckID} = ( name => "$deckID", cards => [] ); %{$sessions{$sessionID}{"decks"}{$deckID}} = ( name => "$deckID", cards => [] );
} }
sub delDeck { sub delDeck {
@ -76,15 +76,15 @@ sub uploadDDF {
sub addPool { sub addPool {
my ($sessionID,$poolID) = @_; my ($sessionID,$poolID) = @_;
$sessions{$sessionID}{"pools"}{$poolID} = ( name => "$poolID", cards => [] ); %{$sessions{$sessionID}{"pools"}{$poolID}} = ( name => "$poolID", cards => [] );
} }
sub reapCards { sub reapCards {
my $arrayRef = @_[0]; my $arrayRef = $_[0];
my @reapedCards = []; my @reapedCards = [];
print "Reaping cards"; print "Reaping cards";
while(@{$arrayRef}) { while(@{$arrayRef}) {
push(@reapedCards,shift(@{$arrayRef})): push(@reapedCards,shift(@{$arrayRef}));
print "."; print ".";
} }
print "Done\n"; print "Done\n";
@ -99,23 +99,23 @@ sub delPool {
} }
sub getUsers { sub getUsers {
my $sessionID = @_[0]; my $sessionID = $_[0];
return keys $sessions{$sessionID}{"users"}; return keys %{$sessions{$sessionID}{"users"}};
} }
sub getDecks { sub getDecks {
my $sessionID = @_[0]; my $sessionID = $_[0];
return keys $sessions{$sessionID}{"decks"}; return keys %{$sessions{$sessionID}{"decks"}};
} }
sub getPools { sub getPools {
my $sessionID = @_[0]; my $sessionID = $_[0];
return keys $sessions{$sessionID}{"pools"}; return keys %{$sessions{$sessionID}{"pools"}};
} }
sub addHand { sub addHand {
my ($sessionID, $userID, $handID) = @_; my ($sessionID, $userID, $handID) = @_;
$sessions{$sessionID}{"users"}{$userID}->{hands}{$handID} = ( cards => [] ); %{$sessions{$sessionID}{"users"}{$userID}->{hands}{$handID}} = ( cards => [] );
} }
sub delHand { sub delHand {
@ -127,7 +127,7 @@ sub delHand {
sub getHands { sub getHands {
my ($sessionID, $userID) = @_; my ($sessionID, $userID) = @_;
return keys $sessions{$sessionID}{"users"}{$userID}->{hands}; return keys %{$sessions{$sessionID}{"users"}{$userID}->{hands}};
} }
sub moveCard { sub moveCard {
@ -198,10 +198,9 @@ my $server = Net::WebSocket::Server->new(
}, },
disconnect => sub { disconnect => sub {
my ($conn, $code, $reason) = @_; my ($conn, $code, $reason) = @_;
}
} }
); );
}, }
); );
$server->start; $server->start;