Fixed all syntax issues, still needs functional tests.
This commit is contained in:
parent
2671799407
commit
1181c3a2e8
@ -29,7 +29,7 @@ sub generateSession {
|
||||
}
|
||||
|
||||
sub generateDeck {
|
||||
$DDF = from_json(shift);
|
||||
my $DDF = from_json(shift);
|
||||
# Add proper handling for reading of DDFs
|
||||
}
|
||||
|
||||
@ -38,8 +38,8 @@ sub shuffle {
|
||||
my $index = 0;
|
||||
for (@deck) {
|
||||
my $swapCardIndex = floor(rand() * @deck);
|
||||
my $swapCard = @deck[$swapCardIndex];
|
||||
@deck[$swapCardIndex] = $_;
|
||||
my $swapCard = $deck[$swapCardIndex];
|
||||
$deck[$swapCardIndex] = $_;
|
||||
$deck[$index] = $swapCard;
|
||||
$index++;
|
||||
}
|
||||
@ -48,7 +48,7 @@ sub shuffle {
|
||||
|
||||
sub addUser {
|
||||
my ($sessionID,$userID) = @_;
|
||||
$sessions{$sessionID}{"users"}{$userID} = (
|
||||
%{$sessions{$sessionID}{"users"}{$userID}} = (
|
||||
name => "$userID",
|
||||
hands => ()
|
||||
);
|
||||
@ -61,7 +61,7 @@ sub addCards {
|
||||
|
||||
sub addDeck {
|
||||
my ($sessionID,$deckID) = @_;
|
||||
$sessions{$sessionID}{"decks"}{$deckID} = ( name => "$deckID", cards => [] );
|
||||
%{$sessions{$sessionID}{"decks"}{$deckID}} = ( name => "$deckID", cards => [] );
|
||||
}
|
||||
|
||||
sub delDeck {
|
||||
@ -76,15 +76,15 @@ sub uploadDDF {
|
||||
|
||||
sub addPool {
|
||||
my ($sessionID,$poolID) = @_;
|
||||
$sessions{$sessionID}{"pools"}{$poolID} = ( name => "$poolID", cards => [] );
|
||||
%{$sessions{$sessionID}{"pools"}{$poolID}} = ( name => "$poolID", cards => [] );
|
||||
}
|
||||
|
||||
sub reapCards {
|
||||
my $arrayRef = @_[0];
|
||||
my $arrayRef = $_[0];
|
||||
my @reapedCards = [];
|
||||
print "Reaping cards";
|
||||
while(@{$arrayRef}) {
|
||||
push(@reapedCards,shift(@{$arrayRef})):
|
||||
push(@reapedCards,shift(@{$arrayRef}));
|
||||
print ".";
|
||||
}
|
||||
print "Done\n";
|
||||
@ -99,23 +99,23 @@ sub delPool {
|
||||
}
|
||||
|
||||
sub getUsers {
|
||||
my $sessionID = @_[0];
|
||||
return keys $sessions{$sessionID}{"users"};
|
||||
my $sessionID = $_[0];
|
||||
return keys %{$sessions{$sessionID}{"users"}};
|
||||
}
|
||||
|
||||
sub getDecks {
|
||||
my $sessionID = @_[0];
|
||||
return keys $sessions{$sessionID}{"decks"};
|
||||
my $sessionID = $_[0];
|
||||
return keys %{$sessions{$sessionID}{"decks"}};
|
||||
}
|
||||
|
||||
sub getPools {
|
||||
my $sessionID = @_[0];
|
||||
return keys $sessions{$sessionID}{"pools"};
|
||||
my $sessionID = $_[0];
|
||||
return keys %{$sessions{$sessionID}{"pools"}};
|
||||
}
|
||||
|
||||
sub addHand {
|
||||
my ($sessionID, $userID, $handID) = @_;
|
||||
$sessions{$sessionID}{"users"}{$userID}->{hands}{$handID} = ( cards => [] );
|
||||
%{$sessions{$sessionID}{"users"}{$userID}->{hands}{$handID}} = ( cards => [] );
|
||||
}
|
||||
|
||||
sub delHand {
|
||||
@ -127,7 +127,7 @@ sub delHand {
|
||||
|
||||
sub getHands {
|
||||
my ($sessionID, $userID) = @_;
|
||||
return keys $sessions{$sessionID}{"users"}{$userID}->{hands};
|
||||
return keys %{$sessions{$sessionID}{"users"}{$userID}->{hands}};
|
||||
}
|
||||
|
||||
sub moveCard {
|
||||
@ -198,10 +198,9 @@ my $server = Net::WebSocket::Server->new(
|
||||
},
|
||||
disconnect => sub {
|
||||
my ($conn, $code, $reason) = @_;
|
||||
}
|
||||
}
|
||||
);
|
||||
},
|
||||
);
|
||||
}
|
||||
);
|
||||
|
||||
$server->start;
|
||||
|
Loading…
x
Reference in New Issue
Block a user