File Coverage

lib/Catan/Game/Trade.pm
Criterion Covered Total %
statement 72 86 83.7
branch 17 26 65.3
condition 9 26 34.6
subroutine 12 14 85.7
pod 0 8 0.0
total 110 160 68.7


line stmt bran cond sub pod time code
1             package Catan::Game::Trade;
2             $Catan::Game::Trade::VERSION = '0.02';
3 3     3   531 use warnings;
  3     1   7  
  3         103  
  1         887  
  1         2  
  1         25  
4 3     3   16 use strict;
  3     1   15  
  3         88  
  1         5  
  1         2  
  1         22  
5 3     3   15 use List::Util 'sum';
  3     1   5  
  3         3073  
  1         4  
  1         2  
  1         1572  
6              
7              
8             sub new
9             {
10 5     5 0 7938 my ($class, $bank, $players, $details, $resource_production) = @_;
11              
12 5 50 33     116 die __PACKAGE__ . ' new requires players and trade detail arguments'
      33        
      33        
      33        
      33        
      33        
      50        
13             unless $bank && $bank->isa('Catan::Game::Bank')
14             && $details && ref $details eq 'HASH' && keys %$details
15             && $players && ref $players eq 'ARRAY' && scalar @$players;
16              
17 5         11 my $self = bless { }, $class;
18              
19             # validate trade details
20 5         12 for my $player_number (keys %$details)
21             {
22 10         34 my @players = grep($player_number == $_->number, @$players);
23              
24 10 50       22 die __PACKAGE__ . ' is for invalid player number'
25             unless scalar @players == 1;
26              
27 10         33 my $resources = $bank->resource_from_notation($details->{$player_number});
28 10         32 $self->{$player_number} = { player => $players[0], resources => $resources };
29              
30 10         12 push @{$self->{players}}, $players[0];
  10         32  
31             }
32              
33 5         10 my @players = @{$self->players};
  5         11  
34              
35 5 100       13 if (@players == 1)
36             {
37 1         2 my $player = shift @players;
38 1         4 my $ratios = $player->ratios;
39 1         2 push @{$self->{players}}, $bank;
  1         2  
40              
41             # check trade ratios if its a bank trade
42 1         2 my ($allowed, $requested) = (0,0);
43              
44 1         2 for my $r (@{$self->resources($player->number)})
  1         3  
45             {
46 3 100       15 if ($r->amount < 0)
    50          
47             {
48 1         3 $allowed += (-$r->amount) / $ratios->{$r->code};
49             }
50             elsif ($r->amount > 0)
51             {
52 2         5 $requested += $r->amount;
53             }
54 3         5 push @{$self->{bank}{resources}}, $r->invert;
  3         22  
55             }
56 1 50 33     12 die "$player requested $requested resources, but provided too few resources trade with the bank"
57             unless $resource_production || $allowed == $requested;
58             }
59             # check that the trade contains only 2 players and the amounts balance
60             else
61             {
62 4 100       25 die 'a trade must be between 2 players only!' unless @players == 2;
63 3         10 my $resources1 = $self->resources($players[0]->number);
64 3         11 my $resources2 = $self->resources($players[1]->number);
65              
66 3         7 for my $r (@$resources1)
67             {
68 7 100       12 my $total2 = sum map { $_->isa(ref $r) ? $_->amount : 0 } @$resources2;
  19         112  
69 7 100       18 die 'a trade between 2 players must balance!'
70             unless $r->amount + $total2 == 0;
71             }
72             }
73              
74             # check both players can afford the trade
75 3 50       8 return $self if $self->can_afford;
76             }
77              
78 3     3 0 14 sub is_with_bank { exists $_[0]->{bank} }
79 14     14 0 39 sub players { $_[0]->{players} }
80              
81             sub as_hashref
82             {
83 3     3 0 5 my $self = shift;
84 3         4 my $rv = {};
85 3         4 for my $player (@{$self->players})
  3         6  
86             {
87 6         8 for my $r (@{$self->resources($player->number)})
  6         14  
88             {
89 16         38 $rv->{$player->number}{$r->code} = $r->amount;
90             }
91             }
92 3         18 return $rv;
93             }
94              
95 0     0 0 0 sub resources_all { [ map { @{$_[0]->resources($_->number)} } @{$_[0]->players} ]}
  0         0  
  0         0  
  0         0  
96              
97             sub resources
98             {
99 19     19 0 28 my ($self, $player_number) = @_;
100              
101             die 'resources requires a valid player number argument'
102 19 50 33     72 unless $player_number && exists $self->{$player_number};
103              
104 19         54 return $self->{$player_number}{resources};
105             }
106              
107             sub execute
108             {
109 0     0 0 0 my $self = shift;
110 0 0       0 if ($self->can_afford)
111             {
112 0         0 my %results;
113              
114 0         0 for my $player (@{$self->players})
  0         0  
115             {
116 0         0 for my $r (@{$self->resources($player->number)})
  0         0  
117             {
118 0         0 $player->resources->{$r->code} += $r->amount;
119 0         0 $results{$player->number}{$r->code} = $r->amount;
120             }
121             }
122 0         0 return \%results;
123             }
124             }
125              
126             sub can_afford
127             {
128 3     3 0 3 my ($self) = @_;
129              
130 3         4 for my $player (@{$self->players})
  3         7  
131             {
132 6         8 for (@{$self->{$player->number}{resources}})
  6         18  
133             {
134             return die "$player does not have enough resources for that"
135 16 50       38 unless $player->resources->{$_->code} + $_->quantity >= 0;
136             }
137             }
138 3         21 return 1;
139             }
140              
141             1;
142              
143             __END__