File Coverage

lib/BalanceOfPower/Player/Role/Broker.pm
Criterion Covered Total %
statement 69 145 47.5
branch 8 20 40.0
condition n/a
subroutine 19 30 63.3
pod 0 25 0.0
total 96 220 43.6


line stmt bran cond sub pod time code
1             package BalanceOfPower::Player::Role::Broker;
2             $BalanceOfPower::Player::Role::Broker::VERSION = '0.400105';
3 13     13   4586 use strict;
  13         24  
  13         296  
4 13     13   141 use v5.10;
  13         31  
5 13     13   45 use Moo::Role;
  13         15  
  13         79  
6              
7 13     13   2911 use BalanceOfPower::Constants ':all';
  13         23  
  13         5427  
8 13     13   61 use BalanceOfPower::Utils qw(as_title);
  13         18  
  13         14639  
9              
10             requires 'register_event';
11              
12              
13              
14             has money => (
15             is => 'rw',
16             default => 0
17             );
18             has wallet => (
19             is => 'ro',
20             default => sub { {} }
21             );
22             has stock_orders => (
23             is => 'rw',
24             default => sub { [] }
25             );
26             has control_orders => (
27             is => 'rw',
28             default => sub { {} }
29             );
30             sub init_nation_wallet
31             {
32 1     1 0 2 my $self = shift;
33 1         1 my $nation = shift;
34 1         4 $self->wallet->{$nation}->{'stocks'} = 0;
35 1         2 $self->wallet->{$nation}->{'influence'} = 0;
36 1         4 $self->wallet->{$nation}->{'war_bonds'} = 0;
37             }
38             sub add_wallet_element
39             {
40 3     3 0 4 my $self = shift;
41 3         2 my $element = shift;
42 3         4 my $nation = shift;
43 3         3 my $q = shift;
44 3 100       7 if(exists $self->wallet->{$nation})
45             {
46 2         7 $self->wallet->{$nation}->{$element} += $q;
47             }
48             else
49             {
50 1         3 $self->init_nation_wallet($nation);
51 1         3 $self->wallet->{$nation}->{$element} = $q;
52             }
53             }
54             sub get_wallet_element
55             {
56 13     13 0 11 my $self = shift;
57 13         13 my $element = shift;
58 13         14 my $nation = shift;
59 13 100       39 if(exists $self->wallet->{$nation})
60             {
61 8         39 return $self->wallet->{$nation}->{$element};
62             }
63             else
64             {
65 5         19 return 0;
66             }
67             }
68              
69             sub add_stocks
70             {
71 2     2 0 3 my $self = shift;
72 2         2 my $q = shift;
73 2         3 my $nation = shift;
74 2         11 $self->add_wallet_element('stocks', $nation, $q);
75             }
76             sub stocks
77             {
78 11     11 0 870 my $self = shift;
79 11         13 my $nation = shift;
80 11         24 $self->get_wallet_element('stocks', $nation);
81             }
82             sub influence
83             {
84 2     2 0 4 my $self = shift;
85 2         2 my $nation = shift;
86 2         7 $self->get_wallet_element('influence', $nation);
87             }
88             sub add_influence
89             {
90 1     1 0 1 my $self = shift;
91 1         3 my $q = shift;
92 1         1 my $nation = shift;
93 1         3 $self->add_wallet_element('influence', $nation, $q);
94             }
95             sub add_war_bonds
96             {
97 0     0 0 0 my $self = shift;
98 0         0 my $nation = shift;
99 0         0 $self->add_wallet_element('war_bonds', $nation, 1);
100             }
101             sub war_bonds
102             {
103 0     0 0 0 my $self = shift;
104 0         0 my $nation = shift;
105 0         0 $self->get_wallet_element('war_bonds', $nation);
106             }
107             sub add_money
108             {
109 2     2 0 3 my $self = shift;
110 2         3 my $q = shift;
111 2         7 $self->money($self->money + $q);
112 2 50       7 $self->money(0) if($self->money < 0);
113             }
114             sub issue_war_bonds
115             {
116 4     4 0 5 my $self = shift;
117 4         2 my $nation = shift;
118 4 50       10 if($self->stocks($nation) > 0)
119             {
120 0 0       0 if($self->money > WAR_BOND_COST)
121             {
122 0         0 $self->add_money(-1 * WAR_BOND_COST);
123 0         0 $self->add_war_bonds($nation);
124 0         0 $self->register_event("WAR BOND FOR $nation ISSUED. PAYED " . WAR_BOND_COST);
125             }
126             else
127             {
128 0         0 $self->register_event("WAR BOND FOR $nation NOT ISSUED. NOT ENOUGH MONEY");
129             }
130             }
131             }
132             sub discard_war_bonds
133             {
134 0     0 0 0 my $self = shift;
135 0         0 my $nation = shift;
136 0 0       0 if($self->war_bonds($nation) > 0)
137             {
138 0         0 $self->wallet->{$nation}->{'war_bonds'} = 0;
139 0         0 $self->register_event("WAR LOST FOR $nation! WAR BONDS FROM $nation HAVE NOW NO VALUE");
140             }
141             }
142             sub cash_war_bonds
143             {
144 0     0 0 0 my $self = shift;
145 0         0 my $nation = shift;
146 0 0       0 if($self->war_bonds($nation) > 0)
147             {
148 0         0 my $gain = $self->wallet->{$nation}->{'war_bonds'} * WAR_BOND_GAIN;
149 0         0 $self->add_money($gain);
150 0         0 $self->wallet->{$nation}->{'war_bonds'} = 0;
151 0         0 $self->register_event("WAR WON FOR $nation! GAINES $gain FROM WAR BONDS");
152              
153             }
154             }
155             sub empty_stocks
156             {
157 1     1 0 2 my $self = shift;
158 1         1 my $nation = shift;
159 1 50       4 if($self->stocks($nation) > 0)
160             {
161 0         0 $self->wallet->{$nation}->{'stocks'} = 0;
162 0         0 $self->wallet->{$nation}->{'war_bonds'} = 0;
163 0         0 $self->wallet->{$nation}->{'influence'} = 0;
164 0         0 $self->register_event("INVESTMENTS IN $nation LOST BECAUSE OF REVOLUTION!");
165             }
166             }
167             sub add_stock_order
168             {
169 2     2 0 4 my $self = shift;
170 2         3 my $order = shift;
171 2         2 push @{$self->stock_orders}, $order;
  2         7  
172             }
173             sub remove_stock_orders
174             {
175 0     0 0 0 my $self = shift;
176 0         0 my $nation = shift;
177 0         0 my @ords = grep { $_ !~ /$nation/ } @{$self->stock_orders};
  0         0  
  0         0  
178 0         0 $self->stock_orders(\@ords);
179             }
180             sub empty_stock_orders
181             {
182 10     10 0 9 my $self = shift;
183 10         29 $self->stock_orders([]);
184             }
185             sub print_stock_orders
186             {
187 0     0 0 0 my $self = shift;
188 0         0 my $out = as_title("STOCK ORDERS");
189 0         0 $out .= "\n\n";
190 0         0 foreach my $ord (@{$self->stock_orders})
  0         0  
191             {
192 0         0 $out .= $ord . "\n";
193             }
194 0         0 return $out;
195             }
196              
197             sub add_control_order
198             {
199 0     0 0 0 my $self = shift;
200 0         0 my $nation = shift;
201 0         0 my $order = shift;
202 0         0 $self->control_orders->{$nation} = $order;
203             }
204             sub get_control_order
205             {
206 28     28 0 22 my $self = shift;
207 28         26 my $nation = shift;
208 28 50       55 if(exists $self->control_orders->{$nation})
209             {
210 0         0 return $self->control_orders->{$nation};
211             }
212             else
213             {
214 28         40 return undef;
215             }
216             }
217             sub remove_control_order
218             {
219 0     0 0 0 my $self = shift;
220 0         0 my $nation = shift;
221 0         0 $self->control_orders->{$nation} = undef;
222             }
223             sub empty_control_orders
224             {
225 10     10 0 11 my $self = shift;
226 10         29 $self->control_orders({});
227             }
228             sub print_control_orders
229             {
230 0     0 0   my $self = shift;
231 0           my $out = as_title("CONTROL ORDERS");
232 0           $out .= "\n\n";
233 0           for(keys %{$self->control_orders})
  0            
234             {
235 0           my $n = $_;
236 0           $out .= $n . ": " . $self->get_control_order($n) . "\n";
237             }
238 0           return $out;
239             }
240             sub dump_wallet
241             {
242 0     0 0   my $self = shift;
243 0           my $io = shift;
244 0           my $indent = shift;
245 0           foreach my $nation(keys %{$self->wallet})
  0            
246             {
247 0           print {$io} $indent . join(";", $nation, $self->stocks($nation), $self->war_bonds($nation), $self->influence($nation)) . "\n";
  0            
248             }
249             }
250             sub load_wallet
251             {
252 0     0 0   my $self = shift;
253 0           my $data = shift;
254 0           my %wallet = ();
255 0 0         return \%wallet if(! $data);
256 0           my @lines = split /\n/, $data;
257 0           foreach my $line (@lines)
258             {
259 0           $line =~ s/^\s+//;
260 0           chomp $line;
261 0           my ($nation, $stocks, $war_bonds, $influence) = split ";", $line;
262 0           $wallet{$nation}->{'stocks'} = $stocks;
263 0           $wallet{$nation}->{'war_bonds'} = $war_bonds;
264 0           $wallet{$nation}->{'influence'} = $influence;
265             }
266 0           return \%wallet;
267             }
268              
269             1;