File Coverage

lib/BalanceOfPower/Nation.pm
Criterion Covered Total %
statement 179 221 81.0
branch 45 58 77.5
condition 5 10 50.0
subroutine 27 31 87.1
pod 0 26 0.0
total 256 346 73.9


line stmt bran cond sub pod time code
1             package BalanceOfPower::Nation;
2             $BalanceOfPower::Nation::VERSION = '0.400105';
3 13     13   46 use strict;
  13         15  
  13         281  
4 13     13   108 use v5.10;
  13         30  
5              
6 13     13   49 use Moo;
  13         15  
  13         82  
7              
8 13     13   2876 use BalanceOfPower::Utils qw( prev_turn );
  13         20  
  13         439  
9 13     13   569 use BalanceOfPower::Constants ':all';
  13         14  
  13         28896  
10              
11             with 'BalanceOfPower::Role::Reporter';
12             with 'BalanceOfPower::Nation::Role::IA';
13             with 'BalanceOfPower::Nation::Role::Shareholder';
14              
15             has name => (
16             is => 'ro',
17             default => 'Dummyland'
18             );
19             has code => (
20             is => 'ro',
21             default => 'DUM'
22             );
23             has area => (
24             is => 'ro',
25             default => 'Neverwhere'
26             );
27              
28              
29             has export_quote => (
30             is => 'ro',
31             default => 50
32             );
33             has government => (
34             is => 'ro',
35             default => 'democracy'
36             );
37             has government_strength => (
38             is => 'rw',
39             default => 70
40             );
41             has government_id => (
42             is => 'rw',
43             default => 0
44             );
45             has size => (
46             is => 'ro',
47             default => 1
48             );
49              
50             has internal_disorder => (
51             is => 'rw',
52             default => 0
53             );
54             has production_for_domestic => (
55             is => 'rw',
56             default => 0
57             );
58             has production_for_export => (
59             is => 'rw',
60             default => 0
61             );
62             has prestige => (
63             is => 'rw',
64             default => 0
65             );
66             has wealth => (
67             is => 'rw',
68             default => 0
69             );
70             has debt => (
71             is => 'rw',
72             default => 0
73             );
74             has current_year => (
75             is => 'rw'
76             );
77              
78             has army => (
79             default => 0,
80             is => 'rw'
81             );
82              
83             has progress => (
84             default => 0,
85             is => 'rw'
86             );
87              
88             has frozen_disorder => (
89             default => 0,
90             is => 'rw'
91             );
92              
93             sub production
94             {
95 590     590 0 507 my $self = shift;
96 590         438 my $prod = shift;
97 590 100       802 if($prod)
98             {
99 208 50 66     506 if($prod <= DEBT_TO_RAISE_LIMIT && $self->debt < MAX_DEBT && DEBT_ALLOWED)
      100        
100             {
101 0         0 $prod += PRODUCTION_THROUGH_DEBT;
102 0         0 $self->debt($self->debt + 1);
103 0         0 $self->register_event("DEBT RISE");
104             }
105 208 100       451 if($self->government eq 'dictatorship')
106             {
107 35         64 $prod -= DICTATORSHIP_PRODUCTION_MALUS;
108             }
109 208         430 my $internal = $prod - (($self->export_quote * $prod) / 100);
110 208         192 my $export = $prod - $internal;
111 208         303 $self->production_for_domestic($internal);
112 208         256 $self->production_for_export($export);
113 208         1368 $self->register_event("PRODUCTION INT: $internal EXP: $export");
114             }
115 590         2127 return $self->production_for_domestic + $self->production_for_export;
116             }
117              
118             sub calculate_internal_wealth
119             {
120 177     177 0 141 my $self = shift;
121 177         245 my $internal_production = $self->production_for_domestic();
122 177         353 $self->add_wealth($internal_production * INTERNAL_PRODUCTION_GAIN);
123 177         205 $self->production_for_domestic(0);
124 177         963 $self->register_event("INTERNAL " . $internal_production);
125             }
126              
127             sub calculate_trading
128             {
129 177     177 0 190 my $self = shift;
130 177         130 my $world = shift;
131 177         649 my @routes = $world->routes_for_node($self->name);
132 177         551 my %diplomacy = $world->diplomacy_for_node($self->name);
133 177         338 @routes = sort { $b->factor_for_node($self->name) * 1000 + $diplomacy{$b->destination($self->name)}
134             <=>
135 59         134 $a->factor_for_node($self->name) * 1000 + $diplomacy{$a->destination($self->name)}
136             } @routes;
137 177 100       455 if(@routes > 0)
138             {
139 54         80 foreach my $r (@routes)
140             {
141 96 100       225 if($self->production_for_export >= TRADING_QUOTE)
142             {
143 89         86 my $treaty_bonus = 0;
144 89 100       266 if($world->exists_treaty_by_type($self->name, $r->destination($self->name), 'commercial'))
145             {
146 18         24 $treaty_bonus = TREATY_TRADE_FACTOR;
147             }
148 89         251 $self->trade(TRADING_QUOTE, $r->factor_for_node($self->name) + $treaty_bonus);
149 89         206 my $event = "TRADE OK " . $r->destination($self->name) . " [x" . $r->factor_for_node($self->name);
150 89 100       155 if($treaty_bonus > 0)
151             {
152 18         111 $event .= " +$treaty_bonus";
153             }
154 89         93 $event .= "]";
155 89         181 $self->register_event($event);
156             }
157             else
158             {
159 7         34 $self->trade(0, $r->factor_for_node($self->name));
160 7         29 $self->register_event("TRADE KO " . $r->destination($self->name));
161             }
162             }
163             }
164             }
165              
166             sub convert_remains
167             {
168 177     177 0 186 my $self = shift;
169 177         306 $self->add_wealth($self->production);
170 177         262 $self->register_event("REMAIN " . $self->production);
171 177         318 $self->production_for_domestic(0);
172 177         329 $self->production_for_export(0);
173             }
174              
175             sub war_cost
176             {
177 20     20 0 24 my $self = shift;
178 20         38 $self->add_wealth(-1 * WAR_WEALTH_MALUS);
179 20         57 $self->register_event("WAR COST PAYED: " . WAR_WEALTH_MALUS);
180             }
181             sub civil_war_cost
182             {
183 17     17 0 17 my $self = shift;
184 17         25 $self->add_wealth(-1 * CIVIL_WAR_WEALTH_MALUS);
185 17         47 $self->register_event("CIVIL WAR COST PAYED: " . CIVIL_WAR_WEALTH_MALUS);
186             }
187              
188             sub boost_production
189             {
190 6     6 0 7 my $self = shift;
191 6         14 my $boost = BOOST_PRODUCTION_QUOTE * PRODUCTION_UNITS->[$self->size];
192 6         13 $self->subtract_production('export', -1 * $boost);
193 6         8 $self->subtract_production('domestic', -1 * $boost);
194 6         16 $self->register_event("BOOST OF PRODUCTION");
195             }
196             sub receive_aid
197             {
198 1     1 0 2 my $self = shift;
199 1         1 my $from = shift;
200 1         4 my $boost = ECONOMIC_AID_QUOTE * PRODUCTION_UNITS->[$self->size];
201 1         3 $self->subtract_production('export', -1 * $boost);
202 1         2 $self->subtract_production('domestic', -1 * $boost);
203             }
204              
205             sub trade
206             {
207 96     96 0 85 my $self = shift;
208 96         91 my $production = shift;
209 96         80 my $gain = shift;
210 96         155 $self->subtract_production('export', $production);
211 96         148 $self->add_wealth($production * $gain);
212 96         127 $self->add_wealth(-1 * TRADEROUTE_COST);
213             }
214              
215             sub calculate_disorder
216             {
217 162     162 0 137 my $self = shift;
218 162         147 my $world = shift;
219 162 100       235 return if($self->internal_disorder_status eq 'Civil war');
220 161 100       360 return if($self->frozen_disorder);
221              
222 159         392 my @ordered_best = $world->order_statistics(prev_turn($self->current_year), 'progress');
223            
224             #Variables
225 159         427 my $wd = $self->wealth / PRODUCTION_UNITS->[$self->size];
226 159         200 my $d = $self->internal_disorder;
227 159         207 my $g = $self->government_strength;
228 159 100       337 my $prg = $ordered_best[0] ? $ordered_best[0]->{'value'} - $self->progress : 0;
229              
230             #Constants
231 159         127 my $wd_middle = 30;
232 159         128 my $wd_divider = 10;
233 159         114 my $disorder_divider = 70;
234 159         121 my $government_strength_minimum = 60;
235 159         105 my $government_strength_divider = 40;
236 159         127 my $random_factor_max = 15;
237            
238 159         3363 my $disorder = ( ($wd_middle - $wd) / $wd_divider ) +
239             ( $d / $disorder_divider ) +
240             ( ($government_strength_minimum - $g) / $government_strength_divider ) +
241             $world->random_around_zero($random_factor_max, 100, "Internal disorder random factor for " . $self->name) +
242             $prg;
243              
244 159         258 $disorder = int ($disorder * 100) / 100;
245 159         1005 $self->register_event("DISORDER CHANGE: " . $disorder);
246 159         402 $self->add_internal_disorder($disorder, $world);
247             }
248              
249             sub subtract_production
250             {
251 142     142 0 133 my $self = shift;
252 142         118 my $which = shift;
253 142         105 my $production = shift;
254 142 100       219 if($which eq 'export')
    50          
255             {
256 122         277 $self->production_for_export($self->production_for_export - $production);
257             }
258             elsif($which eq 'domestic')
259             {
260 20         51 $self->production_for_domestic($self->production_for_domestic - $production);
261             }
262            
263             }
264              
265             sub add_wealth
266             {
267 583     583 0 442 my $self = shift;
268 583         412 my $wealth = shift;
269 583         1039 $self->wealth($self->wealth + $wealth);
270 583 50       1058 $self->wealth(0) if($self->wealth < 0);
271             }
272              
273             sub lower_disorder
274             {
275 1     1 0 2 my $self = shift;
276 1         2 my $world = shift;
277 1 50       5 if($world->at_civil_war($self->name))
278             {
279 0         0 return;
280             }
281 1 50       5 if($self->production_for_domestic > RESOURCES_FOR_DISORDER)
282             {
283 1         4 $self->subtract_production('domestic', RESOURCES_FOR_DISORDER);
284 1         3 $self->add_internal_disorder(-1 * DISORDER_REDUCTION, $world);
285 1         12 $world->broadcast_event({ code => 'lowerdisorder',
286             text => "DISORDER LOWERED TO " . $self->internal_disorder. " IN " . $self->name,
287             involved => [$self->name] }, $self->name);
288             }
289             }
290              
291             sub add_internal_disorder
292             {
293 170     170 0 177 my $self = shift;
294 170         138 my $disorder = shift;
295 170         125 my $world = shift;
296 170         254 my $actual_disorder = $self->internal_disorder_status;
297 170         302 my $new_disorder_data = $self->internal_disorder + $disorder;
298 170         224 $new_disorder_data = int($new_disorder_data * 100) / 100;
299 170         220 $self->internal_disorder($new_disorder_data);
300 170 50       335 if($self->internal_disorder > 100)
301             {
302 0         0 $self->internal_disorder(100);
303             }
304 170 100       304 if($self->internal_disorder < 0)
305             {
306 104         174 $self->internal_disorder(0);
307             }
308 170         219 my $new_disorder = $self->internal_disorder_status;
309 170 100       669 if($actual_disorder ne $new_disorder)
310             {
311 9         111 $world->broadcast_event({ code => 'disorderchange',
312             text => "INTERNAL DISORDER LEVEL FROM $actual_disorder TO $new_disorder IN " . $self->name,
313             involved => [$self->name] }, $self->name);
314 9 100       45 if($new_disorder eq "Civil war")
315             {
316 4         19 $world->start_civil_war($self);
317             }
318             }
319             }
320              
321             sub internal_disorder_status
322             {
323 900     900 0 623 my $self = shift;
324 900         926 my $disorder = $self->internal_disorder;
325 900 100       1291 if($disorder < INTERNAL_DISORDER_TERRORISM_LIMIT)
    100          
    100          
326             {
327 806         1421 return "Peace";
328             }
329             elsif($disorder < INTERNAL_DISORDER_INSURGENCE_LIMIT)
330             {
331 55         113 return "Terrorism";
332             }
333             elsif($disorder < INTERNAL_DISORDER_CIVIL_WAR_LIMIT)
334             {
335 18         30 return "Insurgence";
336             }
337             else
338             {
339 21         49 return "Civil war";
340             }
341             }
342              
343              
344              
345              
346             sub new_government
347             {
348 2     2 0 3 my $self = shift;
349 2         4 my $world = shift;
350 2         38 $self->government_strength($world->random10(MIN_GOVERNMENT_STRENGTH, MAX_GOVERNMENT_STRENGTH, "Reroll government strength for " . $self->name));
351 2         12 $self->government_id($self->government_id + 1);
352 2         10 $world->reroll_diplomacy($self->name);
353 2         12 $world->reset_treaties($self->name);
354 2         11 $world->reset_influences($self->name);
355 2         13 $world->reset_supports($self->name);
356 2         16 $world->reset_crises($self->name);
357 2         26 $world->broadcast_event({ code => "newgov",
358             text => "NEW GOVERNMENT CREATED IN " . $self->name,
359             involved => [$self->name] }, $self->name);
360             }
361              
362             sub occupation
363             {
364 3     3 0 4 my $self = shift;
365 3         4 my $world = shift;
366 3         13 $self->government_id($self->government_id + 1);
367 3         14 $world->reset_treaties($self->name);
368 3         17 $world->reset_influences($self->name);
369 3         29 $world->reset_supports($self->name);
370 3         16 $world->reset_crises($self->name);
371             }
372              
373             sub build_troops
374             {
375 11     11 0 10 my $self = shift;
376 11         18 my $army_cost = $self->build_troops_cost();
377            
378 11 50 33     78 if($self->production_for_domestic > $army_cost && $self->army < MAX_ARMY_FOR_SIZE->[ $self->size ])
379             {
380 11         19 $self->subtract_production('domestic', $army_cost);
381 11         20 $self->add_army(ARMY_UNIT);
382 11         23 $self->register_event("NEW TROOPS FOR THE ARMY");
383             }
384             }
385              
386             sub build_troops_cost
387             {
388 23     23 0 24 my $self = shift;
389 23         24 my $army_cost = ARMY_COST;
390 23 100       57 if($self->government eq 'dictatorship')
391             {
392 8         12 $army_cost -= DICTATORSHIP_BONUS_FOR_ARMY_CONSTRUCTION;
393             }
394 23         28 return $army_cost;
395             }
396              
397             sub add_army
398             {
399 51     51 0 67 my $self = shift;
400 51         47 my $army = shift;
401 51         162 $self->army($self->army + $army);
402 51 100       191 if($self->army > MAX_ARMY_FOR_SIZE->[ $self->size ])
403             {
404 2         6 $self->army(MAX_ARMY_FOR_SIZE->[ $self->size ]);
405             }
406 51 50       151 if($self->army < 0)
407             {
408 0         0 $self->army(0);
409             }
410              
411             }
412              
413             sub grow
414             {
415 1     1 0 2 my $self = shift;
416 1 50       6 return if($self->production_for_domestic < PROGRESS_COST);
417 1         4 my $new_progress = $self->progress + PROGRESS_INCREMENT;
418 1         4 $self->progress($new_progress);
419 1         5 $self->subtract_production('domestic', PROGRESS_COST);
420 1         9 $self->register_event("GROW. NEW PROGRESS: $new_progress");
421             }
422              
423             sub treaty_limit
424             {
425 58     58 0 61 my $self = shift;
426 58         145 my $progress_step = int($self->progress / TREATY_LIMIT_PROGRESS_STEP) + 1;
427 58         176 return $progress_step * TREATIES_FOR_PROGRESS_STEP;
428             }
429              
430             sub print_attributes
431             {
432 0     0 0   my $self = shift;
433 0           my $out = "";
434 0           $out .= "Area: " . $self->area . "\n";
435 0           $out .= "Export quote: " . $self->export_quote . "\n";
436 0           $out .= "Government strength: " . $self->government_strength . "\n";
437 0           $out .= "Internal situation: " . $self->internal_disorder_status . "\n";
438 0           return $out;
439             }
440              
441             sub dump
442             {
443 0     0 0   my $self = shift;
444 0           my $io = shift;
445 0   0       my $indent = shift || "";
446 0           print {$io} $indent .
  0            
447             join(";", $self->name, $self->code, $self->area, $self->export_quote, $self->government, $self->government_strength, $self->size, $self->internal_disorder, $self->production_for_domestic, $self->production_for_export, $self->prestige, $self->wealth, $self->debt, $self->current_year, $self->army, $self->progress, $self->available_stocks, $self->government_id) . "\n";
448 0           $self->dump_events($io, " " . $indent);
449             }
450              
451             sub load
452             {
453 0     0 0   my $self = shift;
454 0           my $data = shift;
455 0           my $version = shift;
456 0           my $nation_line = ( split /\n/, $data )[0];
457 0           my %init_params = $self->manage_nation_line($nation_line, $version);
458 0           $data =~ s/^.*?\n//;
459 0           my $events = $self->load_events($data);
460 0           $init_params{'events'} = $events;
461 0           return $self->new(%init_params);
462             }
463              
464             sub manage_nation_line
465             {
466 0     0 0   my $self = shift;
467 0           my $nation_line = shift;
468 0           my $version = shift;
469 0           $nation_line =~ s/^\s+//;
470 0           chomp $nation_line;
471              
472 0           my %init_params;
473 0 0         if($version > 2)
    0          
474             {
475 0           my ($name, $code, $area, $export_quote, $government, $government_strength, $size, $internal_disorder, $production_for_domestic, $production_for_export, $prestige, $wealth, $debt, $current_year, $army, $progress, $available_stocks, $government_id) = split ";", $nation_line;
476 0           %init_params = (name => $name, code => $code, area => $area, size => $size,
477             government_id => $government_id,
478             export_quote => $export_quote, government => $government, government_strength => $government_strength,
479             internal_disorder => $internal_disorder,
480             production_for_domestic => $production_for_domestic, production_for_export => $production_for_export,
481             prestige => $prestige, wealth => $wealth, debt => $debt,
482             army => $army,
483             current_year => $current_year,
484             progress => $progress,
485             available_stocks => $available_stocks);
486             }
487             elsif($version == 2)
488             {
489 0           my ($name, $code, $area, $export_quote, $government, $government_strength, $size, $internal_disorder, $production_for_domestic, $production_for_export, $prestige, $wealth, $debt, $current_year, $army, $progress, $available_stocks) = split ";", $nation_line;
490 0           %init_params = (name => $name, code => $code, area => $area, size => $size,
491             export_quote => $export_quote, government => $government, government_strength => $government_strength,
492             internal_disorder => $internal_disorder,
493             production_for_domestic => $production_for_domestic, production_for_export => $production_for_export,
494             prestige => $prestige, wealth => $wealth, debt => $debt,
495             army => $army,
496             current_year => $current_year,
497             progress => $progress,
498             available_stocks => $available_stocks);
499              
500             }
501             else
502             {
503 0           my ($name, $code, $area, $export_quote, $government, $government_strength, $size, $internal_disorder, $production_for_domestic, $production_for_export, $prestige, $wealth, $debt, $rebel_provinces, $current_year, $army, $progress, $available_stocks) = split ";", $nation_line;
504 0           %init_params = (name => $name, code => $code, area => $area, size => $size,
505             export_quote => $export_quote, government => $government, government_strength => $government_strength,
506             internal_disorder => $internal_disorder,
507             production_for_domestic => $production_for_domestic, production_for_export => $production_for_export,
508             prestige => $prestige, wealth => $wealth, debt => $debt,
509             army => $army,
510             current_year => $current_year,
511             progress => $progress,
512             available_stocks => $available_stocks);
513             }
514 0           return %init_params;
515             }
516              
517             1;