Perl Poker

Simon is a freelance programmer and author, whose titles include Beginning Perl (Wrox Press, 2000) and Extending and Embedding Perl (Manning Publications, 2002). He's the creator of over 30 CPAN modules and a former Parrot pumpking. Simon can be reached at simon@ simon-cozens.org.

It's not all work and no play at my company. In fact, the Northern Ireland Perl Mongers scene has been swept with somewhat of a poker craze recently. As well as trying to improve our own poker play, we've naturally had a look around at the state of computer poker research.

We found a great number of interesting things: online poker servers where humans and poker-playing robots could play against each other, papers on "pseudo-optimum strategy," evaluation algorithms, and examples in C and in Java—but nothing in Perl.

This needed to be fixed.

Getting Straight to Work

Thankfully, quite a few of the tools out there can be integrated pretty quickly into Perl without much effort. For starters, we can take Games::Cards as our card library. We'll make some revisions to it later so that it can handle more of the areas we need.

Another thing we'll need to do is have some means of evaluating what's a winning hand. The good news is, there's a GNU poker library (no, really), which does that for us, at http://pokersource .sourceforge.net/; the bad news is, it's in C.

Well, not a problem. It's time to dive into some XS as a simple way of linking these things together. We'll start by creating the framework for our module with h2xs:

% h2xs -A -n Games::Poker::HandEvaluator

and now we need to make sure that libpoker gets linked in, by telling the Makefile.PL about the library:

LIBS => '-lpoker'

Assuming that the poker library is correctly installed, this will be enough to link the library into our Perl module. We run Makefile.PL and do a make test to ensure everything's OK. If the library isn't correctly installed, you might see something like this:

Note (probably harmless): No library found for -lpoker

The "probably harmless" is a complete lie.

Now we have to write a little bit of glue code to expose the parts of the library's functionality that we're interested in. The hand-evaluation function for an ordinary deck of cards in standard (nonlowball) poker is called StdDeck_StdRules_EVAL_N. However, it expects to see a bitmask of the deck, and we don't really want to construct that bitmask ourselves. Instead, we borrow a function from the examples that ship with libpoker for turning a string into a bitmask. This function goes above the XS MODULE line in HandEvaluator.xs, as we're not going to need to call it from Perl.

int parse_cards(char *handstr, StdDeck_CardMask* cards) {
  char *p;
  int c = 0;
  int ncards = 0;
  char str[80];

  StdDeck_CardMask_RESET(*cards);
  strcpy(str, handstr);
  p = strtok(str, " ");

  do {
    if (DstringToCard(StdDeck, p, &c) == 0)
      return 0;
    if (!StdDeck_CardMask_CARD_IS_SET(*cards, c)) {
      StdDeck_CardMask_SET(*cards, c);
      ++ncards;
    };
  } while ((p = strtok(NULL, " ")) != NULL);
  return ncards;
}

Now we can wrap our evaluation function. This will take a string representing a hand of cards—for instance, Ah 7c Jd As 7h for two pair aces and sevens—and return an integer. The higher the integer, the better the hand:

int
_evaluate( hand );
    char* hand;
PREINIT:
    StdDeck_CardMask cards;
    int ncards;
CODE:
    ncards = parse_cards(hand, &cards);
    if (ncards) 
        RETVAL = StdDeck_StdRules_EVAL_N(cards, ncards);
    else
        RETVAL = 0;
OUTPUT:
    RETVAL

Of course, we often want an explanation of that integer (such as "Two Pair (A 7 J)"). The libpoker function StdRules_HandVal_toString fills a buffer with such an explanation, so we'll wrap that in an XS function called handval:

char*
handval( hval )
    int hval;
PREINIT:
  char buf[80];
  int n;
CODE:
  StdRules_HandVal_toString(hval, buf);
  RETVAL = buf; 
OUTPUT:
  RETVAL

We'll now write a wrapper function that can handle both an ordinary string and a Games::Card::CardSet object, so the module will not need changes when we integrate it with the rest of our poker modules. Games::Card::CardSet (and hence its derived classes) has a print method that nearly does what we want, but not quite. It prints out the hand like so:

Player 1:  2S   2C   3S   4D   6D   9C  10S

whereas we want

2S 2C 3S 4D 6D 9C TS

(Notice that libpoker expects "T" for ten)

This is nothing that a few regular expressions can't fix:

sub evaluate {
    my $hand = shift;
    if (UNIVERSAL::isa($hand, "Games::Cards::CardSet")) {
        $hand = $hand->print;
        $hand =~ s/.*://; $hand =~ s/\s+/ /g;
        $hand =~ s/10/T/g;
    }
    return 0 unless $hand;
    _evaluate($hand);
}

The mistake everyone makes at least once is to say $hand->isa, which fails badly if $hand is just an ordinary string—UNIVERSAL::isa is a good way of getting around the problem.

For My Next Trick...

And that's basically all we need to do for our hand-evaluation library. Now we'll turn our attention to the Online Poker Protocol, a mechanism designed by the folks at Alberta University, who have been doing a lot of work on computer poker.

Their protocol and servers allow computer players to pit their wits against humans. They play Texas Hold'em, a variant of poker where each player receives two cards of their own ("hold cards"), and then five community cards are dealt face down before all players ("the board"). The board is revealed in three stages, with a round of betting before each stage. The first stage is the "flop," where three of the board cards are revealed. Then comes a round of betting and the "turn," where another board card is turned over. After another round of betting, the final card is revealed on the "river." Then there is a final round of betting before all players' cards are turned over in the "showdown."

We'll begin by writing a simple client to allow us to play on the server, with a view to developing a computer player in the future.

The protocol is documented at the section on http://games.cs .ualberta.ca/webgames/poker/bots.html in the http: manpage, and is a binary TCP/IP communication protocol. Debugging binary protocols is not terribly easy and I needed some more information about how the protocol dealt with certain conditions, so I wrote a rather nice protocol analyzer, which I'm sure I'll tell you about next time.

We start by defining the protocol in terms Perl can understand. For instance, it makes sense to have the command names linked to their byte equivalent as constants, like so:

use constant JOIN_GAME => 20;

And we also maintain an array that specifies how the arguments are to be formatted. The protocol uses 4-byte integers and zero-terminated strings, so it seems reasonable to use the pack function to prepare data for transit. For instance, the JOIN_GAME command takes two strings (username and password) followed by an integer (protocol version) and another string (client identifier). The pack encoding of this would be Z*Z*NZ*:

$protocol[JOIN_GAME] = "Z*Z*NZ*";

Now we can write a function that can be called with the right arguments:

$self->send_packet(JOIN_GAME, 
                   "perlkibot", 
                   "sekrit", 
                   1,
                   "Games::Poker::OPP");

which packs this into a packet as specified by the protocol and sends it down to the server. We start by making sure that the message number is a valid part of the protocol:

sub send_packet {
    my ($self, $message_id, @data) = @_;
    croak sprintf "Protocol error: command 0x%x not recognised", 
        $message_id unless exists $protocol[$message_id];

and now we can simply use pack to transform the arguments:

if ($protocol[$message_id]) {
    eval { $packed_data = pack($protocol[$message_id], @data); };
    croak sprintf "Problem packing data for %d command", 
        $message_id if $@;
}

Now we have the arguments packed into $packed_data. The protocol specifies that we first send the message number as a 4-byte integer, followed by the length of the arguments (that's $packed_data) as a 4-byte integer:

my $packet = pack "NN", $message_id, length $packed_data;

Finally, we add on the arguments and send the packet out:

$packet .= $packed_data;
$self->put($packet);
return $packet;

Notice that we use another method, put, to actually put the data "on the wire." This gives us abstraction about how we do this—we might want to use IO::Socket::INET, or a POE wheel, or something else entirely. Similarly, we can write a helper function to retrieve a packet from the server, unpack the arguments in the same way, and return a message number and unpacked arguments.

After creating a standard constructor to hold the username, password, and server connection details, we can write an IO::Socket::INET implementation of the module like so:

sub connect {
    my $self = shift;
    $self->{socket} = IO::Socket::INET->new(
        PeerHost => $self->{server},
        PeerPort => $self->{port},
    );
}
sub put { my ($self, $what) = @_; $self->{socket}->syswrite($what); }
sub get {
    my ($self, $len) = @_;
    my $buf = " "x$len;
    my $newlen = $self->{socket}->sysread($buf, $len);
    return substr($buf,0,$newlen);
}

Now all the groundwork is finally done! Writing functions to actually speak the protocol is now a lot more straightforward:

sub joingame {
    my $self = shift;
    $self->send_packet(JOIN_GAME, $self->{username}, $self->{password},
        1, "Games::Poker::OPP");
    my ($status) = $self->get_packet();
    if ($status == GOODPASS) { return 1; } 
    elsif ($status == BADPASS) { return 0; } 
    else {
        croak sprintf "Protocol error: got %i from server", $status;
    }
}

Now we need to think about how to handle the game play itself. There are many ways to do this, but the way I decided upon was to provide a main loop function playgame, which calls user-defined callbacks to display status information and decide how to bet. To help the user writing these callbacks, we export some of the protocol constants, particularly those that represent actions that the player can make (e.g., FOLD, CHECK, RAISE, CALL).

I also decided to create an object to hold the game state. Since this is generic to Texas Hold'em and not specific to our protocol, I created a separate module called Games::Poker::TexasHold'em. (Yes, this is a gratuitous abuse of apostrophe-as-package-separator.) In the future, this module will be extended with functions to analyze hand potential, but for now, it just keeps track of the game.

I won't go into much detail about the TexasHold'em module, except to say that it can be used quite independently of the Online Poker Protocol module:

use Games::Poker::TexasHold'em;
my $game = Games::Poker::TexasHold'em->new(
    players => [
        { name => "lathos", bankroll => 500 },
        { name => "MarcBeth", bankroll => 500 },
        { name => "Hectate", bankroll => 500 },
        { name => "RichardIII", bankroll => 500 },
    ],
    button => "Hectate",
    bet => 10,
    limit => 50
);

$game->blinds;
$game->check; $game->bet(10); $game->call; $game->fold;
$game->fold;
$game->next_stage;
$game->check; $game->bet(20); $game->raise(40); $game->call;
$game->next_stage;
print $game->status;

This will print out:

Pot: 80 Stage: turn
?                 Name Bankroll  InPot
.               lathos $  470 $   30
F             MarcBeth $  490 $   10
F              Hectate $  490 $   10
            RichardIII $  470 $   30

Showing that all but lathos and RichardIII have folded, these two started madly throwing cash into the pot. (Which is, for those in the know, what usually happens in games...) We're currently in the turn, it's lathos' bet, and there's $80 in the pot.

playgame sits in a loop, looking for messages from the server and determining how to respond to them:

sub playgame {
    my $self = shift;
    $self->{game} = undef;

    while (my ($cmd, @data) = $self->get_packet()) {

A PING packet (which doesn't often get sent) needs to be replied immediately with a PONG, and that's all we need to do with it:

if ($cmd == PING) { $self->send_packet(PONG); next; }

And a GOODBYE packet should end the loop:

if ($cmd == GOODBYE) { last }

Anything that is purely advisory, such as chatter from other players or information from the server, gets handed to a user-defined status routine:

if ($cmd == CHATTER ||
    $cmd == INFORMATION) {
        $self->{status}->($self, $cmd, @data); next;
    }

playgame has a concept of the current game. If we join the room in the middle of an existing game, we may get sent messages that are not actually for our consumption. If we don't have anything in $self->{game}, then we ignore the message, unless, of course, it's the start of a new game:

next unless $self->{game} or $cmd == START_NEW_GAME;

Now we dispatch any command off to its appropriate handler, and also call the status routine so that the client gets the opportunity to display some message to the user:

if (exists $handlers[$cmd]) {
    $handlers[$cmd]->($self, $cmd, @data);
}
$self->{status}->($self, $cmd, @data);

These handlers are responsible for updating the Games::Poker::TexasHold'em object, and also for making the all-important callback to determine how the client should play!

But where do these handlers come from? Well, when we fill the @protocol array with the pack formats of the expected arguments, we also fill the @handlers array:

map {
     $protocol[$_->[0]] = $_->[1];
     $handlers[$_->[0]] = $_->[2] if $_->[2];
} (
[ START_NEW_GAME , "N5(Z*NN)*", \&new_game_handler ],
[ HOLE_CARDS , "NZ*", \&hole_card_handler ],
[ NEW_STAGE , "NZ*", \&next_stage_handler ],
[ NEXT_TO_ACT , "N4", \&next_turn_handler ],
[ FOLD , "NN", \&fold_handler ],
[ CALL , "NN", \&call_handler ],
...

This ensures that, for instance, when a player folds, the fold-handler routine is called:

sub fold_handler { shift->{game}->fold() }

And when it's someone's turn to play, the next_turn_handler gets called:

sub next_turn_handler {
    my ($self, $cmd, $who, $to_call, $min_bet, $max_bet) = @_;
    my $game = $self->{game};

It might be our turn to play—$who is set to a seat number, and if that seat number matches ours, then we need to call the callback and do what it tells us to:

# If it's me, make the callback
if ($who == $game->{seats}->{$self->{username}}) {
    my $action = $self->{callback}->($self, $to_call, $min_bet, $max_bet);
    return $self->send_packet(ACTION, $action);
}

And there is a slight discrepancy between how Games::Poker::TexasHold'em works and how the game is played on the servers—after a round of betting, the servers want to start the next round by making the player who was to the left of the dealer in the last round into the dealer for this round, whereas my module handles it by continuing betting from the player after the one who last bet. Of course, the servers are correct, and you might call this discrepancy a bug that I haven't fixed yet, but we use this opportunity to ensure that the status object and the server both agree on who's to play next:

$game->{next} = $who;

And that's basically all there is to the game play. Let's now turn to building a client with this module.

Upping the Ante

There's a simple, text-based poker client that ships with the module. The bulk of it is made up of the two callbacks that are sent to Games::Poker::OPP, the status callback and the main action callback.

This is a very simple callback—it displays the status table, shows your hole cards and the cards on the board, and prompts for what you want to do:

callback => sub {
    my $game = shift->state();
    print $game->status;
    print "Hole cards: ", $game->hole, "\n";
    print "Board cards: ", $game->board, "\n";
    print "[F]old, [C]all/check [B]et/[R]aise\n";
    print "Your turn: ";

And then it reads your reaction, and sends it back:

    my $action = <STDIN>;
    if ($action =~ /f/i) { $action = FOLD; }
    elsif ($action =~ /[br]/i) { $action = RAISE; }
    else { $action = CALL; }
    return $action;
 }

(The FOLD, RAISE, and CALL constants are exported by the Games::Poker::OPP module.)

The status callback is equally simple. It gets a command:

status => sub {
    my ($self, $cmd, @stuff) = @_;

If that's informational, it just prints out the arguments:

if ($cmd == CHATTER || $cmd == INFORMATION) {
    print @stuff, "\n";
    return;
}

The server information messages tell you a good deal of what's happening in the game (such as lathos has folded), so we don't need to display any specific status information for these commands:

return if $cmd == FOLD || $cmd == RAISE || $cmd == CALL
       || $cmd == BLIND;

If we were writing a graphical client, though, these would be good opportunities to update the display.

And in all other circumstances, we just print out the game state:

    my $game = $self->state;
    return unless $game;
    print "\n—-\n";
    print $game->status;
    print "Hole cards: ", $game->hole, "\n";
    print "Board cards: ", $game->board, "\n";
    print "—-\n";
}

That's all it takes to create a poker-playing robot in Perl with Games::Poker::OPP—now all that's left to do is add some analysis, a little artificial intelligence, test it out on the servers for a few weeks, and then...Las Vegas, here we come.

TPJ