File Coverage

blib/lib/Games/Lacuna/Task/Action/ShipUpdate.pm
Criterion Covered Total %
statement 4 6 66.6
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 6 8 75.0


line stmt bran cond sub pod time code
1             package Games::Lacuna::Task::Action::ShipUpdate;
2              
3 1     1   1674 use 5.010;
  1         4  
  1         55  
4             our $VERSION = $Games::Lacuna::Task::VERSION;
5              
6 1     1   555 use Moose;
  0            
  0            
7             # -traits => 'NoAutomatic';
8             extends qw(Games::Lacuna::Task::Action);
9             with qw(Games::Lacuna::Task::Role::PlanetRun
10             Games::Lacuna::Task::Role::Ships);
11              
12             our @ATTRIBUTES = qw(hold_size combat speed stealth);
13              
14             use List::Util qw(min max);
15             use Games::Lacuna::Task::Utils qw(normalize_name);
16              
17             has 'handle_ships' => (
18             is => 'rw',
19             isa => 'ArrayRef',
20             documentation => "List of ships which should be handled [Multiple]",
21             default => sub {
22             return [qw(barge cargo_ship dory fighter freighter galleon hulk observatory_seeker scow security_ministry_seeker smuggler_ship snark spaceport_seeker sweeper)];
23             },
24             );
25              
26             has 'best_ships' => (
27             is => 'rw',
28             isa => 'HashRef',
29             traits => ['NoGetopt','Hash'],
30             lazy_build => 1,
31             handles => {
32             available_best_ships => 'count',
33             get_best_ship => 'get',
34             best_ship_types => 'keys',
35             },
36             );
37              
38             has 'best_planets' => (
39             is => 'rw',
40             isa => 'HashRef',
41             traits => ['NoGetopt','Hash'],
42             lazy_build => 1,
43             handles => {
44             get_best_planet => 'get',
45             remove_best_planet => 'delete',
46             has_best_planet => 'count',
47             best_planet_ids => 'keys',
48             },
49             );
50              
51             has 'threshold' => (
52             is => 'rw',
53             isa => 'Int',
54             required => 1,
55             default => 20,
56             documentation => "Threshold for ship attributes [Default: 20%]",
57             );
58              
59             sub description {
60             return q[Keep fleet up to date by building new ships and scuttling old ones. Best used in conjunction with ship_dispatch];
61             }
62              
63             sub run {
64             my ($self) = @_;
65            
66             unless ($self->available_best_ships) {
67             $self->log('notice','No sphipyard slots available. Cannot proceed');
68             return;
69             }
70            
71             foreach my $planet_stats ($self->get_planets) {
72             $self->check_best_planets();
73             last
74             unless $self->has_best_planet;
75             $self->log('info',"Processing planet %s",$planet_stats->{name});
76             $self->process_planet($planet_stats);
77             }
78             }
79              
80             sub process_planet {
81             my ($self,$planet_stats) = @_;
82            
83             # Get space port
84             my $spaceport_object = $self->get_building_object($planet_stats->{id},'SpacePort');
85            
86             return
87             unless $spaceport_object;
88            
89             # Get all available ships
90             my $ships_data = $self->request(
91             object => $spaceport_object,
92             method => 'view_all_ships',
93             params => [ { no_paging => 1 } ],
94             );
95            
96             my $old_ships = {};
97             my $threshold = $self->threshold / 100 + 1;
98            
99             # Loop all shios
100             SHIPS:
101             foreach my $ship (@{$ships_data->{ships}}) {
102             my $ship_type = $ship->{type};
103             $ship_type =~ s/\d$//;
104            
105             # Filter ships by name, type and task
106             next
107             if $ship->{name} =~ m/\b scuttle \b/ix;
108             next
109             if $ship->{task} ~~ [qw(Waiting On Trade Building)];
110             next
111             unless $ship_type ~~ $self->handle_ships;
112             next
113             unless defined $self->best_ships->{$ship_type};
114            
115             my $best_ship = $self->get_best_ship($ship_type);
116            
117             my $ship_is_ok = 1;
118            
119             foreach my $attribute (@ATTRIBUTES) {
120             if ($ship->{$attribute} > $best_ship->{$attribute}) {
121             next SHIPS;
122             }
123             if ($ship->{$attribute} < ($best_ship->{$attribute} / $threshold)) {
124             $ship_is_ok = 0;
125             }
126             }
127            
128             next
129             if $ship_is_ok;
130            
131             $self->log('debug','Ship %s on %s is outdated',$ship->{name},$planet_stats->{name});
132            
133             $old_ships->{$ship_type} ||= [];
134             push (@{$old_ships->{$ship_type}},$ship);
135             }
136            
137             foreach my $ship_type (sort { scalar @{$old_ships->{$b}} <=> scalar @{$old_ships->{$a}} } keys %{$old_ships}) {
138             my $old_ships = $old_ships->{$ship_type};
139             my $best_ships = $self->get_best_ship($ship_type);
140             my $build_planet_id = $best_ships->{planet};
141             my $build_planet_stats = $self->get_best_planet($build_planet_id);
142             next
143             if ! defined $build_planet_stats
144             ||$build_planet_stats->{total_slots} <= 0;
145            
146             my $build_spaceport = $self->find_building($build_planet_id,'SpacePort');
147             my $build_spaceport_object = $self->build_object($build_spaceport);
148            
149             my (@ships_mining,@ships_general);
150             foreach my $old_ship (@{$old_ships}) {
151             if ($old_ship->{task} eq 'Mining') {
152             push(@ships_mining,$old_ship);
153             } else {
154             push(@ships_general,$old_ship);
155             }
156             }
157            
158             my $name_prefix = ($build_planet_id == $planet_stats->{id} ) ? '' : $planet_stats->{name};
159            
160             my @new_building = $self->build_ships(
161             planet => $self->my_body_status($build_planet_id),
162             quantity => scalar(@{$old_ships}),
163             type => $best_ships->{type},
164             spaceports_slots => $build_planet_stats->{spaceport_slots},
165             shipyard_slots => $build_planet_stats->{shipyard_slots},
166             shipyards => $build_planet_stats->{shipyards},
167             name_prefix => $name_prefix,
168             );
169            
170             my $new_building_count = scalar @new_building;
171             $build_planet_stats->{spaceport_slots} -= $new_building_count;
172             $build_planet_stats->{shipyard_slots} -= $new_building_count;
173             $build_planet_stats->{total_slots} -= $new_building_count;
174            
175             foreach my $new_ship (@new_building) {
176             my $old_ship;
177             if ($old_ship = pop(@ships_mining)) {
178             $self->name_ship(
179             spaceport => $build_spaceport_object,
180             ship => $new_ship,
181             prefix => [ $planet_stats->{name},'Mining' ],
182             name => $new_ship->{type_human},
183             );
184             } else {
185             $old_ship = pop(@ships_general)
186             }
187            
188             $self->name_ship(
189             spaceport => $spaceport_object,
190             ship => $old_ship,
191             prefix => 'Scuttle',
192             ignore => 1,
193             );
194             }
195            
196             #$self->check_best_planets;
197             }
198             }
199              
200             sub _build_best_ships {
201             my ($self) = @_;
202            
203             my $best_ships = {};
204             foreach my $planet_stats ($self->get_planets) {
205             $self->log('info',"Checking best ships at planet %s",$planet_stats->{name});
206             my ($buildable_ships,$docks_available) = $self->get_buildable_ships($planet_stats);
207            
208             BUILDABLE_SHIPS:
209             while (my ($type,$data) = each %{$buildable_ships}) {
210             $data->{planet} = $planet_stats->{id};
211             $best_ships->{$type} ||= $data;
212             foreach my $attribute (@ATTRIBUTES) {
213             if ($best_ships->{$type}{$attribute} < $data->{$attribute}) {
214            
215             $best_ships->{$type} = $data;
216             next BUILDABLE_SHIPS;
217             }
218             }
219             }
220             }
221            
222             return $best_ships;
223             }
224              
225             sub _build_best_planets {
226             my ($self) = @_;
227            
228             my $best_planets = {};
229             foreach my $best_ship ($self->best_ship_types) {
230             my $planet_id = $self->get_best_ship($best_ship)->{planet};
231            
232             unless (defined $best_planets->{$planet_id}) {
233             my ($available_shipyard_slots,$available_shipyards) = $self->shipyard_slots($planet_id);
234             my ($available_spaceport_slots) = $self->spaceport_slots($planet_id);
235            
236             my $shipyard_slots = max($available_shipyard_slots,0);
237             my $spaceport_slots = max($available_spaceport_slots,0);
238             my $total_slots = min($shipyard_slots,$spaceport_slots);
239            
240             $best_planets->{$planet_id} = {
241             shipyard_slots => $shipyard_slots,
242             spaceport_slots => $spaceport_slots,
243             total_slots => $total_slots,
244             shipyards => $available_shipyards,
245             };
246             }
247            
248             $self->log('info',"Best %s can be buildt at %s",$best_ship,$self->my_body_status($planet_id)->{name});
249             }
250            
251             return $best_planets;
252             }
253              
254             sub check_best_planets {
255             my ($self) = @_;
256            
257             foreach my $planet_id ($self->best_planet_ids) {
258             $self->remove_best_planet($planet_id)
259             if $self->get_best_planet($planet_id)->{total_slots} <= 0;
260             }
261             return;
262             }
263              
264             sub get_buildable_ships {
265             my ($self,$planet_stats) = @_;
266            
267             my $shipyard = $self->find_building($planet_stats->{id},'Shipyard');
268            
269             return
270             unless defined $shipyard;
271            
272             my $shipyard_object = $self->build_object($shipyard);
273            
274             my $ship_buildable = $self->request(
275             object => $shipyard_object,
276             method => 'get_buildable',
277             );
278            
279             my $ships = {};
280             while (my ($type,$data) = each %{$ship_buildable->{buildable}}) {
281             my $ship_type = $type;
282             $ship_type =~ s/\d$//;
283            
284             next
285             unless $ship_type ~~ $self->handle_ships;
286             next
287             if $data->{can} == 0
288             && $data->{reason}[1] !~ m/^You can only have \d+ ships in the queue at this shipyard/i
289             && $data->{reason}[1] !~ m/^You do not have \d docks available at the Spaceport/i;
290             next
291             if defined $ships->{$ship_type}
292             && grep { $data->{attributes}{$_} < $ships->{$ship_type}{$_} } @ATTRIBUTES;
293            
294             $ships->{$ship_type} = {
295             (map { $_ => $data->{attributes}{$_} } @ATTRIBUTES),
296             type => $type,
297             };
298             }
299            
300             #,$ship_buildable->{docks_available}
301             return $ships;
302             }
303              
304             __PACKAGE__->meta->make_immutable;
305             no Moose;
306             1;