File Coverage

lib/BalanceOfPower/Role/WebMaster.pm
Criterion Covered Total %
statement 23 322 7.1
branch 0 20 0.0
condition 0 14 0.0
subroutine 8 24 33.3
pod 0 16 0.0
total 31 396 7.8


line stmt bran cond sub pod time code
1             package BalanceOfPower::Role::WebMaster;
2             $BalanceOfPower::Role::WebMaster::VERSION = '0.400105';
3 13     13   4538 use strict;
  13         20  
  13         289  
4 13     13   97 use v5.10;
  13         29  
5 13     13   42 use Moo::Role;
  13         18  
  13         65  
6              
7 13     13   9287 use LWP::UserAgent;
  13         382371  
  13         372  
8 13     13   7469 use JSON;
  13         109710  
  13         53  
9 13     13   1536 use Data::Dumper;
  13         20  
  13         637  
10 13     13   54 use File::Path qw(make_path remove_tree);
  13         22  
  13         584  
11              
12 13     13   53 use BalanceOfPower::Utils qw(prev_turn next_turn);
  13         19  
  13         26399  
13              
14              
15             has site_root => (
16             is => 'rw',
17             );
18             has api_url => (
19             is => 'rw',
20             );
21             has admin_password => (
22             is => 'rw'
23             );
24              
25             requires 'print_hotspots';
26             requires 'print_allies';
27             requires 'print_influences';
28             requires 'print_military_supports';
29             requires 'print_rebel_military_supports';
30             requires 'print_war_history';
31             requires 'print_civil_war_history';
32             requires 'print_turn_statistics';
33             requires 'print_formatted_turn_events';
34             requires 'print_nation_actual_situation';
35             requires 'print_borders_analysis';
36             requires 'print_near_analysis';
37             requires 'print_diplomacy';
38             requires 'print_nation_events';
39             requires 'pre_decisions_elaborations';
40             requires 'decisions';
41             requires 'post_decisions_elaborations';
42             requires 'print_market';
43             requires 'print_nation_shop_prices';
44             requires 'print_all_nations_prices';
45              
46              
47              
48             sub build_pre_statics
49             {
50 0     0 0   my $self = shift;
51 0           my $game = shift;
52 0   0       my $year = shift || $self->current_year;
53 0           my $site_root = $self->site_root;
54 0           my $dest_dir = "$site_root/views/generated/$game/" . $self->current_year();
55 0           say "Generating pre-decisions statics";
56 0           make_path $dest_dir;
57 0           open(my $hotspots, "> $dest_dir/hotspots.tt");
58 0           print {$hotspots} $self->print_hotspots('html');
  0            
59 0           close($hotspots);
60 0           open(my $allies, "> $dest_dir/alliances.tt");
61 0           print {$allies} $self->print_allies(undef, 'html');
  0            
62 0           close($allies);
63 0           open(my $influences, "> $dest_dir/influences.tt");
64 0           print {$influences} $self->print_influences(undef, 'html');
  0            
65 0           close($influences);
66 0           open(my $supports, "> $dest_dir/supports.tt");
67 0           print {$supports} $self->print_military_supports(undef, 'html');
  0            
68 0           close($supports);
69 0           open(my $reb_supports, "> $dest_dir/rebel-supports.tt");
70 0           print {$reb_supports} $self->print_rebel_military_supports(undef, 'html');
  0            
71 0           close($reb_supports);
72 0           open(my $whistory, "> $dest_dir/war-history.tt");
73 0           print {$whistory} $self->print_war_history('html');
  0            
74 0           close($whistory);
75 0           open(my $cwhistory, "> $dest_dir/civil-war-history.tt");
76 0           print {$cwhistory} $self->print_civil_war_history('html');
  0            
77 0           close($cwhistory);
78 0           open(my $market, "> $dest_dir/market.tt");
79 0           print {$market} $self->print_market('html');
  0            
80 0           close($market);
81 0           open(my $prices, "> $dest_dir/prices.tt");
82 0           print {$prices} $self->print_all_nations_prices($year, 'html');
  0            
83 0           close($prices);
84 0           $self->build_nations_statics($game, $site_root);
85 0           $self->build_players_statics($game, $site_root);
86             }
87              
88             sub build_post_statics
89             {
90 0     0 0   my $self = shift;
91 0           my $game = shift;
92 0           my $site_root = $self->site_root;
93 0   0       my $year = shift || $self->current_year;
94 0           my $dest_dir = "$site_root/views/generated/$game/" . next_turn($year);
95 0           make_path $dest_dir;
96 0           say "Generating post-decisions statics";
97 0           open(my $situation, "> $dest_dir/situation.tt");
98 0           print {$situation} $self->print_turn_statistics($year, undef, 'html');
  0            
99 0           close($situation);
100 0           open(my $events, "> $dest_dir/events.tt");
101 0           print {$events} $self->print_formatted_turn_events($year, undef, 'html');
  0            
102 0           close($events);
103 0           open(my $news, "> $dest_dir/newspaper.tt");
104 0           print {$news} $self->print_newspaper($year, "News", 'html');
  0            
105 0           close($news);
106             }
107              
108             sub build_meta_statics
109             {
110 0     0 0   my $self = shift;
111 0           my $game = shift;
112 0           my $site_root = $self->site_root;
113 0           my $dest_dir = "$site_root/metadata";
114 0           make_path $dest_dir;
115 0           my %nations_to_dump;
116 0           foreach my $n (@{$self->nations})
  0            
117             {
118 0           $nations_to_dump{$n->name} = {
119             code => $n->code,
120             area => $n->area };
121             }
122 0           my %data = ( current_year => $self->current_year,
123             nations => \%nations_to_dump );
124 0           open(my $meta, "> $dest_dir/$game.meta");
125 0           print {$meta} Dumper(\%data);
  0            
126 0           close($meta);
127             }
128              
129             sub build_nations_statics
130             {
131 0     0 0   my $self = shift;
132 0           my $game = shift;
133 0           my $site_root = $self->site_root;
134 0           say "Generating nations statics";
135 0           foreach my $code (keys %{$self->nation_codes})
  0            
136             {
137 0           my $nation = $self->nation_codes->{$code};
138              
139 0           my $dest_dir = "$site_root/views/generated/$game/" . $self->current_year() . "/n/$code";
140 0           make_path($dest_dir);
141 0           open(my $status, "> $dest_dir/actual.tt");
142 0           print {$status} $self->print_nation_actual_situation($nation, 1, 'html');
  0            
143 0           close($status);
144 0           open(my $borders, "> $dest_dir/borders.tt");
145 0           print {$borders} $self->print_borders_analysis($nation, 'html');
  0            
146 0           close($borders);
147 0           open(my $near, "> $dest_dir/near.tt");
148 0           print {$near} $self->print_near_analysis($nation, 'html');
  0            
149 0           close($near);
150 0           open(my $diplomacy, "> $dest_dir/diplomacy.tt");
151 0           print {$diplomacy} $self->print_diplomacy($nation, 'html');
  0            
152 0           close($diplomacy);
153 0           open(my $events, "> $dest_dir/events.tt");
154 0           print {$events} $self->print_nation_events($nation, prev_turn($self->current_year()), undef, 'html');
  0            
155 0           close($events);
156 0           open(my $graphs, "> $dest_dir/graphs.tt");
157 0           print {$graphs} $self->print_nation_graphs($nation, prev_turn($self->current_year()), 10, 'html');
  0            
158 0           close($graphs);
159 0           open(my $prices, "> $dest_dir/prices.tt");
160 0           print {$prices} $self->print_nation_shop_prices($self->current_year, $nation, 'html');
  0            
161 0           close($prices);
162 0           $dest_dir = "$site_root/metadata/$game/n";
163 0           make_path($dest_dir);
164 0           open(my $nation_meta, "> $dest_dir/" . $code . ".data");
165 0           my $civil_war = $self->at_civil_war($nation);
166              
167 0           my $commands = $self->build_commands();
168 0           my $exec = $commands->set_executive($nation);
169 0           my @allowed = $exec->allowed_orders();
170 0           my %command_matrix;
171 0           for(@allowed)
172             {
173 0           my $com_name = $_;
174 0           my $com = $exec->commands->{$com_name};
175 0 0         if($com->has_argument)
176             {
177 0           my @targets = $com->get_available_targets();
178 0 0         if(@targets)
179             {
180 0           $command_matrix{$com_name}->{targets} = \@targets;
181 0           $command_matrix{$com_name}->{argument} = $com->has_argument();
182             }
183             }
184             else
185             {
186 0           $command_matrix{$com_name}->{argument} = $com->has_argument();
187             }
188             }
189 0           my $nation_obj = $self->get_nation($nation);
190 0           my %travels = $self->make_travel_plan($nation);
191 0           my %prices = $self->get_all_nation_prices($nation, $self->current_year);
192 0           my %nation_hash = ( stocks => $nation_obj->available_stocks,
193             internal_production => $nation_obj->production_for_domestic,
194             export_production => $nation_obj->production_for_export,
195             prestige => $nation_obj->prestige,
196             army => $nation_obj->army,
197             civil_war => $civil_war,
198             commands => \%command_matrix,
199             travels => \%travels,
200             prices => \%prices );
201 0           print {$nation_meta} Dumper(\%nation_hash);
  0            
202 0           close($nation_meta);
203             }
204             }
205             sub build_players_statics
206             {
207 0     0 0   my $self = shift;
208 0           my $game = shift;
209 0           my $site_root = $self->site_root;
210 0           say "Generating player statics";
211 0           foreach my $p (@{$self->players})
  0            
212             {
213 0           my $dest_dir = "$site_root/views/generated/$game/" . $self->current_year() . '/p/' . $p->name;
214 0           make_path($dest_dir);
215 0           open(my $stocks, "> $dest_dir/stocks.tt");
216 0           print {$stocks} $self->print_stocks($p->name, 'html');
  0            
217 0           close($stocks);
218 0           open(my $events, "> $dest_dir/events.tt");
219 0           print {$events} $self->print_stock_events($p->name, prev_turn($self->current_year()), "My market events", 3, 'html');
  0            
220 0           close($events);
221 0           open(my $ranking, "> $dest_dir/ranking.tt");
222 0           print {$ranking} $self->print_all_stocks('html');
  0            
223 0           close($ranking);
224 0           open(my $graphs, "> $dest_dir/graphs.tt");
225 0           print {$graphs} $self->print_player_graphs($p->name, prev_turn($self->current_year()), 10, 'html');
  0            
226 0           close($graphs);
227 0           open(my $targets, "> $dest_dir/targets.tt");
228 0           print {$targets} $self->print_targets($p->name, 'html');
  0            
229 0           close($targets);
230              
231              
232 0           $dest_dir = "$site_root/metadata/$game/p";
233 0           make_path($dest_dir);
234 0           open(my $metawallet, "> $dest_dir/" . $p->name . "-wallet.data");
235 0           my %wallet;
236 0           for(keys %{$p->wallet})
  0            
237             {
238 0           my $code = $self->get_nation($_)->code;
239 0           $wallet{$code} = $p->wallet->{$_};
240             }
241 0           my $stock_status = $self->player_stocks_status($p->name);
242 0           my $w_metadata = { wallet => \%wallet, stock_value => $stock_status->{'stock_value'} };
243 0           print {$metawallet} Dumper($w_metadata);
  0            
244 0           close($metawallet);
245             }
246             }
247              
248             sub clean_statics
249             {
250 0     0 0   my $self = shift;
251 0           my $game = shift;
252 0           my $preservation_window = shift;
253 0           my $site_root = $self->site_root;
254 0           my $delete_year = $self->current_year;
255 0           say "Current year: $delete_year";
256 0           say "---";
257 0           for(my $i = $preservation_window; $i > 0; $i--)
258             {
259 0           $delete_year = prev_turn($delete_year);
260             }
261 0           my $deleting = 1;
262 0           while($deleting)
263             {
264 0           my $directory_to_delete = "$site_root/views/generated/$game/$delete_year";
265 0 0 0       if (-e $directory_to_delete and -d $directory_to_delete)
266             {
267 0           say "Deleting $directory_to_delete";
268 0           remove_tree($directory_to_delete);
269 0 0         if($delete_year =~ /1$/)
270             {
271 0           my $parent_directory_to_delete = $directory_to_delete;
272 0           $parent_directory_to_delete =~ s/\/1$//;
273 0           say "Deleting $parent_directory_to_delete";
274 0           remove_tree($parent_directory_to_delete);
275             }
276 0           $delete_year = prev_turn($delete_year);
277             }
278             else
279             {
280 0           $deleting = 0;
281             }
282             }
283             }
284              
285             sub server_available
286             {
287 0     0 0   my $self = shift;
288 0           my $alive = $self->get_web_data('/keepalive', 1);
289 0 0 0       if($alive && $alive eq 'OK')
290             {
291 0           return 1;
292             }
293             else
294             {
295 0           return 0;
296             }
297             }
298              
299             sub generate_whole_turn
300             {
301 0     0 0   my $self = shift;
302 0           my $game = shift;
303 0           my $turn = shift;
304 0           my $site_root = shift;
305 0           $self->pre_decisions_elaborations($turn);
306 0           $self->build_pre_statics($game, $site_root);
307 0           $self->decisions();
308 0           $self->post_decisions_elaborations();
309 0           $self->build_post_statics($game, $site_root);
310             }
311             sub generate_web_interactive_turn
312             {
313 0     0 0   my $self = shift;
314 0           my $game = shift;
315 0           my $site_root = shift;
316 0           $self->collect_api_data($game);
317 0           $self->decisions();
318 0           $self->post_decisions_elaborations();
319 0           $self->build_post_statics($game, $site_root);
320 0           $self->update_web_players($game);
321 0           $self->pre_decisions_elaborations(next_turn($self->current_year));
322 0           $self->build_pre_statics($game, $site_root);
323             }
324              
325             sub manage_web_players
326             {
327 0     0 0   my $self = shift;
328 0           my $game = shift;
329 0           my $players = $self->get_web_data("/api/$game/users");
330 0 0         if($players)
331             {
332 0           my $many = @{$players} + 0;
  0            
333 0           say "$game - $many players on DB";
334 0           for(@{$players})
  0            
335             {
336 0           $self->create_player($_->{'username'}, $_->{'position'}, $_->{'money'});
337             }
338             }
339             else
340             {
341 0           say "$game - players list NOT retrieved";
342             }
343             }
344              
345             sub collect_api_data
346             {
347 0     0 0   my $self = shift;
348 0           my $game = shift;
349 0           $self->manage_web_players($game);
350 0           $self->manage_stock_orders($game);
351 0           $self->manage_influence_orders($game);
352             }
353              
354             sub manage_stock_orders
355             {
356 0     0 0   my $self = shift;
357 0           my $game = shift;
358 0           foreach my $p (@{$self->players})
  0            
359             {
360 0           my $password = $self->admin_password;
361 0           my $user = $p->name;
362 0           my $call = "/api/$game/stock-orders?player=$user&password=$password";
363 0           my $orders = $self->get_web_data($call);
364 0 0         if(defined $orders)
365             {
366 0           say "$game - Stock orders for $user retrieved";
367 0           for(@{$orders})
  0            
368             {
369 0           $self->get_player($p->name)->add_stock_order($_);
370             }
371             }
372             else
373             {
374 0           say "$game - Stock orders for $user NOT retrieved";
375             }
376             }
377             }
378             sub manage_influence_orders
379             {
380 0     0 0   my $self = shift;
381 0           my $game = shift;
382 0           foreach my $p (@{$self->players})
  0            
383             {
384 0           my $password = $self->admin_password;
385 0           my $user = $p->name;
386 0           my $call = "/api/$game/influence-orders?player=$user&password=$password";
387 0           my $orders = $self->get_web_data($call);
388 0 0         if(defined $orders)
389             {
390 0           say "$game - Influence orders for $user retrieved";
391 0           for(@{$orders})
  0            
392             {
393 0           $self->get_player($p->name)->add_control_order($_->{nation}, $_->{command});
394             }
395             }
396             else
397             {
398 0           say "$game - Orders for $user NOT retrieved";
399             }
400             }
401             }
402              
403             sub update_web_players
404             {
405 0     0 0   my $self = shift;
406 0           my $game = shift;
407 0           my $password = $self->admin_password;
408 0           my @players = @{$self->players};
  0            
409 0           foreach my $p (@players)
410             {
411 0           my $res = $self->post_web_data("/api/$game/user-data", { password => $password,
412             player => $p->name,
413             money => $p->money,
414             position => $p->position });
415 0           say "$game - Updating " . $p->name. ": " . $res;
416             }
417             }
418              
419             sub get_web_data
420             {
421 0     0 0   my $self = shift;
422 0           my $call = shift;
423 0   0       my $bare = shift || 0;
424 0           my $ua = LWP::UserAgent->new;
425 0           $ua->timeout(10);
426 0           $ua->env_proxy;
427 0           my $response = $ua->get($self->api_url . $call);
428              
429            
430 0 0         if ($response->is_success) {
431 0 0         if($bare)
432             {
433 0           return $response->decoded_content;
434             }
435             else
436             {
437 0           my $json = JSON->new->allow_nonref;
438 0           return $json->decode( $response->decoded_content );
439             }
440             }
441             else {
442 0           return undef;
443             }
444             }
445              
446             sub post_web_data
447             {
448 0     0 0   my $self = shift;
449 0           my $call = shift;
450 0           my $form = shift;
451 0           my $ua = LWP::UserAgent->new;
452 0           $ua->timeout(10);
453 0           $ua->env_proxy;
454 0           my $response = $ua->post($self->api_url . $call, $form);
455 0           return $response->code;
456             }
457              
458             1;
459              
460