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