view release on metacpan or  search on metacpan

OPP.pm  view on Meta::CPAN

Prepares a new connection to a poker server. This doesn't actually make
the connection yet; use C<connect> to do that.

You B<must> supply a C<callback> which will be called when it is your
turn to act; you may supply a C<status> callback which will be called
during a game when something happens.

=cut

sub new {
    my $class = shift;
    my %args = (
       server   => "chinook6.cs.ualberta.ca",
       port     => 55006,
       status   => sub {},
       @_
    );
    defined $args{$_} or croak "No $_ specified" 
        for qw(username password callback);
    return bless \%args, $class;
}

=head2 connect

Initiates a connection to the specified server. This is something you'll
want to override if you're subclassing this module.

=cut

sub connect {
    my $self = shift;
    $self->{socket} = IO::Socket::INET->new(
        PeerHost => $self->{server},
        PeerPort => $self->{port},
    );
}

=head2 put ($data)

Sends C<$data> to the server.

=head2 get ($len)

Tries to retrieve C<$len> bytes of data from the server.

Again, things you'll override when inheriting.

=cut

sub put { my ($self, $what) = @_; $self->{socket}->write($what, length $what); }
sub get { 
    my ($self, $len) = @_; 
    my $buf = " "x$len; 
    my $newlen = $self->{socket}->read($buf, $len);
    return substr($buf,0,$newlen);
}

=head2 joingame

Sends username/password credentials and joins the game. Returns 0 if
the username/password was not accepted.

=cut

sub joingame {
    my $self = shift;
    $self->send_packet(JOIN_GAME,
        $self->{username},
        $self->{password},
        1, # Protocol version
        ref $self # Class. ;)
    );
    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;
    }
}

=head2 playgame

    $self->playgame( )

Once you've signed into the server, the C<playgame> loop will receive
status events from the server, update the internal game status object
and call your callbacks.

=cut

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

    while (my ($cmd, @data) = $self->get_packet()) {
        if ($cmd == PING) { $self->send_packet(PONG); next; }
        if ($cmd == GOODBYE) { last }
        if ($cmd == CHATTER ||
            $cmd == INFORMATION) { 
                $self->{status}->($self, $cmd, @data); next; 
            }
    
        # Discard things which don't concern us. 
        next unless $self->{game} or $cmd == START_NEW_GAME; 

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

    }
}

=head2 state

Returns a C<Games::Poker::TexasHold'em> object representing the current
state of play - the players involved, the pot, and so on. See
L<Games::Poker::TexasHold'em> for more information about how to use this.