Purl said:
Ala Qumsieh wrote:
Not at all, I consider yours and others to be laughable
displays of extreme ignorance, bigotry and hatred.
Stated before, I am proud to not be like you.
Purl Gurl
what does this show?
#!perl
# Written by Purl Gurl - (e-mail address removed)
# Please do not email questions. I do not offer
# support for free scripts.
# Post your questions to: comp.lang.perl.misc
# Be sure to carefully read my "readme.txt" in my downloaded zip package.
# Relative URL paths are used. Those should be changed to full URL paths
# to ensure all browsers will work with this script.
# Begin of code. Modifications beyond here are your responsibility.
# Safeguard against excessive content length. Maximum content length
# usually generated by my poker script is 3843. This will change
# should you modified this script. 6000 bytes is default.
if ($ENV{'CONTENT_LENGTH'} > 6000)
{ print "Content-type: text/html\n\n<HTML><H1>Excessive Content Length</H1></HTML>"; exit; }
our %in;
{
my ($in, @in, $iterate, $key, $value);
read (STDIN, $in, $ENV{'CONTENT_LENGTH'});
@in = split (/&/, $in);
foreach $iterate (0 .. $#in)
{
$in[$iterate] =~ s/\+/ /g;
($key, $value) = split (/=/, $in[$iterate], 2);
($value eq "") && next;
$key =~ s/%(..)/pack ("c",hex($1))/ge;
$value =~ s/%(..)/pack ("c",hex($1))/ge;
$in{$key} .= $value;
}
}
# Default amount of player cash:
if (!($in{Player_Cash}))
{ $in{Player_Cash} = "500"; }
if (!($in{Aholhtina}))
{
my (@Deck) = qw (12d 12h 12s 12c 13d 13h 13s 13c
14d 14h 14s 14c 15d 15h 15s 15c
16d 16h 16s 16c 17d 17h 17s 17c
18d 18h 18s 18c 19d 19h 19s 19c
20d 20h 20s 20c 21d 21h 21s 21c
22d 22h 22s 22c 23d 23h 23s 23c
24d 24h 24s 24c);
for (1 .. 3)
{
for (1 .. @Deck)
{ push (@Deck, splice (@Deck, int (rand (@Deck)), 1)); }
}
$in{"Deck"} = "@Deck";
&Log;
}
$in{Aholhtina}++;
# Set Frequency Of Logging Based On Number Of Hands Played.
# Default is logging every four (five minus one) hands:
if ($in{Aholhtina} == 5)
{
$in{Aholhtina} = 1;
&Log;
}
if ($in{Deal_Two} ne "deal_two")
{
&Card_Select;
$in{Card_One} = $card;
&Card_Select;
$in{Card_Two} = $card;
&Card_Select;
$in{Card_Three} = $card;
&Card_Select;
$in{Card_Four} = $card;
&Card_Select;
$in{Card_Five} = $card;
&Poker_URL;
$poker_out = "
You Have <FONT SIZE=+1> $in{Player_Cash} </FONT> Bucks In My Gambling Bank.
<BR><BR>
<CENTER>
<IMG SRC=\"$card_one_url\">
<IMG SRC=\"$card_two_url\">
<IMG SRC=\"$card_three_url\">
<IMG SRC=\"$card_four_url\">
<IMG SRC=\"$card_five_url\">
</FONT></CENTER>";
$poker_out2 = "
HOLD
HOLD
HOLD
HOLD
HOLD
<BR><FONT SIZE=\"2\">
<INPUT TYPE=\"radio\" NAME=\"Card1\" VALUE=\"yes\" \"checked\">Y
<INPUT TYPE=\"radio\" NAME=\"Card1\" VALUE=\"no\">N
<INPUT TYPE=\"radio\" NAME=\"Card2\" VALUE=\"yes\" \"checked\">Y
<INPUT TYPE=\"radio\" NAME=\"Card2\" VALUE=\"no\">N
<INPUT TYPE=\"radio\" NAME=\"Card3\" VALUE=\"yes\" \"checked\">Y
<INPUT TYPE=\"radio\" NAME=\"Card3\" VALUE=\"no\">N
<INPUT TYPE=\"radio\" NAME=\"Card4\" VALUE=\"yes\" \"checked\">Y
<INPUT TYPE=\"radio\" NAME=\"Card4\" VALUE=\"no\">N
<INPUT TYPE=\"radio\" NAME=\"Card5\" VALUE=\"yes\" \"checked\">Y
<INPUT TYPE=\"radio\" NAME=\"Card5\" VALUE=\"no\">N
<p>
<INPUT TYPE=\"hidden\" NAME=\"Card_One\" VALUE=\"$in{Card_One}\">
<INPUT TYPE=\"hidden\" NAME=\"Card_Two\" VALUE=\"$in{Card_Two}\">
<INPUT TYPE=\"hidden\" NAME=\"Card_Three\" VALUE=\"$in{Card_Three}\">
<INPUT TYPE=\"hidden\" NAME=\"Card_Four\" VALUE=\"$in{Card_Four}\">
<INPUT TYPE=\"hidden\" NAME=\"Card_Five\" VALUE=\"$in{Card_Five}\">
<INPUT TYPE=\"hidden\" NAME=\"Deal_Two\" VALUE=\"deal_two\">";
}
if ($in{Deal_Two} eq "deal_two")
{ # Deal Two
my ($pair_one, $pair_two);
my $tossed_card = 0;
if ($in{Card1} eq "no")
{
$tossed_card++;
&Card_Select;
$in{Card_One} = $card;
}
if ($in{Card2} eq "no")
{
$tossed_card++;
&Card_Select;
$in{Card_Two} = $card;
}
if ($in{Card3} eq "no")
{
$tossed_card++;
&Card_Select;
$in{Card_Three} = $card;
}
if ($in{Card4} eq "no")
{
$tossed_card++;
&Card_Select;
$in{Card_Four} = $card;
}
if ($in{Card5} eq "no")
{
$tossed_card++;
&Card_Select;
$in{Card_Five} = $card;
}
my (@Ascending) = ();
$Ascending[0] = substr ($in{Card_One}, 0, 2);
$Ascending[1] = substr ($in{Card_Two}, 0, 2);
$Ascending[2] = substr ($in{Card_Three}, 0, 2);
$Ascending[3] = substr ($in{Card_Four}, 0, 2);
$Ascending[4] = substr ($in{Card_Five}, 0, 2);
@Ascending = sort (@Ascending);
my $ascending = "@Ascending";
my $win = "lose";
my (@Four_Kind) = ("12 12 12 12:Twos", "13 13 13 13:Threes", "14 14 14 14:Fours", "15 15 15 15:Fiv
es",
"16 16 16 16:Sixes", "17 17 17 17:Sevens", "18 18 18 18:Eights", "19 19 19 19:N
ines",
"20 20 20 20:Tens", "21 21 21 21:Jacks", "22 22 22 22:Queens", "23 23 23 23:Kin
gs",
"24 24 24 24:Aces");
my (@Three_Kind) = ("12 12 12:Twos", "13 13 13:Threes", "14 14 14:Fours", "15 15 15:Fives", "16 16
16:Sixes",
"17 17 17:Sevens", "18 18 18:Eights", "19 19 19:Nines", "20 20 20:Tens", "21 2
1 21:Jacks",
"22 22 22:Queens", "23 23 23:Kings", "24 24 24:Aces");
my (@Two_Kind) = ("12 12:Twos", "13 13:Threes", "14 14:Fours", "15 15:Fives", "16 16:Sixes", "17 1
7:Sevens",
"18 18:Eights", "19 19:Nines", "20 20:Tens", "21 21:Jacks", "22 22:Queens", "23
23:Kings",
"24 24:Aces");
my (@Straight) = ("12 13 14 15 16:Six High", "13 14 15 16 17:Seven High", "14 15 16 17 18:Eight Hi
gh",
"15 16 17 18 19:Nine High", "16 17 18 19 20:Ten High", "17 18 19 20 21:Jack High
",
"18 19 20 21 22:Queen High", "19 20 21 22 23:King High", "20 21 22 23 24:Ace Hig
h",
"12 13 14 15 24:Low Ace");
my (
@flush) = ("ccccc:Club", "ddddd
iamond", "hhhhh:Heart", "sssss:Spade");
for (@Four_Kind)
{
my ($key, $value) = split (/:/, $_);
if (index ($ascending, $key) > -1)
{ $win = "Four Of A Kind! Four $value"; last; }
}
if ($win eq "lose")
{
for (@Three_Kind)
{
my ($key, $value) = split (/:/, $_);
if (index ($ascending, $key) > -1)
{
$win = "Three Of A Kind! Three $value";
$ascending =~ s/$key//;
last;
}
}
if (index ($win, "Three") > -1)
{
for (@Two_Kind)
{
my ($key, $value) = split (/:/, $_);
if (index ($ascending, $key) > -1)
{
my $pair_one = $value;
$win = "Full House! $win And A Pair Of $pair_one";
}
}
}
else
{
for (@Two_Kind)
{
my ($key, $value) = split (/:/, $_);
if (index ($ascending, $key) > -1)
{
$pair_one = $value;
$ascending =~ s/$key//;
if (($pair_one eq "Aces") || ($pair_one eq "Kings") ||
($pair_one eq "Queens") || ($pair_one eq "Jacks"))
{ $win = "A Pair Of $pair_one"; }
last;
}
}
for (@Two_Kind)
{
my ($key, $value) = split (/:/, $_);
if (index ($ascending, $key) > -1)
{
$pair_two = $value;
$win ="Two Pairs! A Pair Of $pair_one And A Pair Of $pair_two";
}
}
} # else
} # if not four kind
if ($win eq "lose")
{
for (@Straight)
{
my ($key, $value) = split (/:/, $_);
if (index ($ascending, $key) > -1)
{ $win = "A $value straight!"; last; }
$win =~ s/A (Ace|Eight)/An $1/;
}
}
my ($flush1, $flush2, $flush3, $flush4, $flush5, $flush_string);
$flush1 = substr ($in{Card_One}, 2, 1);
$flush2 = substr ($in{Card_Two}, 2, 1);
$flush3 = substr ($in{Card_Three}, 2, 1);
$flush4 = substr ($in{Card_Four}, 2, 1);
$flush5 = substr ($in{Card_Five}, 2, 1);
$flush_string = join ("", $flush1, $flush2, $flush3, $flush4, $flush5);
for (
@flush)
{
my ($key, $value) = split (/:/, $_);
if (index ($flush_string, $key) > -1)
{
if ($win eq "Ace High")
{ $win = "Holy Poker Chips! An $win $value Royal Flush"; }
elsif ($win eq "Ace Low")
{ $win = "Holy Poker Chips! An $win $value Royal Flush"; }
elsif ($win ne "lose")
{ $win = "Wow! A $value $win Flush"; }
else
{ $win = "A Pretty $value Flush"; }
}
}
my $winner;
if ($win eq "lose")
{
$in{Player_Cash} = ($in{Player_Cash} - 10);
$winner = "You Lose. You Now Have <FONT SIZE=\"+1\"> $in{Player_Cash} </FONT> Bucks In My Gambli
ng Bank.";
}
else
{
$in{Player_Cash} = ($in{Player_Cash} + 10);
$winner = "You Win! $win! You Now Have <FONT SIZE=\"+1\"> $in{Player_Cash} </FONT> Bucks In My G
ambling Bank.";
}
&Poker_URL;
my $cards;
if ($tossed_card eq 1)
{ $cards = "Card" }
else
{ $cards = "Cards" }
$poker_out = "
You Drew $tossed_card $cards And Dealt This Hand:<BR><BR>
<CENTER>
<IMG SRC=\"$card_one_url\">
<IMG SRC=\"$card_two_url\">
<IMG SRC=\"$card_three_url\">
<IMG SRC=\"$card_four_url\">
<IMG SRC=\"$card_five_url\">
</CENTER><P><P><P><P><P>
$winner <BR>";
} # Deal Two
sub Poker_URL
{
# Set Path To Card Graphics:
my $poker_url = "cards/";
$card_one_url = join ("", $poker_url, $in{Card_One});
$card_two_url = join ("", $poker_url, $in{Card_Two});
$card_three_url = join ("", $poker_url, $in{Card_Three});
$card_four_url = join ("", $poker_url, $in{Card_Four});
$card_five_url = join ("", $poker_url, $in{Card_Five});
}
sub Card_Select
{
my (@Burnt) = split (/ /, $in{'Burnt'});
if (scalar (@Burnt) > 0)
{
for (@Burnt)
{ $in{"Deck"} =~ s/$_//; }
}
my (@Deck) = split (/ +/, $in{"Deck"});
do
{ $card = $Deck[rand(@Deck)]; }
until (index ($in{"Burnt"}, $card) == -1);
push (@Burnt, $card);
$in{'Burnt'} = "@Burnt";
$in{"Deck"} =~ s/$card//;
$in{"Deck"} =~ s/^ | $//;
$in{"Deck"} =~ s/ / /;
$card = join ("", $card, ".gif");
if (scalar (@Deck) < 5)
{
@Deck = qw (12d 12h 12s 12c 13d 13h 13s 13c
14d 14h 14s 14c 15d 15h 15s 15c
16d 16h 16s 16c 17d 17h 17s 17c
18d 18h 18s 18c 19d 19h 19s 19c
20d 20h 20s 20c 21d 21h 21s 21c
22d 22h 22s 22c 23d 23h 23s 23c
24d 24h 24s 24c);
# shuffle
for (1 .. 3)
{
for (1 .. @Deck)
{ push (@Deck, splice (@Deck, int (rand (@Deck)), 1)); }
}
$in{"Deck"} = "@Deck";
$in{"Burnt"} = "";
}
}
print "Content-type: text/html\n\n";
print "
<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">
<HTML><HEAD><TITLE>Poker</TITLE>
<META HTTP-EQUIV=\"Content-Type\" CONTENT=\"text/html; charset=ISO-8859-1\">
<META NAME=\"robots\" CONTENT=\"noindex,nofollow\"></HEAD>
<BODY BACKGROUND=\"cards/backdrop.jpg\" BGCOLOR=\"#c0c0c0\">
<BR>
<CENTER>
<FONT FACE=\"arial rounded mt bold\" COLOR=\"#000000\" SIZE=\"3\">
<IMG SRC=\"cards/poker.jpg\">
<FONT SIZE=\"+1\"><BR>
<I>Kira</I>
</FONT><BR>
= Professional Poker Player =
<HR SIZE=\"5\" WIDTH=\"39%\">
Five Card Draw = Nothing Wild = Jacks Or Better<BR>
Five Buck Ante = Five Buck Bet
<HR SIZE=\"5\" WIDTH=\"39%\">
$poker_out
<FORM ACTION=\"poker.cgi\" METHOD=\"post\">
$poker_out2
<FONT FACE=\"arial rounded mt bold\" COLOR=\"#000000\" SIZE=\"3\">
<INPUT TYPE=\"submit\" VALUE=\"Play Poker!\"></FONT>
<INPUT TYPE=\"hidden\" NAME=\"Player_Cash\" VALUE=\"$in{Player_Cash}\">
<INPUT TYPE=\"hidden\" NAME=\"Aholhtina\" VALUE=\"$in{Aholhtina}\">
<INPUT TYPE=\"hidden\" NAME=\"Deck\" VALUE=\"$in{Deck}\">
<INPUT TYPE=\"hidden\" NAME=\"Burnt\" VALUE=\"$in{'Burnt'}\">
</FORM>
<IMG SRC=\"cards/aniline.gif\">
<BR><BR>
<IMG SRC=\"cards/purlgurl.gif\">
</CENTER>
</BODY></HTML>";
sub Log
{
use Socket;
$ENV{REMOTE_HOST} = gethostbyaddr (inet_aton ($ENV{REMOTE_ADDR}), AF_INET);
# Set Path To Log File:
open(LOG,">>poker.log");
print LOG scalar localtime, " - POKER - CASH: $in{Player_Cash}
- DNS: $ENV{REMOTE_HOST} - IPA: $ENV{REMOTE_ADDR}
- System: $ENV{HTTP_USER_AGENT}";
if ($ENV{'HTTP_FORWARDED'})
{ print LOG "\n - Forwarded: $ENV{HTTP_FORWARDED}"; }
if ($ENV{'HTTP_X_FORWARDED_FOR'})
{ print LOG "\n - X-Forwarded: $ENV{HTTP_X_FORWARDED_FOR}"; }
if ($ENV{'HTTP_VIA'})
{ print LOG "\n - Proxy Via: $ENV{HTTP_VIA}"; }
if ($ENV{'HTTP_PROXY_CONNECTION'})
{ print LOG "\n - Connection: $ENV{HTTP_PROXY_CONNECTION}"; }
if ($ENV{'HTTP_CLIENT_IP'})
{ print LOG "\n - Client IP: $ENV{HTTP_CLIENT_IP}"; }
if ($ENV{'HTTP_REFERER'})
{ print LOG "\n - Referral: $ENV{HTTP_REFERER}"; }
if ($ENV{'REMOTE_IDENT'})
{ print LOG "\n - Identity: $ENV{REMOTE_IDENT}"; }
if ($ENV{'REMOTE_USER'})
{ print LOG "\n - User: $ENV{REMOTE_USER}"; }
if ($ENV{'HTTP_FROM'})
{ print LOG "\n - From: $ENV{HTTP_FROM}"; }
print LOG "\n\n";
close (LOG);
}
