File Coverage

blib/lib/Game/Battleship.pm

Criterion	Covered	Total	%
statement	35	60	58.3
branch	10	22	45.4
condition	6	15	40.0
subroutine	5	7	71.4
pod	3	3	100.0
total	59	107	55.1

package Game::Battleship;
our $AUTHORITY = 'cpan:GENE';

# ABSTRACT: "You sunk my battleship!"

our $VERSION = '0.0602';

use Carp;
use Game::Battleship::Player;
use Moo;


has players => (
    is  => 'rw',
    isa => sub { croak 'Invalid players list' unless ref($_[0]) eq 'HASH' },
);


sub add_player {
    my ($self, $player, $i) = @_;

    # If we are not given a number to use...
    unless ($i) {
        # ..find the least whole number that is not already used.
        my @nums = sort { $a <=> $b }
            grep { s/^player_(\d+)$/$1/ }
                keys %{ $self->{players} };
        my $n = 1;
        for (@nums) {
            last if $n > $_;
            $n++;
        }
        $i = $n;
    }

    # Make the name to use for our object.
    my $who = "player_$i";

    # Return undef if we are trying to add an existing player.
    if ( exists $self->{players}{$who} ) {
        warn "A player number $i already exists\n";
        return;
    }

    # Set the player name unless we already have a player.
    $player = $who unless $player;

    # We are given a player object.
    if (ref ($player) eq 'Game::Battleship::Player') {
        $self->{players}{$who} = $player;
    }
    # We are given the guts of a player.
    elsif (ref ($player) eq 'HASH') {
        $self->{players}{$who} = Game::Battleship::Player->new(
            id => $player->{id} || $i,
            name => $player->{name} || $who,
            fleet => $player->{fleet},
            dimensions => $player->{dimensions},
        );
    }
    # We are just given a name.
    else {
        $self->{players}{$who} = Game::Battleship::Player->new(
            id   => $i,
            name => $player,
        );
    }

    # Hand the player object back.
    return $self->{players}{$who};
}


sub player {
    my ($self, $name) = @_;
    my $player;

    # Step through each player...
    for (keys %{ $self->{players} }) {
        # Are we looking at the same player by name, key or id?
        if( $_ eq $name ||
            $self->{players}{$_}->name eq $name ||
            $self->{players}{$_}->id eq $name
        ) {
            # Set the player object to return.
            $player = $self->{players}{$_};
            last;
        }
    }

    warn "No such player '$name'\n" unless $player;
    return $player;
}


sub play {
    my ($self, %args) = @_;
    my $winner = 0;

    while (not $winner) {
        # Take a turn per live player.
        for my $player (values %{ $self->{players} }) {
            next unless $player->life;

            # Strike each opponent.
            for my $opponent (values %{ $self->{players} }) {
                next if $opponent->name eq $player->name ||
                    !$opponent->life;

                my $res = -1;  # "duplicate strike" flag.
                while ($res == -1) {
                    $res = $player->strike(
                        $opponent,
                        $self->_get_coordinate($opponent)
                    );
                }
            }
        }

        # Do we have a winner?
        my @alive = grep { $self->{players}{$_}->life } keys %{ $self->{players} };
        $winner = @alive == 1 ? shift @alive : undef;
    }

#warn $winner->name ." is the winner!\n";
    return $winner;
}

# Return a coordinate from a player's grid.
sub _get_coordinate {
    my ($self, $player) = @_;

    my ($x, $y);

    # Return random coordinates...
    ($x, $y) = (
        int 1 + rand $player->{grid}->{dimension}[0],
        int 1 + rand $player->{grid}->{dimension}[1]
    );

#    warn "$x, $y\n";
    return $x, $y;
}

1;

__END__