-
Notifications
You must be signed in to change notification settings - Fork 8
/
explorer.pl
executable file
·329 lines (288 loc) · 12.6 KB
/
explorer.pl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
#!/usr/bin/perl
use strict;
use Carp;
use Client;
use DBI;
use Getopt::Long;
use IO::Handle;
use JSON::XS;
use List::Util qw(min max sum first);
use File::Path;
use POSIX qw(strftime);
autoflush STDOUT 1;
autoflush STDERR 1;
my $config_name = "config.json";
my @body_names;
my $db_file = "stars.db";
my $max_build_time = 86400;
my $max_distance = 3000;
my $recheck_distance = 100;
my $recheck_frequency = 30 * 24 * 60 * 60;
my $keep_distance = 15;
my $debug = 0;
my $noaction = 0;
my $quiet = 0;
GetOptions(
"config=s" => \$config_name,
"body|b=s" => \@body_names,
"db=s" => \$db_file,
"max_build_time|build|fill=s" => \$max_build_time,
"max_distance|distance=i" => \$max_distance,
"recheck_distance|recheck=i" => \$recheck_distance,
"recheck_frequency|frequency=s" => \$recheck_frequency,
"keep_distance=i" => \$keep_distance,
"debug+" => \$debug,
"noaction" => \$noaction,
"quiet" => \$quiet,
) or die "$0 --config=foo.json --body=Bar\n";
my $client = Client->new(config => $config_name);
my $empire_name = $client->empire_status->{name};
$max_build_time = $1 if $max_build_time =~ /^(\d+) ?s(econds?)?$/;
$max_build_time = $1 * 60 if $max_build_time =~ /^(\d+) ?m(inutes?)?$/;
$max_build_time = $1 * 3600 if $max_build_time =~ /^(\d+) ?h(ours?)?$/;
$max_build_time = $1 * 86400 if $max_build_time =~ /^(\d+) ?d(ays?)?$/;
$recheck_frequency = $1 if $recheck_frequency =~ /^(\d+) ?s(econds?)?$/;
$recheck_frequency = $1 * 60 if $recheck_frequency =~ /^(\d+) ?m(inutes?)?$/;
$recheck_frequency = $1 * 3600 if $recheck_frequency =~ /^(\d+) ?h(ours?)?$/;
$recheck_frequency = $1 * 86400 if $recheck_frequency =~ /^(\d+) ?d(ays?)?$/;
-f $db_file or die "Database does not exist, please specify star_db_util.pl --create to continue\n";
my $star_db = DBI->connect("dbi:SQLite:$db_file");
$star_db or die "Can't open star database $db_file: $DBI::errstr\n";
$star_db->{RaiseError} = 1;
$star_db->{PrintError} = 0;
# Check if db is current, if not, suggest upgrade
eval {
$star_db->do('select excavated_by from orbitals limit 1');
1;
} or do {
die "Database is outdated, please specify star_db_util.pl --upgrade to continue\n";
};
my $planets = $client->empire_status->{planets};
@body_names = values(%$planets) unless @body_names;
my @body_ids = map { $client->match_planet($_) } @body_names;
if ((@body_ids != @body_names)) {
emit("Aborting due to identification errors", $empire_name);
exit 1;
}
@body_ids = sort { $planets->{$a} cmp $planets->{$b} } @body_ids;
@body_names = map { $planets->{$_} } @body_ids;
my %obs = map { ($_, scalar(eval { $client->find_building($_, "Observatory") } )) } @body_ids;
my %ports = map { ($_, scalar(eval { $client->find_building($_, "Space Port" ) } )) } @body_ids;
my %yards = map { ($_, [ eval { $client->find_building($_, "Shipyard" ) } ]) } @body_ids;
@body_ids = grep { $obs{$_} && $ports{$_} && @{$yards{$_}} } @body_ids;
my %ships = map { ($_, $client->port_all_ships($_)) } @body_ids;
my %stars = map { ($_, $client->get_probed_stars($obs{$_}{id})) } @body_ids;
my %claimed = map { ($_->{to}{id}, $_) }
grep { $_->{type} eq "probe" && $_->{task} eq "Travelling" }
map { @{$ships{$_}{ships}} }
@body_ids;
# for my $body_id (@body_ids) {
# my @travelling = grep { $_->{type} eq "probe" && $_->{task} eq "Travelling" } @{$ships{$body_id}{ships}};
# $claimed{$_->{to}{id}} = $_ for @travelling;
# }
for my $body_id (@body_ids) {
my $stars = $stars{$body_id};
$debug > 2 and emit_json("Probes for $body_id", $stars);
for my $star (@{$stars->{stars}}) {
db_update_star($star, $stars->{status}{_time});
if (!check_keeper($star)) {
$noaction or $client->call(observatory => abandon_probe => $obs{$body_id}{id}, $star->{id});
emit("Abandoning probe at $star->{name} ($star->{x},$star->{y})", $body_id);
$stars->{star_count}--;
}
}
}
for my $body_id (@body_ids) {
my $stars = $stars{$body_id};
my $wanted = $stars->{max_probes} - $stars->{star_count} - $stars->{travelling};
$debug > 1 and emit_json("All ships for $body_id", $ships{$body_id}{ships});
my @probes = grep { $_->{type} eq "probe" } @{$ships{$body_id}{ships}};
my @ready = grep { $_->{task} eq "Docked" } @probes;
$debug > 1 and emit_json("Ready probes for $body_id", \@probes);
my $delta = $wanted - @ready;
ship_build($body_id, "probe", $delta, $max_build_time);
for my $probe (@ready) {
last unless --$wanted >= 0;
my $target = db_find_target($body_id);
$claimed{$target->{id}} = $probe; # Do this immediately to prevent duplicate scans
eval {
my $result;
$noaction or ($result = $client->send_ship($probe->{id}, { star_id => $target->{id} }));
my $arrives = Client::format_time(Client::parse_time($result->{ship}{date_arrives}));
my $body = $client->body_status($body_id);
emit("Sent probe ".int(sqrt(dist2($body, $target)))." units".
" to $target->{name} at ($target->{x},$target->{y}),".
" arriving at $arrives", $body_id);
1;
} or emit("Couldn't send probe to $target->{name} at ($target->{x},$target->{y}): $@", $body_id);
}
}
sub dist2 {
my ($a, $b) = @_;
return ($a->{x} - $b->{x}) * ($a->{x} - $b->{x}) + ($a->{y} - $b->{y}) * ($a->{y} - $b->{y});
}
sub db_update_star {
my $star = shift;
my $when = shift;
my @ores = qw(anthracite bauxite beryl chalcopyrite chromite
fluorite galena goethite gold gypsum
halite kerogen magnetite methane monazite
rutile sulfur trona uraninite zircon);
my @attrs = qw(body_id star_id orbit x y type subtype name size water);
my $now = strftime "%Y-%m-%d %T", gmtime($when);
eval {
for my $body (@{$star->{bodies}}) {
$body->{body_id} = $body->{id};
$body->{subtype} = $body->{image};
$body->{subtype} =~ s/-\d+$//;
$body->{empire} ||= {};
$body->{station} ||= {};
$body->{empire_id} = $body->{empire}{id};
$body->{station_id} = $body->{station}{id};
db_update_empire($body->{empire}, $when);
$debug > 1 && emit("Considering body $body->{name} at ($body->{x},$body->{y})");
my $existing = $star_db->selectrow_arrayref("select body_id, strftime(\"%s\", last_checked) as last_epoch from orbitals where star_id = ? and x = ? and y = ?", {}, $star->{id}, $body->{x}, $body->{y});
$debug > 1 && emit_json("checked", $existing);
if ($existing && $existing->[1] < $when) {
my $existing = $star_db->selectrow_hashref("select ".join(",", @ores, @attrs, "empire_id", "station_id")." from orbitals where x = ? and y = ?", {}, $body->{x}, $body->{y});
if (grep { $existing->{$_} ne $body->{$_} && $existing->{$_} ne $body->{ore}{$_} } (@ores, @attrs, "empire_id", "station_id")) {
emit("Updating body $body->{name} at ($body->{x},$body->{y})");
}
$debug > 2 and emit_json("Updating body $body->{name} at ($body->{x},$body->{y})", $body);
eval {
$star_db->do("update orbitals set ".join(", ", map { "$_ = ?" } (@ores, @attrs)).", empire_id = ?, station_id = ?, last_checked = ? where x = ? and y = ? and last_checked < ?", {},
(map { $body->{ore}{$_} } @ores), (map { $body->{$_} } @attrs), $body->{empire}{id}, $body->{station}{id}, $now, $body->{x}, $body->{y}, $now);
1;
} or emit($star_db->errstr);
} elsif (!$existing) {
$debug && emit("Inserting body $body->{name} at ($body->{x},$body->{y})");
eval {
$star_db->do("insert into orbitals (".join(", ", @ores, @attrs, qw(empire_id station_id last_checked)).") values (".join(", ", map { "?" } (@ores, @attrs), qw(? ? ?)).")", {},
(map { $body->{ore}{$_} } @ores), (map { $body->{$_} } @attrs), $body->{empire}{id}, $body->{station}{id}, $now);
1;
} or emit($star_db->err);
}
}
my $existing = $star_db->selectrow_hashref("select id, name, color, zone from stars where x = ? and y = ?", {}, $star->{x}, $star->{y});
if (grep { $existing->{$_} ne $star->{$_} } qw(id name color zone)) {
emit("Updating star $star->{name} at ($star->{x},$star->{y})");
}
eval {
$star_db->do("update stars set id = ?, name = ?, color = ?, zone = ?, last_checked = ? where x = ? and y = ? and last_checked < ?", {},
$star->{id}, $star->{name}, $star->{color}, $star->{zone}, $now, $star->{x}, $star->{y}, $now);
} or emit($star_db->err);
1;
} or emit("SQL error: ".$star_db->errstr);
}
sub db_update_empire {
my $empire = shift;
my $when = shift;
return unless $empire->{id};
our %empires_seen;
return if $empires_seen{$empire->{id}} >= $when;
$empires_seen{$empire->{id}} = $when;
my $now = strftime "%Y-%m-%d %T", gmtime($when);
eval {
$debug > 1 && emit("Considering empire $empire->{name}");
my $existing = $star_db->selectrow_arrayref("select id, name from empires where id = ?", {}, $empire->{id});
$debug > 1 && emit_json("checked", $existing);
if ($existing && $existing->[1] ne $empire->{name}) {
$debug > 2 and emit_json("Updating empire $empire->{name})", $empire);
eval {
$star_db->do("update empires set name = ? where id = ?", {}, $empire->{name}, $empire->{id});
1;
} or emit($star_db->errstr);
} elsif (!$existing) {
$debug && emit("Inserting empire $empire->{name}");
eval {
$star_db->do("insert into empires (name, id) values (?, ?)", {}, $empire->{name}, $empire->{id});
1;
} or emit($star_db->err);
}
1;
} or emit("SQL error: ".$star_db->errstr);
}
sub check_keeper {
my $star = shift;
my @colonies = map { $client->body_status($_) } keys %$planets;
my @excavators = db_get_excavators();
for my $body (@colonies) {
return 1 if dist2($body, $star) <= $keep_distance * $keep_distance;
}
for my $body (@excavators) {
return 1 if $body->{star_id} eq $star->{id};
}
return 0;
}
sub db_get_excavators {
my $search = $star_db->selectall_arrayref(q(
select star_id, body_id, name, x, y
from orbitals
where excavated_by is not null
), { Slice => {} });
return @$search;
}
sub db_find_target {
my $body_id = shift;
my $sth = $star_db->prepare(q(
select (stars.x - ?) * (stars.x - ?) + (stars.y - ?) * (stars.y - ?) as dist2, id, stars.name, stars.x, stars.y
from stars left join orbitals on id = star_id
where body_id is null or stars.last_checked < ?
order by 1
));
my $body = $client->body_status($body_id);
my $recheck_time = strftime "%Y-%m-%d %T", gmtime(time() - $recheck_frequency);
$sth->execute($body->{x}, $body->{x}, $body->{y}, $body->{y}, $recheck_time);
my $target;
while ($target = $sth->fetchrow_hashref) {
last unless $claimed{$target->{id}};
}
$sth->finish;
return $target;
}
sub ship_build {
my ($body_id, $type, $quantity, $max_time) = @_;
$max_time ||= 30 * 24 * 60 * 60;
my @yards = $client->find_building($body_id, "Shipyard");
$_->{buildable} = $client->yard_buildable($_->{id}) for @yards;
for my $yard (@yards) {
$yard->{work}{seconds_remaining} = Client::parse_time($yard->{work}{end}) - time() if $yard->{work}{end};
$debug && emit("Shipyard $yard->{id} working for $yard->{work}{seconds_remaining} seconds", $body_id);
}
for (1..$quantity) {
my $yard = (sort { ($a->{work}{seconds_remaining} + $a->{buildable}{buildable}{$type}{cost}{seconds}) <=>
($b->{work}{seconds_remaining} + $b->{buildable}{buildable}{$type}{cost}{seconds}) } @yards)[0];
if ($yard->{work}{seconds_remaining} < $max_time) {
$yard->{additional}++;
$yard->{work}{seconds_remaining} += $yard->{buildable}{buildable}{$type}{cost}{seconds};
}
}
for my $yard (@yards) {
if ($yard->{additional}) {
eval {
$noaction or $client->yard_build($yard->{id}, $type, $yard->{additional});
emit("Building $yard->{additional} ${type}s in yard at ($yard->{x},$yard->{y})", $body_id);
1;
} or eval {
$noaction or $client->yard_build($yard->{id}, $type, 1);
emit("Building 1 ${type} in yard at ($yard->{x},$yard->{y})", $body_id);
1;
} or emit("Couldn't build ${type}s: $@", $body_id);
}
}
}
sub emit {
my $message = shift;
my $prefix = shift;
$prefix ||= $empire_name;
my $planets = $client->empire_status->{planets};
$prefix = $planets->{$prefix} if $planets->{$prefix};
print Client::format_time(time())." explorer: $prefix: $message\n";
}
sub emit_json {
return unless $debug;
my $message = shift;
my $hash = shift;
print Client::format_time(time())." $message:\n";
print JSON::XS->new->allow_nonref->canonical->pretty->encode($hash);
}