File Coverage

lib/BalanceOfPower/Role/Analyst.pm
Criterion Covered Total %
statement 98 225 43.5
branch 7 30 23.3
condition 3 23 13.0
subroutine 12 25 48.0
pod 0 17 0.0
total 120 320 37.5


line stmt bran cond sub pod time code
1             package BalanceOfPower::Role::Analyst;
2             $BalanceOfPower::Role::Analyst::VERSION = '0.400115';
3 13     13   5939 use strict;
  13         44  
  13         403  
4 13     13   136 use v5.10;
  13         38  
5 13     13   58 use Moo::Role;
  13         20  
  13         95  
6 13     13   3418 use Term::ANSIColor;
  13         30  
  13         789  
7 13     13   82 use BalanceOfPower::Constants ':all';
  13         28  
  13         7425  
8 13     13   84 use BalanceOfPower::Utils qw( prev_turn as_title as_title as_subtitle compare_turns);
  13         22  
  13         933  
9 13     13   64 use BalanceOfPower::Printer;
  13         20  
  13         315  
10              
11 13     13   61 use Data::Dumper;
  13         23  
  13         30106  
12              
13             requires 'diplomacy_exists';
14             requires 'get_borders';
15             requires 'supported';
16             requires 'exists_military_support';
17             requires 'near_nations';
18             requires 'routes_for_node';
19             requires 'get_allies';
20             requires 'get_crises';
21             requires 'get_wars';
22             requires 'print_nation_situation';
23             requires 'print_nation_statistics_header';
24             requires 'print_nation_statistics_line';
25             requires 'get_player';
26             requires 'print_all_crises';
27             requires 'get_attackers';
28              
29             sub print_nation_actual_situation
30             {
31 1     1 0 7 my $self = shift;
32 1         2 my $nation = shift;
33 1         1 my $in_the_middle = shift;
34 1   50     9 my $mode = shift || 'print';
35 1         3 my $attributes_names = ["Size", "Prod.", "Wealth", "W/D", "Growth", "Disor.", "Army", "Prog.", "Pstg."];
36 1         3 my $attributes = ["production", "wealth", "w/d", "growth", "internal disorder", "army", "progress", "prestige"];
37              
38 1         2 my $turn;
39 1 50       3 if($in_the_middle)
40             {
41 1         9 $turn = prev_turn($self->current_year);
42             }
43             else
44             {
45 0         0 $turn = $self->current_year;
46             }
47 1         5 my $nation_obj = $self->get_nation($nation);
48 1         8 my $under_influence = $self->is_under_influence($nation);
49 1         5 my @influence = $self->has_influence($nation);
50 1         8 my @ndata = $self->get_nation_statistics_line($nation, $turn, $attributes);
51 1         5 my @routes = $self->routes_for_node($nation);
52 1         6 my @treaties = $self->get_treaties_for_nation($nation);
53 1         5 my @supports = $self->supports($nation);
54 1         7 my @rebel_supports = $self->rebel_supports($nation);
55 1         2 my $first_row_height;
56 1 50       7 if(@treaties > @supports + @rebel_supports)
57             {
58 0         0 $first_row_height = @treaties;
59             }
60             else
61             {
62 1         3 $first_row_height = @supports + @rebel_supports;
63             }
64 1         6 my @crises = $self->get_crises($nation);
65 1         6 my @wars = $self->get_wars($nation);
66 1         2 my $second_row_height;
67 1 50       5 if(@crises > @wars)
68             {
69 1         2 $second_row_height = @crises;
70             }
71             else
72             {
73 0         0 $second_row_height = @wars;
74             }
75 1 50       5 my $latest_order = $self->get_statistics_value($turn, $nation, 'order') ? $self->get_statistics_value($turn, $nation, 'order') : 'NONE';
76 1         20 return BalanceOfPower::Printer::print($mode, $self, 'print_actual_nation_situation',
77             { nation => $nation_obj,
78             under_influence => $under_influence,
79             influence => \@influence,
80             attributes => $attributes_names,
81             nationstats => \@ndata,
82             traderoutes => \@routes,
83             treaties => \@treaties,
84             supports => \@supports,
85             rebel_supports => \@rebel_supports,
86             first_row_height => $first_row_height,
87             crises => \@crises,
88             wars => \@wars,
89             second_row_height => $second_row_height,
90             latest_order => $latest_order,
91             } );
92             }
93              
94             sub print_borders_analysis
95             {
96 0     0 0 0 my $self = shift;
97 0         0 my $nation = shift;
98 0   0     0 my $mode = shift || 'print';
99 0         0 my @borders = $self->near_nations($nation, 1);
100 0         0 my %data;
101              
102 0         0 foreach my $b (@borders)
103             {
104 0         0 my $rel = $self->diplomacy_exists($nation, $b);
105 0         0 $data{$b}->{'relation'} = $rel;
106              
107 0         0 my $supps = $self->supported($b);
108 0 0       0 if($supps)
109             {
110 0         0 my $supporter = $supps->start($b);
111 0         0 $data{$b}->{'support'}->{nation} = $supporter;
112 0         0 my $sup_rel = $self->diplomacy_exists($nation, $supporter);
113 0         0 $data{$b}->{'support'}->{relation} = $sup_rel;
114             }
115             }
116 0         0 return BalanceOfPower::Printer::print($mode, $self, 'print_borders_analysis',
117             { nation => $nation,
118             borders => \%data } );
119              
120             }
121             sub print_near_analysis
122             {
123 0     0 0 0 my $self = shift;
124 0         0 my $nation = shift;
125 0   0     0 my $mode = shift || 'print';
126 0         0 my @data = ();
127 0         0 my @near = $self->near_nations($nation, 0);
128 0         0 foreach my $b (@near)
129             {
130 0         0 my $rel = $self->diplomacy_exists($nation, $b);
131 0         0 my $reason = $self->in_military_range($nation, $b);
132             push @data, { nation => $b,
133             relation => $rel,
134             how => $reason->{'how'},
135 0         0 who => $reason->{'who'} };
136             }
137 0         0 BalanceOfPower::Printer::print($mode, $self, 'print_near_analysis',
138             { nation => $nation,
139             near => \@data } );
140             }
141             sub print_hotspots
142             {
143 0     0 0 0 my $self = shift;
144 0   0     0 my $mode = shift || 'print';
145 0         0 my $out = "";
146 0         0 $out .= $self->print_all_crises(undef, 1, $mode);
147 0         0 $out .= $self->print_wars(undef, $mode);
148 0         0 return $out;
149             }
150              
151             sub print_civil_war_report
152             {
153 0     0 0 0 my $self = shift;
154 0         0 my $nation = shift;
155 0 0       0 if (! $self->at_civil_war($nation))
156             {
157 0         0 return "$nation is not fightinh civil war";
158             }
159 0         0 my $out = "";
160 0         0 my $nation_obj = $self->get_nation($nation);
161 0         0 $out .= "Rebel provinces: " . $nation_obj->rebel_provinces . "/" . PRODUCTION_UNITS->[$nation_obj->size] . "\n";
162 0         0 $out .= "Army: " . $nation_obj->army . "\n";
163 0         0 my $sup = $self->supported($nation);
164 0         0 my $rebsup = $self->rebel_supported($nation);
165 0 0       0 $out .= "Support: " . $sup->print . "\n" if($sup);
166 0 0       0 $out .= "Rebel support: " . $rebsup->print . "\n" if ($rebsup);
167 0         0 return $out;
168             }
169              
170             sub print_war_history
171             {
172 0     0 0 0 my $self = shift;
173 0   0     0 my $mode = shift || 'print';
174 0         0 my %wars;
175             my @war_names;
176 0         0 foreach my $w (@{$self->memorial})
  0         0  
177             {
178 0 0       0 if(exists $wars{$w->war_id})
179             {
180 0         0 push @{$wars{$w->war_id}}, $w;
  0         0  
181             }
182             else
183             {
184 0         0 $wars{$w->war_id} = [ $w ];
185 0         0 push @war_names, { name => $w->war_id,
186             start => $w->start_date };
187             }
188             }
189             sub comp
190             {
191 0     0 0 0 compare_turns($a->{start}, $b->{start});
192             }
193 0         0 @war_names = sort comp @war_names;
194 0         0 return BalanceOfPower::Printer::print($mode, $self, 'print_war_history',
195             { wars => \%wars,
196             war_names => \@war_names } );
197             }
198             sub print_civil_war_history
199             {
200 0     0 0 0 my $self = shift;
201 0   0     0 my $mode = shift || 'print';
202 0         0 my %civil_wars;
203             my @civil_war_names;
204 0         0 foreach my $w (@{$self->civil_memorial})
  0         0  
205             {
206 0         0 my $name = $w->name . " - " . $w->start_date;
207 0         0 $civil_wars{$name} = $w;
208 0         0 push @civil_war_names, { name => $name,
209             start => $w->start_date };
210             }
211             sub civil_comp
212             {
213 0     0 0 0 compare_turns($a->{start}, $b->{start});
214             }
215 0         0 @civil_war_names = sort civil_comp @civil_war_names;
216 0         0 return BalanceOfPower::Printer::print($mode, $self, 'print_civil_war_history',
217             { civil_wars => \%civil_wars,
218             civil_war_names => \@civil_war_names } );
219             }
220             sub print_treaties_table
221             {
222 0     0 0 0 my $self = shift;
223 0         0 my $out = sprintf "%-20s %-6s %-5s %-5s %-5s", "Nation", "LIMIT", "ALL", "NAG", "COM";
224 0         0 $out .= "\n";
225 0         0 my @nations = @{$self->nation_names};
  0         0  
226 0         0 for(@nations)
227             {
228 0         0 my $n = $_;
229 0         0 my $limit = $self->get_nation($n)->treaty_limit;
230 0         0 my $alls = $self->get_treaties_for_nation_by_type($n, 'alliance');
231 0         0 my $coms = $self->get_treaties_for_nation_by_type($n, 'commercial');
232 0         0 my $nags = $self->get_treaties_for_nation_by_type($n, 'no aggression');
233 0         0 $out .= sprintf "%-20s %-6s %-5s %-5s %-5s", $n, $limit, $alls, $nags, $coms;
234 0         0 $out .= "\n";
235             }
236 0         0 return $out;
237             }
238             sub player_stocks_status
239             {
240 10     10 0 27 my $self = shift;
241 10         18 my $player = shift;
242 10         41 my $player_obj = $self->get_player($player);
243 10         18 my $stock_value = 0;
244 10         21 my %market_data = ();
245 10         16 foreach my $nation(keys %{$player_obj->wallet})
  10         47  
246             {
247 2 50 33     13 if( $player_obj->stocks($nation) > 0 || $player_obj->influence($nation) > 0)
248             {
249             $market_data{$nation} = { 'stocks' => $player_obj->wallet->{$nation}->{stocks},
250             'value' => $self->get_statistics_value(prev_turn($self->current_year), $nation, "w/d"),
251             'prev_value' => $self->get_statistics_value(prev_turn(prev_turn($self->current_year)), $nation, "w/d"),
252             'influence' => $player_obj->wallet->{$nation}->{influence},
253 2         20 'war_bonds' => $player_obj->wallet->{$nation}->{'war_bonds'},
254             };
255 2         14 $stock_value += $player_obj->wallet->{$nation}->{stocks} * $self->get_statistics_value(prev_turn($self->current_year), $nation, "w/d");
256             }
257             }
258 10         31 my $total_value = $stock_value + $player_obj->money;
259 10         101 return { market_data => \%market_data,
260             stock_value => $stock_value,
261             money => $player_obj->money,
262             total_value => $total_value,
263             points => $player_obj->mission_points };
264             }
265              
266              
267             sub print_stocks
268             {
269 0     0 0 0 my $self = shift;
270 0         0 my $player = shift;
271 0   0     0 my $mode = shift || 'print';
272 0         0 return BalanceOfPower::Printer::print($mode, $self, 'print_stocks', $self->player_stocks_status($player));
273             }
274             sub print_all_stocks
275             {
276 0     0 0 0 my $self = shift;
277 0   0     0 my $mode = shift || 'print';
278 0         0 my %data = ();
279 0         0 my @names;
280 0         0 for(@{$self->players})
  0         0  
281             {
282 0         0 my $p = $_;
283 0         0 push @names, $p->name;
284 0         0 $data{$p->name} = $self->player_stocks_status($p->name);
285             }
286 0         0 @names = sort { $data{$b}->{total_value} <=> $data{$a}->{total_value} } @names;
  0         0  
287              
288 0         0 return BalanceOfPower::Printer::print($mode, $self, 'print_ranking',
289             { players_data => \%data,
290             players => \@names });
291             }
292             sub print_market
293             {
294 0     0 0 0 my $self = shift;
295 0   0     0 my $mode = shift || 'print';
296 0         0 my @ordered = $self->order_statistics(prev_turn($self->current_year), 'w/d');
297 0         0 my %data = ();
298 0         0 my @nations = ();
299 0         0 foreach my $stats (@ordered)
300             {
301 0         0 my $nation = $self->get_nation($stats->{nation});
302 0         0 push @nations, $stats->{nation};
303 0         0 my $status = "";
304 0 0       0 if($self->at_war($nation->name))
    0          
305             {
306 0         0 $status = "WAR";
307             }
308             elsif($self->at_civil_war($nation->name))
309             {
310 0         0 $status = "CIVILW";
311             }
312             $data{$nation->name} = { stocks => $nation->available_stocks,
313             wd => $stats->{value},
314 0         0 status => $status };
315             }
316 0         0 return BalanceOfPower::Printer::print($mode, $self, 'print_market',
317             { market_data => \%data,
318             nations => \@nations } );
319             }
320              
321             sub wars_info
322             {
323 1     1 0 2 my $self = shift;
324 1         2 my %grouped_wars;
325 1         6 foreach my $w ($self->wars->all())
326             {
327 1 50       6 if(! exists $grouped_wars{$w->war_id})
328             {
329 1         4 $grouped_wars{$w->war_id} = [];
330             }
331 1         2 push @{$grouped_wars{$w->war_id}}, $w;
  1         4  
332             }
333 1         1 my @wars;
334 1         4 foreach my $k (keys %grouped_wars)
335             {
336 1         2 my %war;
337 1         2 $war{'name'} = $k;
338 1         3 $war{'conflicts'} = [];
339 1         2 foreach my $w ( @{$grouped_wars{$k}})
  1         2  
340             {
341 1         2 my %subwar;
342 1         3 $subwar{'node1'} = $w->node1;
343 1         3 $subwar{'node2'} = $w->node2;
344 1         4 my $nation1 = $self->get_nation($w->node1);
345 1         21 my $nation2 = $self->get_nation($w->node2);
346 1         5 $subwar{'army1'} = $nation1->army;
347 1         5 $subwar{'army2'} = $nation2->army;
348 1         3 $subwar{'node1_faction'} = $w->node1_faction;
349 1         4 $subwar{'node2_faction'} = $w->node2_faction;
350 1         2 push @{$war{'conflicts'}}, \%subwar;
  1         3  
351             }
352 1         3 push @wars, \%war;
353             }
354 1         4 return @wars;
355             }
356              
357             sub armies_on_territory
358             {
359 0     0 0 0 my $self = shift;
360 0         0 my $nation = shift;
361 0         0 my @conflicts = $self->get_attackers($nation);
362 0         0 my @attackers = ();
363 0         0 for(@conflicts)
364             {
365 0         0 push @attackers, $_->node1;
366             }
367 0         0 my $supporter;
368 0         0 my $supps = $self->supported($nation);
369 0 0       0 if($supps)
370             {
371 0         0 $supporter = $supps->start($nation);
372             }
373 0         0 return { invaders => \@attackers,
374             supporter => $supporter,
375             }
376             }
377              
378             sub print_wars
379             {
380 1     1 0 2 my $self = shift;
381 1         2 my $nation = shift;
382 1   50     7 my $mode = shift || 'print';
383 1         13 my @wars = $self->wars_info();
384 1         1 my @civil_wars;
385 1         2 foreach my $n (@{$self->nation_names})
  1         3  
386             {
387 5 50       10 if($self->at_civil_war($n))
388             {
389 0         0 push @civil_wars, $n;
390             }
391             }
392 1         10 return BalanceOfPower::Printer::print($mode, $self, 'print_wars',
393             { wars => \@wars,
394             civil_wars => \@civil_wars } );
395             }
396             1;