Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Merge branch 'master' of github.com:tsee/Games-Lacuna-Client

  • Loading branch information...
commit 473a5fe58302c936e08bc4091ef8cf5e423ac60f 2 parents 4c451da + f49f25a
@fireartist fireartist authored
View
207 examples/blackhole.pl
@@ -0,0 +1,207 @@
+#!/usr/bin/perl
+#
+use strict;
+use warnings;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Games::Lacuna::Client;
+use Getopt::Long qw(GetOptions);
+use List::Util qw( first );
+use Date::Parse;
+use Date::Format;
+use YAML::XS;
+use utf8;
+
+ my %opts = (
+ h => 0,
+ v => 0,
+ config => "lacuna.yml",
+ datafile => "data/data_blackhole.js",
+ maxdist => 450,
+ );
+
+ my $ok = GetOptions(\%opts,
+ 'planet=s',
+ 'x=i',
+ 'y=i',
+ 'id=i',
+ 'target=s',
+ 'help|h',
+ 'datafile=s',
+ 'make_asteroid',
+ 'make_planet',
+ 'increase_size',
+ 'change_type=i',
+ 'view',
+ );
+
+ unless ( $opts{config} and -e $opts{config} ) {
+ $opts{config} = eval{
+ require File::HomeDir;
+ require File::Spec;
+ my $dist = File::HomeDir->my_dist_config('Games-Lacuna-Client');
+ File::Spec->catfile(
+ $dist,
+ 'login.yml'
+ ) if $dist;
+ };
+ unless ( $opts{config} and -e $opts{config} ) {
+ die "Did not provide a config file";
+ }
+ }
+ usage() if ($opts{h});
+ if (!$opts{planet}) {
+ print "Need BHG planet set with --planet!\n";
+ usage();
+ }
+ my $json = JSON->new->utf8(1);
+
+ my $target_id;
+ my $params = {};
+ unless ($opts{view}) {
+ if ($opts{change_type}) {
+ if ($opts{change_type} < 1 or $opts{change_type} > 21) {
+ print "New Type must be 1-21\n";
+ usage();
+ }
+ else {
+ $params->{newtype} = $opts{change_type};
+ print "Changing to type $params->{newtype}\n";
+ }
+ }
+ usage() if !$opts{target} && !defined $opts{x} && !defined $opts{y} && !defined $opts{id};
+
+ usage() if defined $opts{x} && !defined $opts{y};
+ usage() if defined $opts{y} && !defined $opts{x};
+ }
+
+ my $ofh;
+ open($ofh, ">", $opts{datafile}) || die "Could not open $opts{datafile}";
+
+ my $glc = Games::Lacuna::Client->new(
+ cfg_file => $opts{config},
+ # debug => 1,
+ );
+
+ my $data = $glc->empire->view_species_stats();
+ my $ename = $data->{status}->{empire}->{name};
+ my $ststr = $data->{status}->{server}->{time};
+
+# reverse hash, to key by name instead of id
+ my %planets = map { $data->{status}->{empire}->{planets}{$_}, $_ }
+ keys %{ $data->{status}->{empire}->{planets} };
+
+# Load planet data
+ my $body = $glc->body( id => $planets{$opts{planet}} );
+
+ my $result = $body->get_buildings;
+
+ my ($x,$y) = @{$result->{status}->{body}}{'x','y'};
+ my $buildings = $result->{buildings};
+
+# Find the BHG
+ my $bhg_id = first {
+ $buildings->{$_}->{url} eq '/blackholegenerator'
+ } keys %$buildings;
+
+ die "No BHG on this planet\n"
+ if !$bhg_id;
+
+ my $target; my $target_name;
+ my $bhg = $glc->building( id => $bhg_id, type => 'BlackHoleGenerator' );
+ if ( defined $opts{x} && defined $opts{y} ) {
+ $target = { x => $opts{x}, y => $opts{y} };
+ $target_name = "$opts{x},$opts{y}";
+ }
+ elsif ( defined $opts{target} ) {
+ $target = { body_name => $opts{target} };
+ $target_name = $opts{target};
+ }
+ elsif ( defined $opts{id} ) {
+ $target = { body_id => $opts{id} };
+ $target_name = $opts{id};
+ }
+ else {
+ die "target arguments missing\n";
+ }
+
+ if ($bhg) {
+ if ($opts{view}) {
+ print "Viewing BHG: $bhg_id\n";
+ }
+ else {
+ print "Targetting $target_name with $bhg_id\n";
+ }
+ }
+ else {
+ print "No BHG!\n";
+ }
+
+ my $bhg_out;
+ if ($opts{view}) {
+ $bhg_out = $bhg->view();
+ }
+ elsif ($opts{make_planet}) {
+ $bhg_out = $bhg->generate_singularity($target, "Make Planet");
+ }
+ elsif ($opts{make_asteroid}) {
+ $bhg_out = $bhg->generate_singularity($target, "Make Asteroid");
+ }
+ elsif ($opts{increase_size}) {
+ $bhg_out = $bhg->generate_singularity($target, "Increase Size");
+ }
+ elsif ($opts{change_type}) {
+ $bhg_out = $bhg->generate_singularity($target, "Change Type", $params);
+ }
+ else {
+ die "Nothing to do!\n";
+ }
+
+ print $ofh $json->pretty->canonical->encode($bhg_out);
+ close($ofh);
+
+ if ($opts{view}) {
+ print $json->pretty->canonical->encode($bhg_out->{tasks});
+ }
+ else {
+ print $json->pretty->canonical->encode($bhg_out->{effect});
+ }
+
+# print "$glc->{total_calls} api calls made.\n";
+# print "You have made $glc->{rpc_count} calls today\n";
+exit;
+
+sub load_stars {
+ my ($starfile, $range, $hx, $hy) = @_;
+
+ open (STARS, "$starfile") or die "Could not open $starfile";
+
+ my @stars;
+ my $line = <STARS>;
+ while($line = <STARS>) {
+ my ($id, $name, $sx, $sy) = split(/,/, $line, 5);
+ $name =~ tr/"//d;
+ my $distance = sqrt(($hx - $sx)**2 + ($hy - $sy)**2);
+ if ( $distance < $range) {
+ my $star_data = {
+ id => $id,
+ name => $name,
+ x => $sx,
+ y => $sy,
+ dist => $distance,
+ };
+ push @stars, $star_data;
+ }
+ }
+ return \@stars;
+}
+
+sub usage {
+ die <<"END_USAGE";
+Usage: $0 CONFIG_FILE
+ --planet PLANET_NAME
+ --CONFIG_FILE defaults to lacuna.yml
+
+END_USAGE
+
+}
View
191 examples/close_stars.pl
@@ -0,0 +1,191 @@
+#!/usr/bin/perl
+#
+# Script to parse thru the probe data and try to
+# find stars that have been missed in probe net
+#
+# Usage: perl close_stars.pl
+#
+use strict;
+use warnings;
+use Getopt::Long qw(GetOptions);
+use JSON;
+use utf8;
+
+my $home_x;
+my $home_y;
+my $max_dist = 250;
+my $probe_file = "data/probe_data_cmb.js";
+my $star_file = "data/stars.csv";
+my $planet_file = "data/planet_score.js";
+my $planet = '';
+my $sectors = ();
+my $help; my $nodist = 0; my $showprobe = 0;
+
+GetOptions(
+ 'x=i' => \$home_x,
+ 'y=i' => \$home_y,
+ 'planet=s' => \$planet,
+ 'max_dist=i' => \$max_dist,
+ 'nodist' => \$nodist,
+ 'probe=s' => \$probe_file,
+ 'stars=s' => \$star_file,
+ 'showprobe' => \$showprobe,
+ 'help' => \$help,
+ 'zone=s@' => \$sectors,
+);
+
+ usage() if ($help);
+
+ my $bod;
+ my $bodies;
+ my $planets;
+ my $json = JSON->new->utf8(1);
+ if (-e $probe_file) {
+ my $pf; my $lines;
+ open($pf, "$probe_file") || die "Could not open $probe_file\n";
+ $lines = join("", <$pf>);
+ $bodies = $json->decode($lines);
+ close($pf);
+ }
+ else {
+ print STDERR "$probe_file not found!\n";
+ die;
+ }
+ if (-e "$planet_file") {
+ my $pf; my $lines;
+ open($pf, "$planet_file") || die "Could not open $planet_file\n";
+ $lines = join("", <$pf>);
+ $planets = $json->decode($lines);
+ close($pf);
+ }
+ else {
+ unless (defined($home_x) and defined($home_y)) {
+ print STDERR "$planet_file not found!\n";
+ die;
+ }
+ }
+ unless (defined($home_x) and defined($home_y)) {
+ ($home_x, $home_y) = get_coord($planets, $planet);
+ }
+
+ my $stars;
+ if (-e "$star_file") {
+ $stars = get_stars("$star_file", $sectors);
+ }
+ else {
+ print STDERR "$star_file not found!\n";
+ die;
+ }
+
+ my %sys;
+
+ for $bod (@$bodies) {
+ my $star_id = $bod->{star_id};
+ next if (defined($sys{$star_id}));
+ next unless (defined($stars->{$bod->{star_id}}));
+
+ my $dist = sprintf("%.2f", sqrt(($home_x - $stars->{$bod->{star_id}}->{x})**2 +
+ ($home_y - $stars->{$bod->{star_id}}->{y})**2));
+ next if ($dist > $max_dist);
+
+ my $sys_data = {
+ dist => $dist,
+ probed => 1,
+ };
+ $sys{$star_id} = $sys_data;
+ }
+
+ for my $star_id (keys %$stars) {
+ next if (defined($sys{$star_id}));
+ my $dist = sprintf("%.2f", sqrt(($home_x - $stars->{$star_id}->{x})**2 +
+ ($home_y - $stars->{$star_id}->{y})**2));
+ next if ($dist > $max_dist);
+ my $sys_data = {
+ dist => $dist,
+ probed => 0,
+ };
+ $sys{$star_id} = $sys_data;
+ }
+
+ print "ID,Name,X,Y,Color,Zone,P,Dist\n";
+ for my $key (keys %sys) {
+ next if (!$showprobe and $sys{$key}->{probed});
+ printf "%s,%s,%s,%s,%s,%s,%s,%s\n",
+ $key,
+ $stars->{$key}->{name},
+ $stars->{$key}->{x},
+ $stars->{$key}->{y},
+ $stars->{$key}->{color},
+ $stars->{$key}->{zone},
+ $sys{$key}->{probed},
+ $sys{$key}->{dist};
+ }
+exit;
+
+sub get_stars {
+ my ($sfile, $sectors) = @_;
+
+ my $fh;
+ open ($fh, "<", "$sfile") or die;
+
+ my $fline = <$fh>;
+ my %star_hash;
+ while(<$fh>) {
+ chomp;
+ my ($id, $name, $x, $y, $color, $zone) = split(/,/, $_, 6);
+ next if ($sectors and not (grep { $_ eq $zone } @$sectors));
+ $star_hash{$id} = {
+ id => $id,
+ name => $name,
+ x => $x,
+ y => $y,
+ color => $color,
+ zone => $zone,
+ }
+ }
+ return \%star_hash;
+}
+
+sub get_coord {
+ my ($planets, $pname) = @_;
+
+# print "$pname : ", join(":", keys %{$planets}), "\n";
+ my ($prime) = grep { $planets->{$_}->{prime} } keys %{$planets};
+# print "Planet: $prime\n";
+ my $px = $planets->{"$prime"}->{x};
+ my $py = $planets->{"$prime"}->{y};
+
+# print $px, $py, "\n";
+ if (defined($planets->{"$pname"})) {
+ return $planets->{"$pname"}->{x}, $planets->{"$pname"}->{y};
+ }
+ return $px, $py
+
+}
+
+sub usage {
+ diag(<<END);
+Usage: $0 [options]
+
+This program takes your supplied probe file and reports which stars
+within a certain distance have not been probed.
+Probe file generation by probe_yaml.pl and merge_probe.pl
+
+Options:
+ --help - Prints this out
+ --x Num - X coord for distance calculation
+ --y Num - X coord for distance calculation
+ --probe - probe_file,
+ --planet - planet to measure distance from
+ --max_dist - Maximum Distance to report on
+ --stars - star file, default data/stars.csv
+ --showprobe - show probed stars. Default is to show unprobed stars
+ --zone - Only show named zone as in '-3|0'
+END
+ exit 1;
+}
+
+sub diag {
+ my ($msg) = @_;
+ print STDERR $msg;
+}
View
77 examples/merge_probe.pl
@@ -9,11 +9,11 @@
use strict;
use warnings;
use Getopt::Long qw(GetOptions);
-use YAML::XS;
+use JSON;
use utf8;
-my $import_file = "data/probe_data_raw.yml";
-my $merge_file = "data/probe_data_cmb.yml";
+my $import_file = "data/probe_data_raw.js";
+my $merge_file = "data/probe_data_cmb.js";
my $star_file = "data/stars.csv";
my $help = 0;
@@ -26,9 +26,20 @@
usage() if $help;
-
- my $import = YAML::XS::LoadFile($import_file);
- my $merged = YAML::XS::LoadFile($merge_file);
+ my $json = JSON->new->utf8(1);
+ $json = $json->pretty([1]);
+ $json = $json->canonical([1]);
+
+ my $imp_f; my $mrg_f; my $new_f; my $lines;
+ open($imp_f, "$import_file") || die "Could not open $import_file\n";
+ $lines = join("", <$imp_f>);
+ my $import = $json->decode($lines);
+ close($imp_f);
+
+ open($mrg_f, "$merge_file") || die "Could not open $merge_file\n";
+ $lines = join("", <$mrg_f>);
+ my $merged = $json->decode($lines);
+ close($mrg_f);
my $stars;
if (-e "$star_file") {
@@ -87,11 +98,9 @@
}
my @merged = map { $mhash{$_} } sort keys %mhash;
- my $fh;
- open($fh, ">", "$merge_file") || die "Could not open $merge_file";
-
- YAML::XS::DumpFile($fh, \@merged);
- close($fh);
+ open($new_f, ">", "$merge_file") || die "Could not open $merge_file\n";
+ print $new_f $json->pretty->canonical->encode(\@merged);
+ close($new_f);
exit;
sub merge_probe {
@@ -125,6 +134,7 @@ sub merge_probe {
$orig->{observatory}->{stime} = $data->{observatory}->{stime};
$orig->{observatory}->{ststr} = $data->{observatory}->{ststr};
if ($data_e ne '') {
+ print "Empire Info update for $orig->{name}\n" unless ($orig_e eq '' or cmp_emp($orig, $data));
$orig->{empire}->{alignment} = $data->{empire}->{alignment};
$orig->{empire}->{id} = $data->{empire}->{id};
$orig->{empire}->{is_isolationist} = $data->{empire}->{is_isolationist};
@@ -160,8 +170,26 @@ sub merge_probe {
delete $orig->{water_stored};
}
}
+ if ($orig->{star_name} ne $data->{star_name}) {
+ printf "Starname changed from %s to %s.\n",
+ $orig->{star_name}, $data->{star_name};
+ $orig->{star_name} = $data->{star_name};
+ }
+ if (defined($data->{station})) {
+ if (!defined($orig->{station})) {
+ printf "Star %s has been claimed by Station: %s!\n",
+ $data->{star_name}, $data->{station}->{name};
+ %{$orig->{station}} = %{$data->{station}};
+ }
+ elsif ($data->{station}->{name} ne $orig->{station}->{name}) {
+ printf "Star %s has been claimed by Station: %s from Station: %s!\n",
+ $data->{star_name}, $data->{station}->{name},
+ $orig->{station}->{name};
+ %{$orig->{station}} = %{$data->{station}};
+ }
+ }
if ($orig->{type} ne $data->{type}) {
-# We probably have a new space station to account for
+# We probably have a new space station or asteroid to account for
printf "Changing type of %s from %s:%s to %s:%s\n",
$data->{name}, $orig->{image}, $orig->{type},
$data->{image}, $data->{type};
@@ -170,6 +198,20 @@ sub merge_probe {
return $orig;
}
+sub cmp_emp {
+ my ($orig, $data) = @_;
+
+ my $str1 = join(":", $orig->{empire}->{alignment}, $orig->{empire}->{id},
+ $orig->{empire}->{is_isolationist}, $orig->{empire}->{name});
+ my $str2 = join(":", $data->{empire}->{alignment}, $data->{empire}->{id},
+ $data->{empire}->{is_isolationist}, $data->{empire}->{name});
+
+ if ($str1 eq $str2) {
+ return 1;
+ }
+ return 0;
+}
+
sub copy_body {
my($orig, $data) = @_;
#Easier to swap info into new and return it.
@@ -212,9 +254,10 @@ sub check_sname {
unless (defined($elem->{star_name})) {
$elem->{star_name} = $stars->{$elem->{star_id}}->{name};
}
- if ($elem->{star_name} ne $stars->{$elem->{star_id}}->{name}) {
- $elem->{star_name} = $stars->{$elem->{star_id}}->{name};
- }
+ $elem->{star_name} =~ y/"'//d;
+# if ($elem->{star_name} ne $stars->{$elem->{star_id}}->{name}) {
+# $elem->{star_name} = $stars->{$elem->{star_id}}->{name};
+# }
}
sub get_stars {
@@ -249,8 +292,8 @@ sub usage {
Options:
--help - Prints this out
- --import <file> - File to import, default: data/probe_data_raw.yml
- --merge <file> - Main file to merge into, default: data/probe_data_cmb.yml
+ --import <file> - File to import, default: data/probe_data_raw.js
+ --merge <file> - Main file to merge into, default: data/probe_data_cmb.js
END
exit 1;
View
169 examples/place_halls.pl
@@ -0,0 +1,169 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use List::Util qw(first shuffle);
+use Data::Dumper;
+
+use Getopt::Long;
+use Games::Lacuna::Client;
+
+my %opts;
+GetOptions(\%opts,
+ # General options
+ 'h|help',
+ 'q|quiet',
+ 'v|verbose',
+ 'config=s',
+ 'planet=s@',
+ 'dry-run|dry',
+ 'max=i',
+ 'delay=s',
+) or usage();
+
+usage() if $opts{h};
+
+my %do_planets;
+if ($opts{planet}) {
+ %do_planets = map { normalize_planet($_) => 1 } @{$opts{planet}};
+}
+
+my $glc = Games::Lacuna::Client->new(
+ cfg_file => $opts{config} || "$FindBin::Bin/../lacuna.yml",
+);
+
+# need a Halls object to do any construction
+my $halls = $glc->building(type => 'HallsOfVrbansk');
+
+my $empire = $glc->empire->get_status->{empire};
+# reverse hash, to key by name instead of id
+my %planets = map { $empire->{planets}{$_}, $_ } keys %{$empire->{planets}};
+for my $planet_name (keys %planets) {
+ if (keys %do_planets) {
+ next unless $do_planets{normalize_planet($planet_name)};
+ }
+
+ verbose("Inspecting $planet_name\n");
+
+ # Load planet data
+ my $planet = $glc->body(id => $planets{$planet_name});
+ my $result = $planet->get_buildings;
+ my $buildings = $result->{buildings};
+
+ my $pcc = find_pcc($buildings);
+ next unless $pcc;
+
+ my $plans = $pcc->view_plans->{plans};
+ unless (@$plans) {
+ verbose("No plans on $planet_name\n");
+ next;
+ }
+
+ my @halls = grep { $_->{name} eq 'Halls of Vrbansk' } @$plans;
+ unless (@halls) {
+ verbose("No Halls on $planet_name\n");
+ next;
+ }
+
+ # initialize plots
+ my %plots;
+ for my $x (-5..5) {
+ for my $y (-5..5) {
+ $plots{"$x:$y"} = 1;
+ }
+ }
+ for (keys %$buildings) {
+ delete $plots{"$buildings->{$_}{x}:$buildings->{$_}{y}"};
+ }
+
+ my $max = $opts{max} || 1;
+ for (1..$max) {
+ last unless keys %plots;
+ last unless @halls;
+ my ($plot) = shuffle(keys %plots);
+ my ($x, $y) = $plot =~ /([\d-]+):([\d-]+)/;
+ delete $plots{$plot};
+ pop @halls;
+ if ($opts{'dry-run'}) {
+ output("Would have placed Halls at $x, $y on $planet_name\n");
+ } else {
+ output("Placing Halls at $x, $y on $planet_name\n");
+ $halls->build($planets{$planet_name}, $x, $y);
+ }
+
+ sleep $opts{delay} if $opts{delay};
+ }
+}
+
+output("$glc->{total_calls} api calls made.\n");
+output("You have made $glc->{rpc_count} calls today\n");
+output(Dumper $glc->{call_stats});
+undef $glc;
+
+exit 0;
+
+sub normalize_planet {
+ my ($planet_name) = @_;
+
+ $planet_name =~ s/\W//g;
+ $planet_name = lc($planet_name);
+ return $planet_name;
+}
+
+sub find_pcc {
+ my ($buildings) = @_;
+
+ # Find the PCC
+ my $pcc_id = first {
+ $buildings->{$_}->{name} eq 'Planetary Command Center'
+ }
+ grep { $buildings->{$_}->{level} > 0 and $buildings->{$_}->{efficiency} == 100 }
+ keys %$buildings;
+
+ return if not $pcc_id;
+
+ my $building = $glc->building(
+ id => $pcc_id,
+ type => 'PlanetaryCommand',
+ );
+
+ return $building;
+}
+
+sub usage {
+ diag(<<END);
+Usage: $0 [options]
+
+Options:
+ --verbose - Output extra information.
+ --quiet - Print no output except for errors.
+ --config <file> - Specify a GLC config file, normally lacuna.yml.
+ --planet <name> - Specify a planet to process. This option can be
+ passed multiple times to indicate several planets.
+ If this is not specified, all relevant colonies will
+ be inspected.
+ --dry-run - Don't actually take any action, just report status and
+ what actions would have taken place.
+ --max <n> - Build at most <n> Halls, default is 1
+ --delay <n> - Sleep for <n> seconds between each build
+END
+ exit 1;
+}
+
+sub verbose {
+ return unless $opts{v};
+ print @_;
+}
+
+sub output {
+ return if $opts{q};
+ print @_;
+}
+
+sub diag {
+ my ($msg) = @_;
+ print STDERR $msg;
+}
View
33 examples/probe_yaml.pl → examples/probe_js.pl
@@ -11,10 +11,9 @@
use Getopt::Long qw(GetOptions);
use Date::Parse;
use Date::Format;
-use YAML::XS;
use utf8;
-my $probe_file = "data/probe_data_raw.yml";
+my $probe_file = "data/probe_data_raw.js";
my $cfg_file = "lacuna.yml";
my $help = 0;
@@ -31,34 +30,53 @@
usage() if $help;
+ my $json = JSON->new->utf8(1);
+ $json = $json->pretty([1]);
+ $json = $json->canonical([1]);
my $fh;
open($fh, ">", "$probe_file") || die "Could not open $probe_file";
+# Wrappper
my $data = $glc->empire->view_species_stats();
# Get planets
- my $planets = $data->{status}->{empire}->{planets};
my $ename = $data->{status}->{empire}->{name};
my $ststr = $data->{status}->{server}->{time};
my $stime = str2time( map { s!^(\d+)\s+(\d+)\s+!$2/$1/!; $_ } $ststr);
my $ttime = ctime($stime);
print "$ttime\n";
+ my $empire = $data->{status}->{empire};
+
+ my %planets = map { $empire->{planets}{$_}, $_ } keys %{$empire->{planets}};
# Get obervatories;
my @observatories;
- for my $pid (keys %$planets) {
- my $buildings = $glc->body(id => $pid)->get_buildings()->{buildings};
+ for my $pname (sort keys %planets) {
+ next if $pname =~ /Station/;
+# Wrappper Needed
+ my $ok;
+ my $buildings;
+ while (1) {
+ $ok = eval {
+ $buildings = $glc->body(id => $planets{$pname})->get_buildings()->{buildings};
+ };
+ last if $ok;
+ sleep 60;
+ }
push @observatories, grep { $buildings->{$_}->{url} eq '/observatory' } keys %$buildings;
+ sleep 2;
}
# Find stars
my @stars;
my @star_bit;
for my $obs_id (@observatories) {
+# Wrappper
my $obs_view = $glc->building( id => $obs_id, type => 'Observatory' )->view();
my $pages = 1;
my $num_probed = 0;
do {
+# Wrappper
my $obs_probe = $glc->building( id => $obs_id, type => 'Observatory' )->get_probed_stars($pages++);
$num_probed = $obs_probe->{star_count};
@star_bit = @{$obs_probe->{stars}};
@@ -111,7 +129,7 @@
push @bodies, @tbod if (@tbod);
}
- YAML::Any::DumpFile($fh, \@bodies);
+ print $fh $json->pretty->canonical->encode(\@bodies);
close($fh);
print "$glc->{total_calls} api calls made.\n";
@@ -122,11 +140,10 @@ sub usage {
diag(<<END);
Usage: $0 [options]
-This program takes all your data on observatories and places it in a YAML file for use by other programs.
+This program takes all your data on observatories and places it in a JSON file for use by other programs.
Data contained is all the body data, plus which observatory "owns" the probe for this bit of data.
Stars may be repeated if multiple observatories probe the same star, but we will report that. Note that abandoning either probe currently, abandons all probes at the star.
-
Options:
--help - Prints this out
--output <file> - Output file, default: data/probe_data_raw.yml
View
205 examples/score_bodies.pl
@@ -8,10 +8,9 @@
use strict;
use warnings;
use Getopt::Long qw(GetOptions);
-use YAML;
-use YAML::XS;
-use Data::Dumper;
+use JSON;
use utf8;
+binmode STDOUT, ":utf8";
# Constants used for what is a decent sized planet
use constant {
@@ -26,12 +25,12 @@
my $home_x;
my $home_y;
my $max_dist = 5000;
-my $probe_file = "data/probe_data_cmb.yml";
+my $probe_file = "data/probe_data_cmb.js";
my $star_file = "data/stars.csv";
my $statistics = "data/system_stats.csv";
-my $planet_file = "data/planet_score.yml";
+my $planet_file = "data/planet_score.js";
my $planet = '';
-my $help; my $opt_a = 0; my $opt_g = 0; my $opt_h = 0; my $opt_s; my $nodist = 0;
+my $help; my $opt_a = 0; my $opt_g = 0; my $opt_h = 0; my $opt_o = 0; my $opt_s = 0; my $nodist = 0;
GetOptions(
'x=i' => \$home_x,
@@ -46,26 +45,37 @@
'asteroid' => \$opt_a,
'gas' => \$opt_g,
'habitable' => \$opt_h,
- 'systems' => \$opt_s,
+ 'stations' => \$opt_s,
+ 'systems' => \$opt_o,
);
usage() if ($help);
- if ($opt_s) {
- $opt_a = $opt_g = $opt_h = 1;
+ if ($opt_o) {
+ $opt_a = $opt_g = $opt_h = $opt_s = 1;
}
+ my $json = JSON->new->utf8(1);
+
my $bod;
my $bodies;
my $planets;
if (-e "$probe_file") {
- $bodies = YAML::XS::LoadFile($probe_file);
+ my $pf;
+ open($pf, "$probe_file") || die "Could not open $probe_file\n";
+ my $lines = join("", <$pf>);
+ $bodies = $json->decode($lines);
+ close($pf);
}
else {
print STDERR "$probe_file not found!\n";
die;
}
if (-e "$planet_file") {
- $planets = YAML::XS::LoadFile($planet_file);
+ my $pf;
+ open($pf, "$planet_file") || die "Could not open $planet_file\n";
+ my $lines = join("", <$pf>);
+ $planets = $json->decode($lines);
+ close($pf);
}
else {
unless (defined($home_x) and defined($home_y)) {
@@ -124,101 +134,183 @@
$bod->{type} = "U";
$bod->{bscore} = 0; #erk
}
- score_system(\%sys, $bod);
+ score_system_fp(\%sys, $bod);
}
for my $key (keys %sys) {
$sys{"$key"}->{sscore} = join(":", $sys{"$key"}->{G}, $sys{"$key"}->{H}, $sys{"$key"}->{A});
+ $sys{"$key"}->{gscore} = join(":", $sys{"$key"}->{G}, $sys{"$key"}->{HA});
+ $sys{"$key"}->{FW} = score_foodw($sys{$key}->{FRNG});
}
+ print STDERR scalar keys %sys, " systems and ", scalar @$bodies, " bodies checked.\n";
- printf "%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\n",
- "Name", "Sname", "BS", "SS", "T", "YS", "O", "Dist", "SD", "X", "Y", "Type",
- "Img","Size", "Own", "Zone", "Total", "Mineral", "Amt";
- for $bod (sort byscore @$bodies) {
+ my @fields = ( "Name", "Sname", "BS", "SS", "GG", "TS", "TBS", "TCS", "TYS", "TCYS", "FW", "O", "Dist",
+ "SD", "X", "Y", "Type", "Img","Size", "Own", "Zone", "Water", "Total", "Mineral", "Amt");
+ printf "%s\t" x scalar @fields, @fields;
+ print "\n";
+ for $bod (sort byfw @$bodies) {
next if ($bod->{type} eq "U");
next if ($bod->{type} eq "A" and $opt_a == 0);
next if ($bod->{type} eq "G" and $opt_g == 0);
next if ($bod->{type} eq "H" and $opt_h == 0);
+ next if ($bod->{type} eq "S" and $opt_s == 0);
next if ($bod->{dist} > $max_dist);
- printf "%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s",
+ printf "%s\t" x ( scalar @fields - 2),
$bod->{name}, $bod->{star_name}, $bod->{bscore},
- $sys{"$bod->{star_id}"}->{sscore}, $sys{"$bod->{star_id}"}->{T},
- $sys{"$bod->{star_id}"}->{YS},
+ $sys{"$bod->{star_id}"}->{sscore}, $sys{"$bod->{star_id}"}->{gscore},
+ $sys{"$bod->{star_id}"}->{TS}, $sys{"$bod->{star_id}"}->{TBS},
+ $sys{"$bod->{star_id}"}->{TCS}, $sys{"$bod->{star_id}"}->{TYS},
+ $sys{"$bod->{star_id}"}->{TCYS}, $sys{"$bod->{star_id}"}->{FW},
$bod->{orbit}, $bod->{dist}, $bod->{sdist}, $bod->{x}, $bod->{y},
$bod->{type}, $bod->{image}, $bod->{size}, $bod->{empire}->{name},
- $bod->{zone}, $bod->{ore_total};
+ $bod->{zone}, $bod->{water}, $bod->{ore_total};
for my $ore (sort keys %{$bod->{ore}}) {
if ($bod->{ore}->{$ore} > 1) {
- print "\t$ore\t", $bod->{ore}->{$ore};
+ print $ore,"\t", $bod->{ore}->{$ore},"\t";
}
}
print "\n";
}
exit;
+sub score_foodw {
+ my ($size_a) = @_;
+
+ my $score = 0;
+ my $skip = 0;
+ my $num;
+ for $num (2..4) {
+ if ($size_a->[$num] >= 50 and $size_a->[$num] < 70) {
+ $score += 1;
+ }
+ elsif ($size_a->[$num] > 95) {
+ $score += 1;
+ }
+ else {
+ $skip = 1;
+ }
+ }
+
+ my $pass_5 = 0;
+ my $pass_6 = 0;
+ if ($size_a->[5] >= 50 and $size_a->[5] < 70) {
+ $score += 1;
+ $pass_5 = 1;
+ }
+ elsif ($size_a->[5] >= 95) {
+ $score += 1;
+ $pass_5 = 1;
+ }
+ if ($size_a->[6] >= 50 and $size_a->[6] < 70) {
+ $score += 1;
+ $pass_6 = 1;
+ }
+ elsif ($size_a->[6] >= 95) {
+ $score += 1;
+ $pass_6 = 1;
+ }
+ $skip = 1 unless ($pass_5 + $pass_6);
+
+ return $score if $skip;
+ for $num (1..7) {
+ if ($size_a->[$num] >= 95) {
+ $score += 1;
+ }
+ }
+ for $num (1,7) {
+ if ($size_a->[$num] >= 55 and $size_a->[$num] < 70) {
+ $score += 1;
+ }
+ elsif ($size_a->[$num] >= 95) {
+ $score += 1;
+ }
+ else {
+ $skip = 1;
+ }
+ }
+ return $score if $skip;
+ if ($size_a->[8] >= 55 and $size_a->[8] < 70) {
+ $score += 1;
+ }
+ elsif ($size_a->[8] >= 95) {
+ $score += 1;
+ }
+ return $score;
+}
+
# Highly Arbritrary system for scoring a star system based on what is in it.
-sub score_system {
+sub score_system_fp {
my ($sys, $bod) = @_;
+ my $star_id = $bod->{star_id};
+
+ unless (defined($sys->{"$star_id"}) ) {
+ $sys->{"$star_id"}->{sscore} = "";
+ $sys->{"$star_id"}->{A} = 0; # Decent Asteroids
+ $sys->{"$star_id"}->{G} = 0; # Decent Gas Giants
+ $sys->{"$star_id"}->{H} = 0; # Decent Habitable
+ $sys->{"$star_id"}->{HA} = 0; # Looking for right size Gas Giants, plan to Blackhole the rest
+ $sys->{"$star_id"}->{TS} = 0; # Total size
+ $sys->{"$star_id"}->{TBS} = 0; # Total Base score
+ $sys->{"$star_id"}->{TCS} = 0; # Total Size of H & G
+ $sys->{"$star_id"}->{TYS} = 0; # Total H & G Orbits 2-6
+ $sys->{"$star_id"}->{TCYS} = 0; # Total H & G, if > min
+ $sys->{"$star_id"}->{FW} = 0; # Threshold scoring
+ $sys->{"$star_id"}->{FRNG} = [ (0) x 9 ];
+ }
+
+ $sys->{"$star_id"}->{FRNG}->[$bod->{orbit}] = $bod->{size};
- unless (defined($sys->{"$bod->{star_id}"}) ) {
- $sys->{"$bod->{star_id}"}->{sscore} = "";
- $sys->{"$bod->{star_id}"}->{A} = 0;
- $sys->{"$bod->{star_id}"}->{G} = 0;
- $sys->{"$bod->{star_id}"}->{H} = 0;
- $sys->{"$bod->{star_id}"}->{T} = 0;
- $sys->{"$bod->{star_id}"}->{YS} = 0;
+ $sys->{"$star_id"}->{TS} += $bod->{size};
+ $sys->{"$star_id"}->{TBS} += $bod->{bscore};
+
+ if ($bod->{type} eq "H" or $bod->{type} eq "G") {
+ $sys->{"$star_id"}->{TCS} += $bod->{size};
+ if ($bod->{orbit} >= 2 and $bod->{orbit} <= 6) {
+ $sys->{"$star_id"}->{TYS} += $bod->{size};
+ }
}
- $sys{"$bod->{star_id}"}->{YS} += $bod->{bscore};
if ($bod->{type} eq "H") {
if ( ($bod->{orbit} == 1 or $bod->{orbit} == 7) &&
($bod->{size} >= MIN_H1)) {
- $sys->{"$bod->{star_id}"}->{H} += 1;
-
+ $sys->{"$star_id"}->{H} += 1;
+ $sys->{"$star_id"}->{TCYS} += $bod->{size};
}
elsif ( ($bod->{orbit} == 3) and
($bod->{size} >= MIN_H3)) {
- $sys->{"$bod->{star_id}"}->{H} += 1;
+ $sys->{"$star_id"}->{H} += 1;
+ $sys->{"$star_id"}->{TCYS} += $bod->{size};
}
elsif ( ($bod->{orbit} >= 2 and $bod->{orbit} <= 6) &&
($bod->{size} >= MIN_H5)) {
- $sys->{"$bod->{star_id}"}->{H} += 1;
+ $sys->{"$star_id"}->{H} += 1;
+ $sys->{"$star_id"}->{TCYS} += $bod->{size};
}
+ $sys->{"$star_id"}->{HA} += 1;
}
elsif ($bod->{type} eq "G") {
if ( ($bod->{orbit} == 1 or $bod->{orbit} == 7) &&
($bod->{size} >= MIN_G1)) {
- $sys->{"$bod->{star_id}"}->{G} += 1;
+ $sys->{"$star_id"}->{G} += 1;
+ $sys->{"$star_id"}->{TCYS} += $bod->{size};
}
elsif ( ($bod->{orbit} >= 2 and $bod->{orbit} <= 6) &&
($bod->{size} >= MIN_G5)) {
- $sys->{"$bod->{star_id}"}->{G} += 1;
+ $sys->{"$star_id"}->{G} += 1;
+ $sys->{"$star_id"}->{TCYS} += $bod->{size};
}
}
elsif ($bod->{type} eq "A") {
my $ascore = score_atype($bod->{image});
if ( $ascore > MIN_A) {
- $sys->{"$bod->{star_id}"}->{A} += 1;
+ $sys->{"$star_id"}->{A} += 1;
}
+ $sys->{"$star_id"}->{HA} += 1;
}
else {
- $sys->{"$bod->{star_id}"}->{A} += 0;
- }
- if ($bod->{type} eq "U") {
- $sys->{"$bod->{star_id}"}->{T} += 0
- }
- elsif ($bod->{type} eq "A" or ($bod->{orbit} == 1 or $bod->{orbit} >= 7)) {
- if ($bod->{orbit} == 8) {
- $sys->{"$bod->{star_id}"}->{T} += int($bod->{size}/3+0.5);
- }
- else {
- $sys->{"$bod->{star_id}"}->{T} += int($bod->{size}/2+0.5);
- }
- }
- else {
- $sys->{"$bod->{star_id}"}->{T} += $bod->{size};
+ $sys->{"$star_id"}->{A} += 0;
}
}
@@ -330,11 +422,18 @@ sub byscore {
$a->{name} cmp $b->{name};
}
+sub byfw {
+ $sys{"$b->{star_id}"}->{FW} <=> $sys{"$a->{star_id}"}{FW} ||
+ $sys{"$b->{star_id}"}->{TCYS} <=> $sys{"$a->{star_id}"}{TCYS} ||
+ $sys{"$b->{star_id}"}->{TYS} <=> $sys{"$a->{star_id}"}{TYS} ||
+ $a->{orbit} <=> $b->{orbit};
+}
+
sub get_stars {
my ($sfile) = @_;
my $fh;
- open ($fh, "<", "$sfile") or die;
+ open ($fh, "<:utf8", "$sfile") or die;
my $fline = <$fh>;
my %star_hash;
View
13 examples/star_db_util.pl
@@ -85,6 +85,9 @@
$star_db->{AutoCommit} = 0;
if ($opts{'merge-db'}) {
+ unless (-f $opts{'merge-db'}) {
+ die "Can't locate database to merge: $opts{'merge-db'}\n";
+ }
$star_db->{AutoCommit} = 1;
$star_db->do('attach database ? as d2', {}, $opts{'merge-db'});
$star_db->{AutoCommit} = 0;
@@ -96,7 +99,7 @@
select s2.*, strftime('%s', s2.last_checked) checked_epoch
from d2.stars s2
join stars s1 on s1.id = s2.id
- and s2.last_checked > coalesce(s1.last_checked,0)
+ and coalesce(s2.last_checked, 0) >= coalesce(s1.last_checked,0)
SQL
$get_stars->execute;
return 1;
@@ -114,7 +117,7 @@
}
while (my $star = $get_stars->fetchrow_hashref) {
if (my $row = star_exists($star->{x}, $star->{y})) {
- if (($star->{checked_epoch}||0) > ($row->{checked_epoch}||0)) {
+ if (($star->{checked_epoch}||0) >= ($row->{checked_epoch}||0)) {
update_star($star)
}
} else {
@@ -130,7 +133,7 @@
from d2.orbitals o2
join orbitals o1 on o1.star_id = o2.star_id
and o1.orbit = o2.orbit
- and o2.last_checked > coalesce(o1.last_checked,0)
+ and coalesce(o2.last_checked, 0) >= coalesce(o1.last_checked,0)
SQL
$get_orbitals->execute;
return 1;
@@ -149,7 +152,7 @@
while (my $orbital = $get_orbitals->fetchrow_hashref) {
# Check if it exists in the star db, and if so what its type is
if (my $row = orbital_exists($orbital->{x}, $orbital->{y})) {
- if (($orbital->{checked_epoch}||0) > ($row->{checked_epoch}||0)) {
+ if (($orbital->{checked_epoch}||0) >= ($row->{checked_epoch}||0)) {
update_orbital( {
empire => { id => $orbital->{empire_id} },
(map { $_ => $orbital->{$_} } qw/x y type name water size/),
@@ -194,7 +197,7 @@
my $empire = $glc->empire->get_status->{empire};
# reverse hash, to key by name instead of id
- my %planets = reverse %{ $empire->{planets} };
+ my %planets = map { $empire->{planets}{$_}, $_ } keys %{$empire->{planets}};
# Scan each planet
for my $planet_name (keys %planets) {
View
1  lib/Games/Lacuna/Client/Buildings.pm
@@ -13,6 +13,7 @@ require Games::Lacuna::Client::Buildings::Simple;
our @BuildingTypes = (qw(
Archaeology
ArtMuseum
+ BlackHoleGenerator
Capitol
CulinaryInstitute
Development
View
45 lib/Games/Lacuna/Client/Buildings/BlackHoleGenerator.pm
@@ -0,0 +1,45 @@
+package Games::Lacuna::Client::Buildings::BlackHoleGenerator;
+use 5.0080000;
+use strict;
+use warnings;
+use Carp 'croak';
+
+use Games::Lacuna::Client;
+use Games::Lacuna::Client::Buildings;
+
+our @ISA = qw(Games::Lacuna::Client::Buildings);
+
+sub api_methods {
+ return {
+ generate_singularity => { default_args => [qw(session_id building_id)] },
+ };
+}
+
+__PACKAGE__->init();
+
+1;
+__END__
+
+=head1 NAME
+
+Games::Lacuna::Client::Buildings::BlackHoleGenerator - Black Hole Generator
+
+=head1 SYNOPSIS
+
+ use Games::Lacuna::Client;
+
+=head1 DESCRIPTION
+
+=head1 AUTHOR
+
+Steffen Mueller, E<lt>smueller@cpan.orgE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2010 by Steffen Mueller
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.10.0 or,
+at your option, any later version of Perl 5 you may have available.
+
+=cut
View
1  lib/Games/Lacuna/Client/Buildings/Simple.pm
@@ -30,7 +30,6 @@ our @BuildingTypes = (qw(
Bean
Beeldeban
BeeldebanNest
- BlackHoleGenerator
Bread
Burger
Cheese
View
1  lib/Games/Lacuna/Client/Buildings/SpacePort.pm
@@ -27,6 +27,7 @@ sub api_methods {
send_spies => { default_args => [qw(session_id)] },
prepare_fetch_spies => { default_args => [qw(session_id)] },
fetch_spies => { default_args => [qw(session_id)] },
+ view_battle_logs => { default_args => [qw(session_id building_id)] },
};
}
View
1  lib/Games/Lacuna/Client/Empire.pm
@@ -27,6 +27,7 @@ sub api_methods {
get_species_templates
)
),
+ create => { default_args => [qw(empire_id)] },
found => { default_args => [qw(empire_id)] },
update_species => { default_args => [qw(empire_id)] },
invite_friend => { default_args => [qw(session_id)] },
Please sign in to comment.
Something went wrong with that request. Please try again.