File Coverage

lib/Settlers/Game/Bank.pm

Criterion	Covered	Total	%
statement	49	62	79.0
branch	8	18	44.4
condition	10	35	28.5
subroutine	11	15	73.3
pod	0	12	0.0
total	78	142	54.9

package Settlers::Game::Bank;
$Settlers::Game::Bank::VERSION = '0.07';
use strict;
use warnings;
use List::Util 'shuffle';

my %resource_table = (
    B => 'Settlers::Resource::Brick',
    G => 'Settlers::Resource::Grain',
    L => 'Settlers::Resource::Lumber',
    O => 'Settlers::Resource::Ore',
    W => 'Settlers::Resource::Wool',
);
eval "require $_" for values %resource_table;

sub name      { 'The Bank' }
sub number    { 'bank' }
sub resources { $_[0]->{resources} }

sub new
{
  my ($class, $args) = @_;

  return bless {
    deck      => deck_build($args),
    resources => resource_build($args),
  }, $class;
}

sub deck { $_[0]->{deck} }

sub deck_remaining { scalar @{$_->{deck}} }

sub deck_build
{
  my $args = shift;

  # NB the 5-6 player game has 1 extra MO, RB, YP. 5 extra KN.
  my (@codes);
  push @codes, ($args->{knight_count}        || ('KN') x 14);
  push @codes, ($args->{vp_count}            || ('VP') x 5);
  push @codes, ($args->{monopoly_count}      || ('MO') x 2);
  push @codes, ($args->{road_building_count} || ('RB') x 2);
  push @codes, ($args->{year_of_plenty_count}|| ('YP') x 2);

  return [shuffle @codes];
}

sub deck_draw
{
  my ($self, $type) = @_;
  die 'no more development cards left!' unless @{$self->deck};

  # if the type of card is in the deck use it instead of drawing
  if ($type)
  {
    my $has_found = undef;
    $type = uc $type;
    my @deck = ();
    for (@{$self->deck})
    {
      if ($_ ne $type || $has_found)
      {
        push(@deck, $_);
      }
      else
      {
        $has_found = 1;
      }
    }
    $self->{deck} = [$type, @deck] if $has_found;
  }
  return shift @{$self->deck};
}

sub resource_build
{
  my $args = shift;
  # NB the 5-6 player game has 25 of each resource
  my $count = $args->{resource_count} || 19;
  return {
    B => $count,
    G => $count,
    L => $count,
    O => $count,
    W => $count,
  };
}

sub resource_from_notation
{
  my ($self, $resources) = @_;
  die 'resource from notation requires a hashref of resource codes and amounts'
    unless $resources && ref $resources eq 'HASH';

  my @resource_objects = ();

  for my $code (keys %$resources)
  {
    my $amount = $resources->{$code};
    my $class = $resource_table{ uc $code };

    die "invalid resource code $_->{code}" unless $class;
    push @resource_objects, $class->new($amount);
  }
  return \@resource_objects;
}

sub resource_by_code
{
  my ($self, $code) = @_;
  die 'resource by code requires a valid resource code!'
    unless $code && exists $resource_table{ uc $code };

  return $resource_table{uc $code};
}

sub resource_concede
{
  my ($self, $player, $details) = @_;
  die 'resource_concede requires a player and resources hashref'
    unless $player && $player->isa('Settlers::Game::Player')
      && $details && ref $details eq 'HASH';

  my $trade = Settlers::Game::Trade->new($self, [$player], { $player->number => $details});

  # check all amounts are negative as the player is supposed to be CONCEDING resources
  for (@{$trade->resources($player->number)})
  {
    die 'resource_concede amounts must be negative!' unless $_->amount < 0;
  }
  return $trade->execute;
}

1;

__END__