File Coverage

blib/lib/Games/Lacuna/Task/Action/ShipDispatch.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::ShipDispatch;
2              
3 1     1   1850 use 5.010;
  1         3  
  1         55  
4             our $VERSION = $Games::Lacuna::Task::VERSION;
5              
6 1     1   403 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             use Games::Lacuna::Task::Utils qw(normalize_name);
13              
14             sub description {
15             return q[Dispatch ships based on their name];
16             }
17              
18             has '_planet_re' => (
19             is => 'rw',
20             isa => 'RegexpRef',
21             lazy_build => 1,
22             builder => '_build_planet_re',
23             traits => ['NoGetopt'],
24             );
25              
26             sub _build_planet_re {
27             my ($self) = @_;
28            
29             my @list;
30             foreach my $body ($self->my_planets) {
31             push(@list,$body->{id});
32             push(@list,uc($body->{name}));
33             push(@list,normalize_name($body->{name}));
34             }
35            
36             my $string = join('|', map { "\Q$_\E" } @list);
37             return qr/\b ($string) \b/x;
38             }
39              
40              
41             sub process_planet {
42             my ($self,$planet_stats) = @_;
43            
44             # Get space port
45             my $spaceport_object = $self->get_building_object($planet_stats->{id},'SpacePort');
46            
47             return
48             unless $spaceport_object;
49            
50             # Get all available ships
51             my $ships_data = $self->request(
52             object => $spaceport_object,
53             method => 'view_all_ships',
54             params => [ { no_paging => 1 }, { task => [ 'Docked' ] } ],
55             );
56            
57             my %dispatch;
58            
59             SHIPS:
60             foreach my $ship (@{$ships_data->{ships}}) {
61             # Dispatch to another planet
62             if ( uc($ship->{name}) =~ $self->_planet_re ) {
63             my $target_planet = $self->my_body_status($1);
64             unless ($target_planet->{id} == $planet_stats->{id}) {
65             $dispatch{$target_planet->{id}} ||= [];
66             push (@{$dispatch{$target_planet->{id}}},$ship);
67            
68             $self->log('notice','Dispatching ship %s from %s to %s',$ship->{name},$planet_stats->{name},$target_planet->{name});
69             next SHIPS;
70             }
71             }
72            
73             # Scuttle
74             if ( $ship->{name} =~ m/\b scuttle \b/ix) {
75             $self->log('notice','Scuttling ship %s on %s',$ship->{name},$planet_stats->{name});
76            
77             $self->request(
78             object => $spaceport_object,
79             method => 'scuttle_ship',
80             params => [$ship->{id}],
81             );
82             # Start mining
83             } elsif ( $ship->{name} =~ m/\b(mining|miner)\b/i) {
84             next
85             unless $ship->{hold_size} > 0;
86             $self->log('notice','Starting to mine with ship %s on %s',$ship->{name},$planet_stats->{name});
87            
88             my $mining_object = $self->get_building_object($planet_stats->{id},'MiningMinistry');
89            
90             $self->request(
91             object => $mining_object,
92             method => 'add_cargo_ship_to_fleet',
93             params => [$ship->{id}],
94             );
95             }
96             }
97            
98             foreach my $body_id (sort { scalar(@{$dispatch{$a}}) <=> scalar(@{$dispatch{$b}}) }keys %dispatch) {
99             my $target_planet = $self->my_body_status($body_id);
100             $self->log('debug','Dispatching %i ships from %s to %s',scalar(@{$dispatch{$body_id}}), $planet_stats->{name},$target_planet->{name});
101             $self->push_ships($planet_stats->{id},$body_id,$dispatch{$body_id});
102             }
103             }
104              
105             __PACKAGE__->meta->make_immutable;
106             no Moose;
107             1;