Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
executable file 147 lines (128 sloc) 4.88 KB
#!/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 $debug = 0;
my $noaction = 0;
my $quiet = 0;
GetOptions(
"config=s" => \$config_name,
"body|b=s" => \@body_names,
"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};
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 %arches = map { ($_, scalar(eval { $client->find_building($_, "Archaeology Ministry") } )) } @body_ids;
@body_ids = grep { $arches{$_} && $arches{$_}{level} } @body_ids;
emit("Looking at bodies ".join(', ', @body_names));
exit(0) unless $noaction || grep { $_ && !($_->{work}{end} && Client::parse_time($_->{work}{end}) >= time()) } values(%arches);
my %glyphs;
for my $body_id (@body_ids) {
my $summary = eval { $client->glyph_list($body_id) };
if (!$summary) {
warn "Couldn't get glyphs on $planets->{$body_id}: $@\n";
next;
}
$glyphs{$_->{name}} += $_->{quantity} for @{$summary->{glyphs}};
}
my @recipes = (
[ qw(goethite halite gypsum trona) ],
[ qw(gold anthracite uraninite bauxite) ],
[ qw(kerogen methane sulfur zircon) ],
[ qw(monazite fluorite beryl magnetite) ],
[ qw(rutile chromite chalcopyrite galena) ],
);
my %bias;
for my $recipe (@recipes) {
my @sorted = sort { $a <=> $b } map { $glyphs{$_} || 0 } @$recipe;
my $average = ($sorted[0] + $sorted[1]) / 2;
for my $ore (@$recipe) {
$bias{$ore} = $glyphs{$ore} - $average;
}
emit(sprintf("%5d %-12s %5d %-12s %5d %-12s %5d %-12s", map { $glyphs{$_}, $_ } @$recipe));
emit(sprintf(" %5d %-12s %5d %-12s %5d %-12s %5d %-12s", map { $bias{$_}, "bias" } @$recipe));
}
for my $body_id (@body_ids) {
next if Client::parse_time($arches{$body_id}{work}{end}) > time();
my $ores = $client->ores_for_search($arches{$body_id}{id});
my @ores = sort { $bias{$a} <=> $bias{$b} } keys (%{$ores->{ore}});
@ores = grep { $bias{$_} < 0 } @ores;
if (@ores) {
emit("Searching for $ores[0] glyph (bias $bias{$ores[0]})", $body_id);
$noaction or $client->archaeology_search($arches{$body_id}{id}, $ores[0]);
$bias{$ores[0]}++;
next;
}
my $embassy = eval { $client->find_building($body_id, "Embassy"); };
if (!$embassy) {
emit("Build an embassy to search for more important glyphs", $body_id);
} else {
my $result = $client->call(embassy => view_stash => $embassy->{id});
if (!($result->{exchanges_remaining_today} && $result->{max_exchange_size} >= 10000)) {
emit("Upgrade your embassy to search for more important glyphs", $body_id);
} else {
my %stored = %{$result->{stored}};
my %stash = %{$result->{stash}};
@ores = sort { $bias{$a} <=> $bias{$b} } keys %bias;
@ores = grep { $stash{$_} >= 10000 && $bias{$_} <= 0 } @ores;
if (!@ores) {
emit("Restock your embassy to search for more important glyphs", $body_id);
} else {
my %wanted = ( $ores[0] => 10000 );
my %extra = map { $_, $stored{$_} } keys %bias;
delete $extra{$ores[0]};
my %giving = $client->select_exchange(\%stash, \%extra, \%wanted);
emit("Exchanging ". join(", ", map { "$giving{$_} $_" } keys(%giving)). " for ". join(", ", map { "$wanted{$_} $_" } keys(%wanted)));
$noaction or eval { $client->call(embassy => exchange_with_stash => $embassy->{id}, { %giving }, { %wanted }); };
emit("Searching for $ores[0] glyph (bias $bias{$ores[0]})", $body_id);
$noaction or eval { $client->archaeology_search($arches{$body_id}{id}, $ores[0]); };
$bias{$ores[0]}++;
next;
}
}
}
my @ores = sort { $bias{$a} <=> $bias{$b} } keys (%{$ores->{ore}});
if (@ores) {
emit("Searching for $ores[0] glyph (bias $bias{$ores[0]})", $body_id);
$noaction or $client->archaeology_search($arches{$body_id}{id}, $ores[0]);
$bias{$ores[0]}++;
next;
}
}
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())." digger: $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);
}