File Coverage

lib/BalanceOfPower/Executive.pm
Criterion Covered Total %
statement 121 154 78.5
branch 6 14 42.8
condition n/a
subroutine 25 28 89.2
pod 0 5 0.0
total 152 201 75.6


line stmt bran cond sub pod time code
1             package BalanceOfPower::Executive;
2             $BalanceOfPower::Executive::VERSION = '0.400110';
3 13     13   44 use strict;
  13         14  
  13         273  
4 13     13   93 use v5.10;
  13         27  
5              
6 13     13   38 use Moo;
  13         13  
  13         52  
7              
8             with 'BalanceOfPower::Role::Logger';
9              
10 13     13   2410 use BalanceOfPower::Constants ":all";
  13         17  
  13         5433  
11 13     13   64 use BalanceOfPower::Utils qw(as_active as_title);
  13         17  
  13         537  
12 13     13   3428 use BalanceOfPower::Commands::BuildTroops;
  13         26  
  13         339  
13 13     13   3403 use BalanceOfPower::Commands::InMilitaryRange;
  13         20  
  13         409  
14 13     13   3655 use BalanceOfPower::Commands::DeleteRoute;
  13         23  
  13         281  
15 13     13   3269 use BalanceOfPower::Commands::MilitarySupport;
  13         26  
  13         286  
16 13     13   3334 use BalanceOfPower::Commands::RebelMilitarySupport;
  13         20  
  13         275  
17 13     13   3356 use BalanceOfPower::Commands::RecallRebelMilitarySupport;
  13         21  
  13         277  
18 13     13   3296 use BalanceOfPower::Commands::RecallMilitarySupport;
  13         24  
  13         302  
19 13     13   3385 use BalanceOfPower::Commands::ComTreaty;
  13         24  
  13         315  
20 13     13   3785 use BalanceOfPower::Commands::NagTreaty;
  13         22  
  13         290  
21 13     13   3210 use BalanceOfPower::Commands::LowerDisorder;
  13         24  
  13         278  
22 13     13   3124 use BalanceOfPower::Commands::BoostProduction;
  13         22  
  13         279  
23 13     13   3247 use BalanceOfPower::Commands::AddRoute;
  13         25  
  13         272  
24 13     13   3450 use BalanceOfPower::Commands::EconomicAid;
  13         24  
  13         285  
25 13     13   3269 use BalanceOfPower::Commands::DeclareWar;
  13         23  
  13         275  
26 13     13   3298 use BalanceOfPower::Commands::AidInsurgents;
  13         22  
  13         289  
27 13     13   3494 use BalanceOfPower::Commands::DiplomaticPressure;
  13         23  
  13         268  
28 13     13   4627 use BalanceOfPower::Commands::MilitaryAid;
  13         17  
  13         559  
29 13     13   3038 use BalanceOfPower::Commands::Progress;
  13         22  
  13         9681  
30              
31             has actor => (
32             is => 'rw',
33             default => sub { undef }
34             );
35              
36             has commands => (
37             is => 'ro',
38             default => sub { {} }
39             );
40              
41             sub init
42             {
43 73     73 0 92 my $self = shift;
44 73         179 $self->log_name("bop-IA.log");
45 73         154 $self->delete_log();
46 73         136 $self->log_active(1);
47 73         75 my $world = shift;
48 73         1369 my $command =
49             BalanceOfPower::Commands::BuildTroops->new( name => "BUILD TROOPS",
50             domestic_cost => ARMY_COST,
51             world => $world,
52             allowed_at_war => 1, );
53 73         527 $self->commands->{"BUILD TROOPS"} = $command;
54 73         1190 $command =
55             BalanceOfPower::Commands::LowerDisorder->new( name => "LOWER DISORDER",
56             world => $world,
57             domestic_cost => RESOURCES_FOR_DISORDER );
58 73         471 $self->commands->{"LOWER DISORDER"} = $command;
59 73         1229 $command =
60             BalanceOfPower::Commands::AddRoute->new( name => "ADD ROUTE",
61             world => $world,
62             export_cost => ADDING_TRADEROUTE_COST );
63 73         538 $self->commands->{"ADD ROUTE"} = $command;
64 73         1128 $command =
65             BalanceOfPower::Commands::DeclareWar->new( name => "DECLARE WAR TO",
66             synonyms => ["DECLARE WAR"],
67             world => $world,
68             crisis_needed => 1 );
69 73         572 $self->commands->{"DECLARE WAR TO"} = $command;
70 73         1118 $command =
71             BalanceOfPower::Commands::DeleteRoute->new( name => "DELETE TRADEROUTE",
72             synonyms => ["DELETE ROUTE"],
73             world => $world );
74 73         529 $self->commands->{"DELETE TRADEROUTE"} = $command;
75 73         1216 $command =
76             BalanceOfPower::Commands::BoostProduction->new( name => "BOOST PRODUCTION",
77             world => $world,
78             );
79 73         467 $self->commands->{"BOOST PRODUCTION"} = $command;
80 73         1239 $command =
81             BalanceOfPower::Commands::MilitarySupport->new( name => "MILITARY SUPPORT",
82             world => $world,
83             army_limit => { '>' => ARMY_FOR_SUPPORT }
84             );
85 73         493 $self->commands->{"MILITARY SUPPORT"} = $command;
86 73         1198 $command =
87             BalanceOfPower::Commands::RecallMilitarySupport->new( name => "RECALL MILITARY SUPPORT",
88             synonyms => ["RECALL SUPPORT"],
89             world => $world,
90             allowed_at_war => 1,
91             );
92 73         598 $self->commands->{"RECALL MILITARY SUPPORT"} = $command;
93 73         1241 $command =
94             BalanceOfPower::Commands::AidInsurgents->new( name => "AID INSURGENTS IN",
95             synonyms => ["AID INSURGENTS", "AID INSURGENCE"],
96             world => $world,
97             export_cost => AID_INSURGENTS_COST );
98 73         552 $self->commands->{"AID INSURGENTS IN"} = $command;
99 73         1216 $command =
100             BalanceOfPower::Commands::ComTreaty->new( name => "TREATY COM WITH",
101             synonyms => ["COM TREATY",
102             "COM TREATY WITH",
103             "TREATY COM",
104             ],
105             world => $world,
106             prestige_cost => TREATY_PRESTIGE_COST,
107             treaty_limit => 1,
108             );
109 73         515 $self->commands->{"TREATY COM WITH"} = $command;
110 73         1156 $command =
111             BalanceOfPower::Commands::NagTreaty->new( name => "TREATY NAG WITH",
112             synonyms => ["NAG TREATY",
113             "NAG TREATY WITH",
114             "TREATY NAG"
115             ],
116             world => $world,
117             prestige_cost => TREATY_PRESTIGE_COST,
118             treaty_limit => 1,
119             );
120 73         537 $self->commands->{"TREATY NAG WITH"} = $command;
121 73         1178 $command =
122             BalanceOfPower::Commands::EconomicAid->new( name => "ECONOMIC AID FOR",
123             synonyms => ["ECONOMIC AID"],
124             world => $world,
125             export_cost => ECONOMIC_AID_COST,
126             );
127 73         788 $self->commands->{"ECONOMIC AID FOR"} = $command;
128 73         1185 $command =
129             BalanceOfPower::Commands::RebelMilitarySupport->new( name => "REBEL MILITARY SUPPORT",
130             world => $world,
131             army_limit => { '>' => ARMY_FOR_SUPPORT }
132             );
133 73         474 $self->commands->{"REBEL MILITARY SUPPORT"} = $command;
134 73         1116 $command =
135             BalanceOfPower::Commands::DiplomaticPressure->new( name => "DIPLOMATIC PRESSURE ON",
136             world => $world,
137             prestige_cost => DIPLOMATIC_PRESSURE_PRESTIGE_COST
138             );
139 73         467 $self->commands->{"DIPLOMATIC PRESSURE ON"} = $command;
140 73         1149 $command =
141             BalanceOfPower::Commands::RecallRebelMilitarySupport->new( name => "RECALL REBEL MILITARY SUPPORT",
142             world => $world,
143             );
144 73         456 $self->commands->{"RECALL REBEL MILITARY SUPPORT"} = $command;
145 73         1264 $command =
146             BalanceOfPower::Commands::MilitaryAid->new( name => "MILITARY AID FOR",
147             synonyms => ["MILITARY AID"],
148             world => $world,
149             export_cost => MILITARY_AID_COST,
150             );
151 73         620 $self->commands->{"MILITARY AID FOR"} = $command;
152 73         1169 $command =
153             BalanceOfPower::Commands::Progress->new( name => "PROGRESS",
154             world => $world,
155             domestic_cost => PROGRESS_COST,
156             );
157 73         540 $self->commands->{"PROGRESS"} = $command;
158             }
159              
160              
161             sub recognize_command
162             {
163 0     0 0 0 my $self = shift;
164 0         0 my $nation = shift;
165 0         0 my $query = shift;
166 0         0 my $actor = $self->actor;
167 0         0 for(keys %{$self->commands})
  0         0  
168             {
169 0         0 my $c = $self->commands->{$_};
170 0         0 $c->actor($actor);
171 0 0       0 if($c->recognize($query))
172             {
173 0 0       0 if($c->allowed())
174             {
175 0         0 return $c->execute($query, $nation);
176             }
177             else
178             {
179 0         0 return { status => -1 };
180             }
181            
182             }
183             }
184 0         0 return { status => 0 };
185             }
186              
187             sub decide
188             {
189 258     258 0 12689 my $self = shift;
190 258         203 my $order = shift;
191 258 100       657 if(! exists $self->commands->{$order})
192             {
193 6         28 $self->log($self->actor . ": $order doesn't exists!");
194 6         14 return undef;
195             }
196 252         309 my $c = $self->commands->{$order};
197 252         868 $c->actor($self->actor);
198 252 100       549 if($c->allowed())
199             {
200 167         443 my $command = $c->IA();
201 167 100       238 my $exit_log = $command ? $command : "KO";
202 167         636 $self->log($self->actor . ": executing $order: $exit_log");
203 167         462 return $command;
204             }
205             else
206             {
207 85         305 $self->log($self->actor . ": $order not allowed");
208 85         200 return undef;
209             }
210             }
211              
212             sub allowed_orders
213             {
214 0     0 0   my $self = shift;
215 0           my @out;
216 0           for(keys %{$self->commands})
  0            
217             {
218 0           my $c = $self->commands->{$_};
219 0           $c->actor($self->actor);
220 0 0         if( $c->allowed() )
221             {
222 0           push @out, $c->print;
223             }
224             }
225 0           return @out;
226             }
227              
228             sub print_orders
229             {
230 0     0 0   my $self = shift;
231 0           my $out = as_title("ORDERS FOR " . $self->actor);
232 0           $out .= "\n\n";
233 0           for(keys %{$self->commands})
  0            
234             {
235 0           my $c = $self->commands->{$_};
236 0           $c->actor($self->actor);
237 0 0         if( $c->allowed() )
238             {
239 0           $out .= as_active($c->print) . "\n";
240             }
241             else
242             {
243 0           $out .= $c->print . "\n";
244             }
245             }
246 0           return $out;
247             }
248              
249             1;