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

tested all functions and fixed reference and logic issues

Browse Source
This commit is contained in:
bluesaxman 2020-09-07 08:53:16 -06:00
parent df4572115f
commit f73049a854
1 changed files with 53 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

78
Server/server.pl
View File

@ -13,16 +13,17 @@ my %sessions = ();
sub generateSession {
my $newSession = shift;
unless (defined $newSession) { $newSession = time; }
unless (defined $newSession) { my $uniquifyer = sprintf("%.0f",rand()*1000); $newSession = time.$uniquifyer; }
if ( grep( /$newSession/, keys %sessions ) ) {
generateSession();
return 0 #failur to create session
} else {
print "Adding session ".$newSession." to database\n";
$sessions{$newSession} = ();
$sessions{$newSession}{"id"} = $newSession;
$sessions{$newSession}{"users"} = ();
$sessions{$newSession}{"decks"} = ();
$sessions{$newSession}{"pools"} = ();
$sessions{$newSession} = {
"id" => $newSession,
"users" => {},
"decks" => {},
"pools" => {},
};
}
return $newSession;
@ -68,15 +69,34 @@ sub shuffle {
$deck[$index] = $swapCard;
$index++;
}
return @deck;
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}} = (
$sessions{$sessionID}{"users"}{$userID} = {
name => "$userID",
hands => ()
);
hands => {}
};
addHand($sessionID,$userID,"default");
}
sub addCards {
@ -86,12 +106,12 @@ sub addCards {
sub addDeck {
my ($sessionID,$deckID) = @_;
%{$sessions{$sessionID}{"decks"}{$deckID}} = ( name => "$deckID", cards => [] );
$sessions{$sessionID}{"decks"}{$deckID} = { name => "$deckID", cards => [] };
}
sub delDeck {
my ($sessionID,$deckID) = @_;
$sessions{$sessionID}{"decks"}{$deckID} = undef;
delete($sessions{$sessionID}{"decks"}{$deckID});
}
sub uploadDDF {
@ -101,25 +121,26 @@ 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 @reapedCards = [];
my @reapedCards = ();
print "Reaping cards";
while(@{$arrayRef}) {
push(@reapedCards,shift(@{$arrayRef}));
print ".";
}
print "Done\n";
print "Done\nReaped:";
print join(", ",@reapedCards)."\n";
return @reapedCards;
}
sub delPool {
my ($sessionID,$poolID) = @_;
my @reapedCards = reapCards(\@{$sessions{$sessionID}{"pools"}{$poolID}->{cards}});
$sessions{$sessionID}{"pools"}{$poolID} = undef;
delete($sessions{$sessionID}{"pools"}{$poolID});
return @reapedCards;
}
@ -140,32 +161,37 @@ sub getPools {
sub addHand {
my ($sessionID, $userID, $handID) = @_;
%{$sessions{$sessionID}{"users"}{$userID}->{hands}{$handID}} = ( cards => [] );
$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;
delete($sessions{$sessionID}{"users"}{$userID}{hands}{$handID});
return @leftoverCards;
}
sub getHands {
my ($sessionID, $userID) = @_;
return keys %{$sessions{$sessionID}{"users"}{$userID}->{hands}};
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
$sessions{$sessionID}{"decks"}{$deckID}->{cards}, 0,
$sessions{$sessionID}{"users"}{$userID}->{hands}{$handID}->{cards}, 0
);
}
@ -179,11 +205,13 @@ sub playCard {
sub delUser {
my ($sessionID,$userID) = @_;
my @hands = getHands($sessions{$sessionID}{"users"}{$userID}->{hands});
my @hands = getHands($sessionID,$userID);
my @reaped = ();
for (@hands) {
delHand($sessionID,$userID,$_);
push(@reaped,delHand($sessionID,$userID,$_));
}
$sessions{$sessionID}{"users"}{$userID} = undef;
delete($sessions{$sessionID}{"users"}{$userID});
return @reaped;
}
sub getDeckSize {