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; |