File Coverage

lib/Settlers/Game/Trade.pm

Criterion	Covered	Total	%
statement	82	86	95.3
branch	18	24	75.0
condition	10	26	38.4
subroutine	13	14	92.8
pod	0	8	0.0
total	123	158	77.8

package Settlers::Game::Trade;
$Settlers::Game::Trade::VERSION = '0.07';
use warnings;
use strict;
use List::Util 'sum';


sub new
{
  my ($class, $bank, $players, $details, $resource_production) = @_;

  die __PACKAGE__ . ' new requires players and trade detail arguments'
    unless $bank && $bank->isa('Settlers::Game::Bank')
      && $details && ref $details eq 'HASH' && keys %$details
      && $players && ref $players eq 'ARRAY' && scalar @$players;

  my $self = bless { }, $class;

  # validate trade details
  for my $player_number (keys %$details)
  {
    my @players = grep($player_number == $_->number, @$players);

    die __PACKAGE__ . ' is for an invalid player number'
      unless scalar @players == 1;

    my $resources = $bank->resource_from_notation($details->{$player_number});
    $self->{$player_number} = { player => $players[0], resources => $resources };

    push @{$self->{players}}, $players[0];
  }

  my @players =  @{$self->players};

  if (@players == 1)
  {
    my $player = shift @players;
    my $ratios = $player->ratios;
    push @{$self->{players}}, $bank;

    # check trade ratios if its a bank trade
    my ($allowed, $requested) = (0,0);

    for my $r (@{$self->resources($player->number)})
    {
      if ($r->amount < 0)
      {
        $allowed += (-$r->amount) / $ratios->{$r->code};
      }
      elsif ($r->amount > 0)
      {
        $requested += $r->amount;
      }
      push @{$self->{bank}{resources}}, $r->invert;
    }
    die "$player requested $requested resources, but provided too few resources trade with the bank\n"
      unless $resource_production || $allowed == $requested;
  }
  # check that the trade contains only 2 players and the amounts balance
  else
  {
    die "a trade must be between 2 players only!\n" unless @players == 2;
    my $resources1 = $self->resources($players[0]->number);
    my $resources2 = $self->resources($players[1]->number);

    for my $r (@$resources1)
    {
      my $total2 = sum map { $_->isa(ref $r) ? $_->amount : 0 } @$resources2;
      die "a trade between 2 players must balance!\n"
        unless $r->amount + $total2 == 0;
    }
  }
  return $self;
}

sub is_with_bank { exists $_[0]->{bank} }
sub players      { $_[0]->{players} }

sub as_hashref
{
  my $self = shift;
  my $rv = {};
  for my $player (@{$self->players})
  {
    for my $r (@{$self->resources($player->number)})
    {
      $rv->{$player->number}{$r->code} = $r->amount;
    }
  }
  return $rv;
}

sub resources_all { [ map { @{$_[0]->resources($_->number)} } @{$_[0]->players} ]}

sub resources
{
  my ($self, $player_number) = @_;

  die 'resources requires a valid player number argument'
    unless $player_number && exists $self->{$player_number};

  return $self->{$player_number}{resources};
}

sub execute
{
  my $self = shift;
  if ($self->can_afford)
  {
    my %results;

    for my $player (@{$self->players})
    {
      for my $r (@{$self->resources($player->number)})
      {
        $player->resources->{$r->code} += $r->amount;
        $results{$player->number}{$r->code} = $r->amount;
      }
    }
    return \%results;
  }
}

sub can_afford
{
  my ($self) = @_;

  for my $player (@{$self->players})
  {
    for (@{$self->{$player->number}{resources}})
    {
      return die "$player does not have enough resources for that\n"
        unless $player->resources->{$_->code} + $_->quantity >= 0;
    }
  }
  return 1;
}

1;

__END__