Permalink
Switch branches/tags
Nothing to show
Find file
Fetching contributors…
Cannot retrieve contributors at this time
1357 lines (1155 sloc) 45.6 KB
package Client;
use strict;
use Carp;
use Exception::Class (
'LacunaRPCException' => { fields => ['code', 'text', 'data'] }
);
use File::Path;
use File::Spec;
use JSON::PP;
use LWP::UserAgent;
use Scalar::Util qw(blessed);
use Time::Local;
use List::Util qw(min max first);
{
package LacunaRPCException;
use overload 'bool' => sub { 1 },
'""' => sub { "LacunaRPCException ".($_[0]->code).": ".($_[0]->text)."\n" },
'0+' => sub { $_[0]->code };
}
sub new {
my $base = shift;
die "Cannot make a new Client from ".ref($base)."\n"
if blessed($base) && !$base->isa("Client");
my $class = ref($base) || $base;
my $self = ref($base) ? { %$base, @_ } : { @_ };
bless($self, $class);
$self->read_config();
$self->{ua} ||= LWP::UserAgent->new();
$self->{cache_root} ||= 'cache';
$self->{total_calls} = 0;
return $self;
}
sub read_json {
my ($self, $filename, $filetype) = @_;
my $file;
# warn "filename: $filename\n";
unless (open($file, "<", $filename)) {
croak "Could not read $filetype file $filename: $!" if $filetype;
return;
}
my $json = do { local $/; <$file> };
close($file);
my $result = eval { decode_json($json) };
return $result;
}
sub write_json {
my $self = shift;
my $filename = shift;
my $filetype = shift;
my $value = shift;
my $dir = File::Spec->catpath((File::Spec->splitpath($filename))[0..1]);
-d $dir or mkpath($dir) or croak "Could not make path $dir: $!";
my $file;
open($file, ">", "$filename.$$") or croak "Could not write $filetype file $filename.$$: $!";
print $file encode_json($value);
close $file;
rename("$filename.$$", $filename) or croak "Could not rename $filetype file $filename.$$ to $filename: $!";
}
sub read_config {
my $self = shift;
croak "config not specified for Client" unless $self->{config};
my $config = $self->read_json($self->{config}, "config");
for my $key (qw(empire_name empire_password uri api_key cache_root captcha_program email_forward)) {
$self->{$key} = $config->{$key} if exists($config->{$key});
# warn "$key: $self->{$key}\n";
}
}
sub parse_time {
my $str = shift;
return timegm($6,$5,$4,$1,$2 - 1,$3) if $str =~ /^(\d+) (\d+) (20\d\d) (\d+):(\d+):(\d+) \+0000$/;
return;
}
sub format_time {
my $time = shift;
my $gm = shift;
my @elems = reverse(($gm ? gmtime($time) : localtime($time))[0..5]);
$elems[0] += 1900;
$elems[1]++;
sprintf("%4d-%02d-%02d %02d:%02d:%02d", @elems);
}
sub format_bignum {
my $num = shift;
my $str = sprintf("%0.0f ", $num);
1 while $str =~ s/(\d)(\d\d\d)(\D)/$1,$2$3/;
chop $str;
return $str;
}
sub log_call {
my $api = shift;
my $message = shift;
my $response = shift;
our $time;
our $count;
my $now = time();
if ($time ne $now) {
$time = $now;
$count = 0;
} else {
$count++;
}
my $dir = File::Spec->catdir("log", substr(format_time($time, 1), 0, 10));
-d $dir or mkpath($dir) or croak "Could not make path $dir: $!";
eval { confess("stacktrace") };
my $stack = $@;
my $password;
if ($api eq "/empire" && $message->{method} eq "login") {
my $password = $message->{params}[1];
$message->{params}[1] = "password elided";
my $pattern = $password;
$pattern =~ s/(\W)/\\$1/g;
$stack =~ s/$pattern/password elided/g;
}
my $filename = join(".", format_time($time, 1), $$, sprintf("%03d", $count), $api, $message->{method});
$filename =~ s-/--g;
$filename =~ s- -_-g;
my $pathname = File::Spec->catfile($dir, $filename);
$pathname =~ s/:/-/g if $pathname =~ /\\/;
my $file;
open($file, ">:utf8", $pathname) or croak "Could not log call: $pathname: $!";
print $file encode_json({
api => $api,
message => $message,
status => $response->status_line,
response => $response->content,
stack => $stack,
});
close($file);
if ($api eq "empire" && $message->{method} eq "login") {
$message->{params}[1] = $password;
}
}
sub call {
my $self = shift;
my $api = shift;
my $method = shift;
my @params = @_;
unshift(@params, $self->session_id) unless "$api/$method" eq "empire/login";
$api = "/$api" unless $api =~ /^\//;
my $message = { jsonrpc => "2.0", id => 1, method => $method, params => [ @params ] };
# warn "Posting to ".($self->{uri} . $api)."\n";
# warn "Content: ".encode_json($message)."\n";
my $response = $self->{ua}->post($self->{uri} . $api, Content => encode_json($message));
$self->{total_calls}++;
log_call($api, $message, $response);
my $result;
eval { $result = decode_json($response->content); };
if (!$result && $@ =~ /^malformed/) {
print $response->content;
die $@;
}
if ($result->{error} && $result->{error}{code} == 1010 && $result->{error}{message} =~ /maximum number of requests/i) {
# {
# "error" : {
# "code" : 1010,
# "data" : null,
# "message" : "You have already made the maximum number of requests (10000) you can make for one day."
# },
# "id" : 1,
# "jsonrpc" : "2.0"
# }
# warn "Request: ".encode_json($message)."\n";
warn "Out of requests. Shutting down.\n";
$self->cache_write( type => 'misc', id => 'rpc_limit', data => { rpc_exceeded => 1 } );
LacunaRPCException->throw(code => $result->{error}{code}, text => $result->{error}{message},
data => JSON::PP->new->allow_nonref->canonical->pretty->encode($result->{error}{data}));
} elsif ($result->{error} && $result->{error}{code} == 1010 && $result->{error}{message} =~ /slow down/i) {
warn "Request throttling active: $result->{error}{message}\nSleeping for 30 seconds before retry.\n";
sleep 30;
return $self->call($api, $method, @_);
} elsif ($result->{error} && $result->{error}{code} == 1016 && $self->{captcha_program}) {
warn "Captcha needed.\n";
$self->present_captcha();
return $self->call($api, $method, @_);
} elsif ($result->{error} && $result->{error}{code} == 1014 && $self->{captcha_program}) {
warn "Captcha answer incorrect.\n";
$self->present_captcha($result->{error}{data});
return "wrong";
} elsif ($result->{error}) {
# warn "Request: ".encode_json($message)."\n";
warn "Error Response: $result->{error}{code}: $result->{error}{message}\n";
LacunaRPCException->throw(code => $result->{error}{code}, text => $result->{error}{message},
data => JSON::PP->new->allow_nonref->canonical->pretty->encode($result->{error}{data}));
}
croak "Call failed: ".($response->status_line) unless $response->is_success;
croak "Call response without result" unless $result->{result};
$self->{session_id} = $result->{result}{session_id} if $result->{result}{session_id};
$self->{session_time} = time();
$self->write_session if $self->{session_id};
my $time = parse_time($result->{result}{status}{server}{time});
$result->{result}{status}{_time} = $time;
my $empire = $result->{result}{status}{empire};
if ($empire) {
$self->cache_write( type => 'empire_status', data => $empire );
eval {
my $message_id = $empire->{latest_message_id} || eval { $empire->{most_recent_message}{id} };
if ($message_id && $message_id ne $self->cache_read( type => 'mail_inbox' )->{messages}[0]{id}) {
# print "Invalidating mailbox: new $empire->{most_recent_message}{id} ne cached ".($self->cache_read( type => 'mail_inbox' )->{messages}[0]{id})."\n";
$self->cache_invalidate( type => 'mail_inbox' );
}
};
}
my $body = $result->{result}{status}{body};
if ($body) {
my @arrivals = map { parse_time($_->{date_arrives}) } @{ $body->{incoming_foreign_ships} || [] };
my $invalid = List::Util::min(time() + 3600, @arrivals);
$self->cache_write( type => 'body_status', id => $body->{id}, data => $body, invalid => $invalid );
}
return $result->{result};
}
sub read_session {
my $self = shift;
my $session = $self->cache_read( type => 'session' );
@$self{ keys %$session } = values %$session;
return;
}
sub write_session {
my $self = shift;
my $session = {
session_id => $self->{session_id},
session_time => time(),
};
$self->cache_write( type => 'session', data => $session );
return;
}
sub session_id {
my $self = shift;
# warn "Known session: $self->{session_id}\n";
return $self->{session_id} if $self->{session_time} >= time() - 3600 * 1.5;
$self->read_session();
# warn "Preexisting session: $self->{session_id}\n";
return $self->{session_id} if $self->{session_time} >= time() - 3600 * 1.5;
my $result = $self->call(empire => login => $self->{empire_name}, $self->{empire_password}, $self->{api_key});
# warn "Created session: $self->{session_id}\n";
return $self->{session_id} if $self->{session_time} >= time() - 3600 * 1.5;
croak "Couldn't get session_id";
}
sub empire_status {
my $self = shift;
my $result = $self->cache_read( type => 'empire_status', stale => 610 );
$result && return $result;
$result = $self->call(empire => login => $self->{empire_name}, $self->{empire_password}, $self->{api_key})->{status}{empire};
return $result || croak "Couldn't get empire status";
}
sub empire_public_profile {
my $self = shift;
my $id = shift;
my $result = $self->cache_read( type => 'empire_profile', id => $id, stale => 86400 );
$result && return $result;
$result = $self->call(empire => view_public_profile => $id);
$self->cache_write( type => 'empire_profile', id => $id, data => $result, invalid => time() + 86400 );
return $result;
}
sub match_planet {
my $self = shift;
my $name = shift;
my $planets = $self->empire_status->{planets};
my @candidates = grep { $planets->{$_} =~ /$name/ } keys %$planets;
return $candidates[0] if @candidates == 1;
LacunaRPCException->throw(code => 1002, text => "Planet name $name not found") unless @candidates;
LacunaRPCException->throw(code => 1002, text => "Planet name $name is ambiguous",
data => JSON::PP->new->allow_nonref->canonical->pretty->encode([ map { $planets->{$_} } @candidates ]));
}
sub body_status {
my $self = shift;
my $body_id = shift;
my $result = $self->cache_read( type => 'body_status', id => $body_id, stale => 500 );
return $result if $result;
$self->cache_invalidate( type => 'buildings', id => $body_id );
$result = $self->body_buildings($body_id)->{status}{body};
return $result || croak "Couldn't get body status";
}
sub body_buildings {
my $self = shift;
my $body_id = shift;
my $result = $self->cache_read( type => 'buildings', id => $body_id );
return $result if $result;
$result = $self->call(body => get_buildings => $body_id);
my @completions;
for my $building (values(%{$result->{buildings}})) {
push(@completions, parse_time($building->{pending_build}{end})) if $building->{pending_build};
push(@completions, parse_time($building->{work }{end})) if $building->{work};
}
my $invalid = List::Util::min(time() + 3600, @completions);
$self->cache_write( type => 'buildings', id => $body_id, data => $result, invalid => $invalid );
return $result;
}
sub body_buildable {
my $self = shift;
my $body_id = shift;
my $result = $self->cache_read( type => 'buildable', id => $body_id );
return $result if $result;
my $buildings = $self->body_buildings($body_id);
my @completions;
for my $building (values(%{$buildings->{buildings}})) {
next unless $building->{pending_build};
# next unless $building->{name} =~ /Oversight|Ore Refinery|Intelligence|University/;
push(@completions, parse_time($building->{pending_build}{end}));
}
my $body = $self->body_status($body_id);
if ($body->{incoming_foreign_ships}) {
push(@completions, map { parse_time($_->{date_arrives}) } @{$body->{incoming_foreign_ships}});
}
if ($body->{incoming_own_ships}) {
push(@completions, map { parse_time($_->{date_arrives}) } @{$body->{incoming_own_ships}});
}
my %plots;
for my $building (values %{$buildings->{buildings}}) {
$plots{$building->{x},$building->{y}} = 1;
}
my @plots;
for my $x (-5 .. 5) {
for my $y (-5 .. 5) {
# next if $x >= 3 && $y >= 3;
push(@plots, [ $x, $y ]) unless $plots{$x,$y};
}
}
$result = $self->call(body => get_buildable => $body_id, $plots[0][0], $plots[0][1]);
my $invalid = List::Util::max(time() + 30, List::Util::min(time() + 600, @completions));
$self->cache_write( type => 'buildable', id => $body_id, invalid => $invalid, data => $result );
return $result;
}
sub body_build {
my $self = shift;
my $body_id = shift;
my $building_name = shift;
my $sx = shift;
my $sy = shift;
my $url = "";
my %plots;
my $existing = $self->body_buildings($body_id);
for my $building (values %{$existing->{buildings}}) {
$plots{$building->{x},$building->{y}} = 1;
$url = $building->{url} if $building->{name} eq $building_name;
}
my @plots;
for my $x (-5 .. 5) {
for my $y (-5 .. 5) {
next if -1 <= $x && $x <= 1 && -1 <= $y && $y <= 1;
# next if $x >= 3 && $y >= 3;
push(@plots, [ $x, $y ]) unless $plots{$x,$y};
}
}
my $place = $plots[int(rand(@plots))];
$place = [ $sx, $sy ] if ($sx || $sy) && !$plots{$sx,$sy};
$url ||= $self->body_buildable($body_id)->{buildable}{$building_name}{url};
return $self->building_build($url, $body_id, @$place);
}
sub building_build {
my $self = shift;
my $url = shift;
my $body_id = shift;
my $x = shift;
my $y = shift;
# invalidate the buildable cache
$self->cache_invalidate( type => 'buildable', id => $body_id );
my $result = $self->call($url => build => $body_id, $x, $y);
if ( $result ) {
# invalidate the buildings cache
$self->cache_invalidate( type => 'buildings', id => $body_id );
$self->cache_invalidate( type => 'plans', id => $body_id );
# invalidate building caches if we upgrade oversight ministry or ore refinery
if ( $url =~ /oversite|orerefinery/ ) {
for my $id ( keys %{$self->body_buildings($result->{status}{body}{id})->{buildings}} ) {
$self->cache_invalidate( type => 'building_stats', id => $id, level => $_ ) for ( 0 .. 30 );
}
}
}
return $result;
}
sub building_demolish {
my $self = shift;
my $url = shift;
my $building_id = shift;
my $result = $self->call($url => demolish => $building_id);
$self->cache_invalidate( type => 'building_view', id => $building_id );
$self->cache_invalidate( type => 'buildings', id => $result->{status}{body}{id} );
$self->cache_invalidate( type => 'buildable', id => $result->{status}{body}{id} );
return $result;
}
sub building_upgrade {
my $self = shift;
my $url = shift;
my $building_id = shift;
if ( my $result = eval { $self->call($url => upgrade => $building_id); } ) {
$self->cache_invalidate( type => 'building_view', id => $building_id );
$self->cache_invalidate( type => 'buildings', id => $result->{status}{body}{id} );
$self->cache_invalidate( type => 'plans', id => $result->{status}{body}{id} );
$self->cache_invalidate( type => 'buildable', id => $result->{status}{body}{id} ) if $url =~ /oversight|orerefinery|intelligence|university/;
# invalidate the buildings cache
$self->cache_invalidate( type => 'buildings', id => $result->{status}{body}{id} );
# invalidate building caches if we upgrade oversight ministry or ore refinery
if ( $url =~ /oversite|orerefinery/ ) {
for my $id ( keys %{$self->body_buildings($result->{status}{body}{id})->{buildings}} ) {
$self->cache_invalidate( type => 'building_stats', id => $id, level => $_ ) for ( 0 .. 30 );
}
}
return $result;
}
else {
if (my $e = Exception::Class->caught('LacunaRPCException')) {
if ($e->code eq 1011 || $e->code eq 1012) {
# Not enough X in storage / production
$self->cache_invalidate( type => 'building_view', id => $building_id );
}
$e->rethrow;
}
else {
my $e = Exception::Class->caught();
ref $e ? $e->rethrow : die $e;
}
}
}
sub body_subsidize {
my $self = shift;
my $body_id = shift;
my $dev = $self->find_building($body_id, "Development Ministry");
my $result = $self->call(development => subsidize_build_queue => $dev->{id});
$self->cache_invalidate(type => "buildings", id => $body_id);
$self->cache_invalidate(type => "buildable", id => $body_id);
return $result;
}
sub halls_sacrifice {
my $self = shift;
my $hall_id = shift;
my $building_id = shift;
my $result = eval { $self->call(hallsofvrbansk => sacrifice_to_upgrade => $hall_id, $building_id); };
$self->cache_invalidate( type => 'building_view', id => $building_id );
$self->cache_invalidate( type => 'buildings', id => $result->{status}{body}{id} );
$self->cache_invalidate( type => 'plans', id => $result->{status}{body}{id} );
return $result;
}
sub building_repair {
my $self = shift;
my $url = shift;
my $building_id = shift;
my $result = $self->call($url => repair => $building_id);
if ( $result ) {
$self->cache_invalidate( type => 'buildings', id => $result->{status}{body}{id} );
$self->cache_invalidate( type => 'building_view', id => $building_id );
}
return $result;
}
sub building_view {
my $self = shift;
my $url = shift;
my $building_id = shift;
my $result = $self->cache_read( type => 'building_view', id => $building_id );
return $result if $result;
$result = $self->call($url, view => $building_id);
my @completions;
for my $building ($result->{building}) {
push(@completions, parse_time($building->{pending_build}{end})) if $building->{pending_build};
push(@completions, parse_time($building->{work }{end})) if $building->{work};
}
push(@completions, time() + 300) unless $result->{building}{upgrade}{can};
my $invalid = List::Util::min(time() + 3600, @completions);
$self->cache_write( type => 'building_view', id => $building_id, invalid => $invalid, data => $result );
return $result;
}
sub building_stats_for_level {
my $self = shift;
my $url = shift;
my $building_id = shift;
my $level = shift;
my $result = $self->cache_read( type => 'building_stats', id => $building_id, level => $level );
return $result if $result;
$result = $self->call($url, get_stats_for_level => $building_id, $level);
$self->cache_write( type => 'building_stats', id => $building_id, level => $level, data => $result );
return $result;
}
sub find_building {
my $self = shift;
my $where = shift;
my $name = shift;
my $level = shift;
my $buildings = $self->body_buildings($where);
my @buildings = map { { %{$buildings->{buildings}{$_}}, id => $_ } } keys(%{$buildings->{buildings}});
@buildings = grep { $_->{name} eq $name } @buildings;
@buildings = grep { $_->{level} == $level } @buildings if $level;
my @sorted = sort { $a->{level} <=> $b->{level} } @buildings;
if (wantarray()) {
return @sorted;
} else {
return $sorted[$#sorted] if @sorted;
LacunaRPCException->throw(code => 1002, text => "$name not found",
data => JSON::PP->new->allow_nonref->canonical->pretty->encode({body_id => $where, name => $name, level => $level}));
}
}
sub body_plans {
my $self = shift;
my $body_id = shift;
my $result = $self->cache_read( type => 'plans', id => $body_id );
return $result if $result;
# Trade and transporter are preferred because of the inclusion of cargo size and plan_type
# The last one is not in an eval so that fundamental exceptions (e.g. login failure) propagate
$result = eval { $self->call(trade => get_plan_summary => scalar($self->find_building($body_id, "Trade Ministry" ))->{id}) } ||
eval { $self->call(transporter => get_plan_summary => scalar($self->find_building($body_id, "Subspace Transporter" ))->{id}) } ||
$self->call(planetarycommand => view_plans => scalar($self->find_building($body_id, "Planetary Command Center"))->{id});
my @arrivals;
for my $type (qw(incoming_own_ships incoming_enemy_ships incoming_ally_ships incoming_foreign_ships)) {
next unless $result->{status}{body}{$type};
for my $ship (@{$result->{status}{body}{$type}}) {
push(@arrivals, parse_time($ship->{date_arrives}));
}
}
my $invalid = List::Util::min(time() + 3600, @arrivals);
$self->cache_write( type => 'plans', id => $body_id, data => $result, invalid => $invalid );
return $result;
}
sub body_waste_chain {
my $self = shift;
my $body_id = shift;
my $result = $self->cache_read( type => 'waste_chain', id => $body_id );
return $result if $result;
$result = $self->call(trade => view_waste_chains => scalar($self->find_building($body_id, "Trade Ministry"))->{id});
my $invalid = time() + (23 * 3600);
$self->cache_write( type => 'waste_chain', id => $body_id, data => $result, invalid => $invalid );
return $result;
}
sub add_waste_ship_to_fleet {
my $self = shift;
my $body_id = shift;
my $ship_id = shift;
my $result = $self->call(trade => add_waste_ship_to_fleet =>
scalar($self->find_building($body_id, "Trade Ministry"))->{id}, $ship_id);
$self->cache_invalidate( type => 'waste_chain', id => $body_id );
$self->cache_invalidate( type => 'spaceport_view_all_ships', id => $body_id );
return $result;
}
sub remove_waste_ship_from_fleet {
my $self = shift;
my $body_id = shift;
my $ship_id = shift;
my $result = $self->call(trade => remove_waste_ship_from_fleet =>
scalar($self->find_building($body_id, "Trade Ministry"))->{id}, $ship_id);
$self->cache_invalidate( type => 'waste_chain', id => $body_id );
$self->cache_invalidate( type => 'spaceport_view_all_ships', id => $body_id );
return $result;
}
sub scuttle_ship {
my $self = shift;
my $body_id = shift;
my $ship_id = shift;
my $result = $self->call(spaceport => scuttle_ship =>
scalar($self->find_building($body_id, "Space Port"))->{id}, $ship_id);
$self->cache_invalidate( type => 'spaceport_view_all_ships', id => $body_id );
return $result;
}
sub name_ship {
my $self = shift;
my $body_id = shift;
my $ship_id = shift;
my $name = shift;
my $result = $self->call(spaceport => name_ship =>
scalar($self->find_building($body_id, "Space Port"))->{id}, $ship_id, $name);
$self->cache_invalidate( type => 'spaceport_view_all_ships', id => $body_id );
return $result;
}
sub view_excavators {
my $self = shift;
my $body_id = shift;
my $result = $self->cache_read( type => 'excavators', id => $body_id );
return $result if $result;
# Trade and transporter are preferred because of the inclusion of cargo size
# The last one is not in an eval so that fundamental exceptions (e.g. login failure) propagate
$result = $self->call(archaeology => view_excavators => scalar($self->find_building($body_id, "Archaeology Ministry"))->{id});
my @travelling;
if ($result->{travelling}) {
my $ships = $self->port_all_ships($body_id);
@travelling = grep { $_->{type} eq "excavator" && $_->{task} eq "Travelling" } @{$ships->{ships}};
if ($result->{travelling} != @travelling) {
$self->cache_invalidate( type => 'spaceport_view_all_ships', id => $body_id );
my $ships = $self->port_all_ships($body_id);
@travelling = grep { $_->{type} eq "excavator" && $_->{task} eq "Travelling" } @{$ships->{ships}};
}
}
my @arrivals = map { parse_time($_->{date_arrives}) } @travelling;
my $invalid = List::Util::min(time() + (23 * 3600), @arrivals);
$self->cache_write( type => 'excavators', id => $body_id, data => $result, invalid => $invalid );
return $result;
}
sub glyph_list {
my $self = shift;
my $body_id = shift;
my $result = $self->cache_read( type => 'glyphs', id => $body_id );
return $result if $result;
# Trade and transporter are preferred because of the inclusion of cargo size
# The last one is not in an eval so that fundamental exceptions (e.g. login failure) propagate
$result = eval { $self->call(trade => get_glyph_summary => scalar($self->find_building($body_id, "Trade Ministry" ))->{id}) } ||
eval { $self->call(transporter => get_glyph_summary => scalar($self->find_building($body_id, "Subspace Transporter"))->{id}) } ||
$self->call(archaeology => get_glyph_summary => scalar($self->find_building($body_id, "Archaeology Ministry"))->{id});
my @arrivals;
for my $type (qw(incoming_own_ships incoming_enemy_ships incoming_ally_ships incoming_foreign_ships)) {
next unless $result->{status}{body}{$type};
for my $ship (@{$result->{status}{body}{$type}}) {
push(@arrivals, parse_time($ship->{date_arrives}));
}
}
my $invalid = List::Util::min(time() + 3600, @arrivals);
$self->cache_write( type => 'glyphs', id => $body_id, data => $result, invalid => $invalid );
return $result;
}
sub glyph_assemble {
my $self = shift;
my $body_id = shift;
my $recipe = shift;
my $count = @_ ? shift : 1;
my $arch = $self->find_building($body_id, "Archaeology Ministry");
my $result = $self->call(archaeology => assemble_glyphs => $arch->{id}, $recipe, $count);
if ($result) {
$self->cache_invalidate( type => 'plans', id => $result->{status}{body}{id} );
$self->cache_invalidate( type => 'glyphs', id => $result->{status}{body}{id} );
}
return $result;
}
sub park_party {
my $self = shift;
my $building_id = shift;
my $result = $self->call(park => throw_a_party => $building_id);
if ( $result ) {
$self->cache_invalidate( type => 'buildings', id => $result->{status}{body}{id} );
$self->cache_invalidate( type => 'building_view', id => $building_id );
}
return $result;
}
sub themepark_operate {
my $self = shift;
my $building_id = shift;
my $result = $self->call(themepark => operate => $building_id);
if ( $result ) {
$self->cache_invalidate( type => 'buildings', id => $result->{status}{body}{id} );
$self->cache_invalidate( type => 'building_view', id => $building_id );
}
return $result;
}
sub recycle_recycle {
my $self = shift;
my $building_id = shift;
my $water = shift;
my $ore = shift;
my $energy = shift;
my $type = shift || "wasterecycling";
my $result = $self->call($type => recycle => $building_id, $water, $ore, $energy, 0);
if ( $result ) {
$self->cache_invalidate( type => 'buildings', id => $result->{status}{body}{id} );
$self->cache_invalidate( type => 'building_view', id => $building_id );
}
return $result;
}
sub archaeology_search {
my $self = shift;
my $building_id = shift;
my $ore = shift;
my $result = $self->call(archaeology => search_for_glyph => $building_id, $ore);
if ( $result ) {
$self->cache_invalidate( type => 'buildings', id => $result->{status}{body}{id} );
$self->cache_invalidate( type => 'building_view', id => $building_id );
$self->cache_invalidate( type => 'glyphs', id => $result->{status}{body}{id} );
}
return $result;
}
sub ores_for_search {
my $self = shift;
my $building_id = shift;
my $result = $self->call(archaeology => get_ores_available_for_processing => $building_id);
return $result;
}
sub get_glyphs {
my $self = shift;
my $building_id = shift;
my $result = $self->call(archaeology => get_glyphs => $building_id);
return $result;
}
sub port_all_ships {
my $self = shift;
my $building_id = shift;
my $body_id;
my $planets = $self->empire_status->{planets};
if ($planets->{$building_id}) {
$body_id = $building_id;
$building_id = $self->find_building($body_id, "Space Port")->{id};
} else {
$body_id = $self->building_stats_for_level(spaceport => $building_id, 1)->{status}{body}{id};
}
my $result = $self->cache_read( type => 'spaceport_view_all_ships', id => $body_id, stale => 3600 );
return $result if $result;
my @ships;
$result = $self->call(spaceport => view_all_ships => $building_id, { no_paging => 1 });
push(@ships, @{$result->{ships}});
$result->{ships} = [ @ships ];
my @completions;
for my $ship (@{$result->{ships}}) {
if ($ship->{date_available}) {
my $available = parse_time($ship->{date_available});
push(@completions, $available) if $available > time() + 30;
}
push(@completions, parse_time($ship->{date_arrives})) if $ship->{date_arrives};
}
my $invalid = List::Util::min(time() + 3600, @completions);
$self->cache_write( type => 'spaceport_view_all_ships', id => $body_id, data => $result, invalid => $invalid );
return $result;
}
sub get_probed_stars {
my $self = shift;
my $building_id = shift;
my $result = $self->cache_read( type => 'observatory_get_probed_stars', id => $building_id );
return $result if $result;
my $page = 1;
my @stars;
for (;;) {
$result = $self->call(observatory => get_probed_stars => $building_id, $page);
push @stars, @{$result->{stars}};
last if @{$result->{stars}} < 25;
$page++;
}
$result->{stars} = \@stars;
my $invalid = time() + 600;
$self->cache_write( type => 'observatory_get_probed_stars', id => $building_id, data => $result, invalid => $invalid );
return $result;
}
sub ships_for {
my $self = shift;
my $planet = shift;
my $target = shift;
my $result = $self->call(spaceport => get_ships_for => $planet, $target);
return $result;
}
sub send_ship {
my $self = shift;
my $ship = shift;
my $target = shift;
my $result = $self->call(spaceport => send_ship => $ship, $target);
return $result;
}
sub send_fleet {
my $self = shift;
my $ships = shift;
my $target = shift;
my $result = $self->call(spaceport => send_fleet => $ships, $target);
return $result;
}
sub send_spies {
my $self = shift;
my $from = shift;
my $to = shift;
my $ship = shift;
my $spies = shift;
my $result = $self->call(spaceport => send_spies => $from, $to, $ship, $spies);
return $result;
}
sub fetch_spies {
my $self = shift;
my $from = shift;
my $to = shift;
my $ship = shift;
my $spies = shift;
my $result = $self->call(spaceport => fetch_spies => $from, $to, $ship, $spies);
return $result;
}
sub yard_queue {
my $self = shift;
my $building_id = shift;
my $result = $self->cache_read( type => 'shipyard_view_build_queue', id => $building_id );
return $result if $result;
my $page = 1;
my @ships;
for (;;) {
$result = $self->call(shipyard => view_build_queue => $building_id, $page);
push(@ships, @{$result->{ships_building}});
last if @{$result->{ships_building}} < 25;
$page++;
}
$result->{ships_building} = [ @ships ];
my @completions;
for my $ship (@{$result->{ships_building}}) {
if ($ship->{date_completed}) {
my $available = parse_time($ship->{date_completed});
push(@completions, $available) if $available > time() + 30;
}
push(@completions, parse_time($ship->{date_arrives})) if $ship->{date_arrives};
}
my $invalid = List::Util::min(time() + 3600, @completions);
$self->cache_write( type => 'shipyard_view_build_queue', id => $building_id, data => $result, invalid => $invalid );
return $result;
}
sub yard_buildable {
my $self = shift;
my $yard_id = shift;
my $result = $self->cache_read( type => 'shipyard_buildable', id => $yard_id );
return $result if $result;
$result = $self->call(shipyard => get_buildable => $yard_id);
# Building completions can affect shipyard builds
my $body_id = $result->{status}{body}{id};
my $buildings = $self->body_buildings($body_id);
my @completions;
for my $building (values(%{$buildings->{buildings}})) {
next unless $building->{pending_build};
push(@completions, parse_time($building->{pending_build}{end}));
}
my $invalid = List::Util::max(time() + 30, List::Util::min(time() + 600, @completions));
$self->cache_write( type => 'shipyard_buildable', id => $yard_id, data => $result, invalid => $invalid );
return $result;
}
sub yard_build {
my $self = shift;
my $building_id = shift;
my $type = shift;
my $count = shift || 1;
my $result = $self->call(shipyard => build_ship => $building_id, $type, $count);
$self->cache_invalidate( type => 'buildable', id => $building_id );
$self->cache_invalidate( type => 'shipyard_view_build_queue', id => $building_id );
if ($result) {
$self->cache_invalidate( type => 'buildings', id => $result->{status}{body}{id} );
$self->cache_invalidate( type => 'spaceport_view_all_ships', id => $result->{status}{body}{id} );
}
return $result;
}
sub trade_push {
my $self = shift;
my $building_id = shift;
my $target_id = shift;
my $items = shift;
my $options = shift;
my $result = $self->call(trade => push_items => $building_id, $target_id, $items, $options);
if ($result) {
$self->cache_invalidate( type => 'body_status', id => $target_id );
$self->cache_invalidate( type => 'spaceport_view_all_ships', id => $target_id );
$self->cache_invalidate( type => 'spaceport_view_all_ships', id => $result->{status}{body}{id} );
if (grep { $_->{type} eq "plan" } @$items) {
$self->cache_invalidate( type => 'plans', id => $target_id );
$self->cache_invalidate( type => 'plans', id => $result->{status}{body}{id} );
$self->cache_invalidate( type => 'buildable', id => $result->{status}{body}{id} );
}
if (grep { $_->{type} eq "glyph" } @$items) {
$self->cache_invalidate( type => 'glyphs', id => $target_id );
$self->cache_invalidate( type => 'glyphs', id => $result->{status}{body}{id} );
}
}
return $result;
}
sub transporter_push {
my $self = shift;
my $building_id = shift;
my $target_id = shift;
my $items = shift;
my $result = $self->call(transporter => push_items => $building_id, $target_id, $items);
if ($result) {
$self->cache_invalidate( type => 'body_status', id => $target_id );
if (grep { $_->{type} eq "ship" } @$items) {
$self->cache_invalidate( type => 'spaceport_view_all_ships', id => $target_id );
$self->cache_invalidate( type => 'spaceport_view_all_ships', id => $result->{status}{body}{id} );
}
if (grep { $_->{type} eq "plan" } @$items) {
$self->cache_invalidate( type => 'plans', id => $target_id );
$self->cache_invalidate( type => 'plans', id => $result->{status}{body}{id} );
$self->cache_invalidate( type => 'buildable', id => $result->{status}{body}{id} );
}
if (grep { $_->{type} eq "glyph" } @$items) {
$self->cache_invalidate( type => 'glyphs', id => $target_id );
$self->cache_invalidate( type => 'glyphs', id => $result->{status}{body}{id} );
}
}
return $result;
}
sub depot_transmit {
my $self = shift;
my $building_id = shift;
my $type = shift;
my $result = $self->call(subspacesupplydepot => "transmit_$type" => $building_id);
if ($result) {
$self->cache_invalidate( type => 'buildable', id => $result->{status}{body}{id} );
}
return $result;
}
sub map_get_stars {
my ($self, $x1, $y1, $x2, $y2) = @_;
my $result = $self->call('map' => get_stars => $x1, $y1, $x2, $y2);
return $result;
}
sub mission_list {
my ($self, $where) = @_;
my $result = $self->cache_read( type => 'mission_list', id => $where );
return $result if $result;
$result = $self->call(missioncommand => get_missions => $where);
my $invalid = time() + 600;
$self->cache_write( type => 'mission_list', id => $where, data => $result, invalid => $invalid );
return $result;
}
sub mission_complete {
my ($self, $where, $which) = @_;
$self->cache_invalidate(type => 'mission_list', id => $where);
my $mission = first { $_->{id} eq $which } @{$self->mission_list($where)->{missions}};
my $result = $self->call(missioncommand => complete_mission => $where, $which);
if (grep { /speed.*stealth.*hold size.*combat/ } (@{$mission->{rewards}}, @{$mission->{objectives}})) {
$self->cache_invalidate( type => 'spaceport_view_all_ships', id => $result->{status}{body}{id} );
}
return $result;
}
sub mission_skip {
my ($self, $where, $mission) = @_;
$self->cache_invalidate(type => 'mission_list', id => $where);
return $self->call(missioncommand => skip_mission => $where, $mission);
}
sub spy_list {
my ($self, $where) = @_;
my $result = $self->cache_read( type => 'spy_list', id => $where );
return $result if $result;
my $intel = $self->find_building($where, "Intelligence Ministry");
my @spies;
for my $page (1..30) {
$result = $self->call(intelligence => view_spies => $intel->{id}, $page);
push(@spies, @{$result->{spies}});
$result->{spies} = \@spies;
last if $result->{spy_count} <= $page * 25;
}
my @completions = map { parse_time($_->{available_on}) } grep { !($_->{is_available}) } @{$result->{spies}};
my $invalid = List::Util::max(time() + 30, List::Util::min(time() + (20 * 60 * 60), @completions));
$self->cache_write( type => 'spy_list', id => $where, data => $result, invalid => $invalid );
return $result;
}
sub spy_train {
my ($self, $where, $count) = @_;
my $result = $self->call(intelligence => train_spy => $where, $count);
$self->cache_invalidate(type => 'spy_list', id => $result->{status}{body}{id});
return $result;
}
sub spy_burn {
my ($self, $where, $who) = @_;
my $result = $self->call(intelligence => burn_spy => $where, $who);
$self->cache_invalidate(type => 'spy_list', id => $result->{status}{body}{id});
return $result;
}
sub spy_name {
my ($self, $where, $who, $what) = @_;
my $result = $self->call(intelligence => name_spy => $where, $who, $what);
$self->cache_invalidate(type => 'spy_list', id => $result->{status}{body}{id});
return $result;
}
sub spy_assign {
my ($self, $where, $who, $what) = @_;
my $result = $self->call(intelligence => assign_spy => $where, $who, $what);
$self->cache_invalidate(type => 'spy_list', id => $result->{status}{body}{id});
return $result;
}
sub spy_retrain {
my ($self, $where, $who, $type) = @_;
substr($type, 0, 1) =~ tr/a-z/A-Z/;
my $trainer = $self->find_building($where, "$type Training");
my $result = $self->call($trainer->{url} => train_spy => $trainer->{id}, $who);
$self->cache_invalidate(type => 'spy_list', id => $result->{status}{body}{id});
return $result;
}
# This will only cache the first page of mail.
# That's usually enough for non-interactive use;
# automated processes should be running frequently enough
# to only be interested in recent messages.
sub mail_inbox {
my $self = shift;
my $options = shift || {};
my $result;
if (!keys(%$options)) {
$result = $self->cache_read( type => 'mail_inbox' );
return $result if $result;
}
$result = $self->call( inbox => view_inbox => $options );
if (!keys(%$options)) {
$self->cache_write( type => 'mail_inbox', data => $result );
}
return $result;
}
sub mail_message {
my $self = shift;
my $message_id = shift;
my $result = $self->cache_read( type => 'mail_message', id => $message_id );
return $result if $result;
$result = $self->call( inbox => read_message => $message_id);
$self->cache_write( type => 'mail_message', id => $message_id, data => $result );
return $result;
}
sub mail_trash {
my $self = shift;
my $message_ids = shift;
my $result = $self->call( inbox => trash_messages => $message_ids);
$self->cache_invalidate( type => 'mail_inbox' );
return $result;
}
sub mail_archive {
my $self = shift;
my $message_ids = shift;
my $result = $self->call( inbox => archive_messages => $message_ids);
$self->cache_invalidate( type => 'mail_inbox' );
return $result;
}
sub boost_view {
my $self = shift;
my $result = $self->cache_read(type => 'empire_boosts');
return $result if $result;
my $result = $self->call(empire => 'view_boosts');
my $invalid = List::Util::min(time() + 3600);
$self->cache_write(type => 'empire_boosts', data => $result, invalid => $invalid);
return $result;
}
sub boost_aspect {
my $self = shift;
my $name = shift;
my $result;
if ($name eq "spy_training") {
$result = $self->call(empire => "spy_training_boost");
} else {
$result = $self->call(empire => "boost_$name");
}
$self->cache_invalidate(type => 'empire_boosts');
return $result;
}
sub present_captcha {
my ($self, $captcha) = @_;
$captcha ||= $self->call(captcha => "fetch");
for (;;) {
warn("Fetched captcha guid $captcha->{guid}\n");
my $c_response = $self->{ua}->get($captcha->{url});
my $image = $c_response->content;
my $filename = $captcha->{url};
$filename =~ s-.*/-captcha/-;
-d 'captcha' or mkdir 'captcha';
my $file;
open($file, ">", $filename) or die "Couldn't write captcha image: $filename: $!\n";
print $file $image;
close($file);
open($file, "-|", "$self->{captcha_program} $filename") or die "Couldn't run captcha presenter: $!\n";
my $answer = <$file>;
close($file);
chomp $answer;
$answer =~ s/^ANSWER: //;
if (!$answer) {
$captcha = $self->call(captcha => "fetch");
next;
}
my $response = eval { $self->call(captcha => solve => $captcha->{guid}, $answer) };
if ($response eq "wrong") {
open($file, ">", "$filename.wrong") or die "Couldn't write captcha answer: $!\n";
print $file "$answer\n";
close($file);
warn("Failed captcha guid $captcha->{guid}\n");
} else {
open($file, ">", "$filename.answer") or die "Couldn't write captcha answer: $!\n";
print $file "$answer\n";
close($file);
warn("Solved captcha guid $captcha->{guid}\n");
}
last;
}
}
{
my %path_for = (
empire_boosts => 'empire/boosts',
empire_status => 'empire/status',
empire_profile => 'empire/%d/profile',
body_status => 'body/%d/status',
buildings => 'body/%d/buildings',
buildable => 'body/%d/buildable',
spy_list => 'body/%d/spy_list',
plans => 'body/%d/plans',
glyphs => 'body/%d/glyphs',
excavators => 'body/%d/excavators',
waste_chain => 'body/%d/waste_chain',
building_view => 'building/%d/view',
building_stats => 'building/%d/stats_%d',
spaceport_view_all_ships => 'body/%d/view_all_ships',
observatory_get_probed_stars => 'building/%d/get_probed_stars',
shipyard_view_build_queue => 'building/%d/view_build_queue',
shipyard_buildable => 'building/%d/buildable',
mission_list => 'building/%d/mission_list',
mail_inbox => 'mail/inbox',
mail_message => 'mail/message/%d',
session => 'session',
misc => 'misc/%s',
);
sub _cache_path {
my ($self, $type, $id, $level) = @_;
my ($host) = ( $self->{uri} =~ m|^\w+://(\w+)\.lacunaexpanse\.com$|i );
my $name = $self->{empire_name};
$name =~ s/\W/_/g;
my $result = sprintf "$self->{cache_root}/%s_%s/$path_for{ $type }", grep { defined $_ } $name, $host, $id, $level;
$result = File::Spec->catfile(split(/\//, $result));
return $result;
}
}
sub cache_read {
my ($self, %args) = @_;
my $result = $self->read_json( $self->_cache_path( $args{type}, $args{id}, $args{level} ) );
# short-circuit
return unless $result;
my $now = time();
if (
($result->{_invalid} && ( $result->{_invalid} < $now )) # cache expired
or # or
($args{stale} && ( $result->{_time} <= ( $now - $args{stale} ) )) # cache is stale
) {
unlink $self->_cache_path( $args{type}, $args{id}, $args{level} );
return;
}
return $result;
}
sub cache_write {
my ($self, %args) = @_;
$args{data}{_time} = time();
$args{data}{_invalid} = $args{invalid} if $args{invalid};
my $cache_file = $self->_cache_path( $args{type}, $args{id}, $args{level} );
$self->write_json( $cache_file , $args{type}, $args{data} );
return;
}
sub cache_invalidate {
my ($self, %args) = @_;
unlink $self->_cache_path( $args{type}, $args{id} );
return;
}
sub select_exchange {
my $self = $_[0];
my %existing = %{$_[1]};
my %extra = %{$_[2]};
my %wanted = %{$_[3]};
# ::emit(join("\n", "Need to balance ".List::Util::sum(values(%wanted)).":", map { sprintf("%9d %s", $wanted{$_}, $_) } sort keys %wanted));
# ::emit(join("\n", "Can work with ".List::Util::sum(values(%extra)).":", map { sprintf("%9d %s", $extra{$_}, $_) } sort keys %extra));
my $amount;
my %giving;
my $iteration = 0;
while (($amount = List::Util::sum(values(%wanted)) - List::Util::sum(values(%giving))) > 0) {
return if $iteration++ > 150;
my @ordered = sort { $existing{$a} + $giving{$a} <=> $existing{$b} + $giving{$b} } grep { $giving{$_} < $extra{$_} } keys(%extra);
# ::emit("Ordered resources: ". join(", ", @ordered));
# ::emit(join("\n", "Ordered resources:", map { sprintf("%9d %s", $existing{$_} + $giving{$_}, $_) } @ordered));
last unless @ordered;
my $top = 1;
$top++ while $existing{$ordered[$top]} + $giving{$ordered[$top]} == $existing{$ordered[0]} + $giving{$ordered[0]};
# ::emit("Top: $top, remaining: $amount");
if ($amount >= $top) {
my $step;
if ($top < @ordered) {
$step = List::Util::min((map { $extra{$_} - $giving{$_} } @ordered[0..($top-1)]),
($existing{$ordered[$top]} + $giving{$ordered[$top]}) - ($existing{$ordered[0]} + $giving{$ordered[0]}),
int($amount / $top));
$giving{$_} += $step for @ordered[0..($top-1)];
} else {
$step = List::Util::min((map { $extra{$_} - $giving{$_} } @ordered[0..($top-1)]),
int($amount / $top));
$giving{$_} += $step for @ordered[0..($top-1)];
}
} else {
$giving{$_}++ for @ordered[0..($amount-1)];
}
# ::emit(join("\n", "Giving resources:", map { sprintf("%9d %s", $giving{$_}, $_) } keys(%giving)));
}
return %giving;
}
1;