view release on metacpan or  search on metacpan

examples/build_scheduled.pl  view on Meta::CPAN

    ) if $dist;
  };
  usage() unless $config_file and -e $config_file
}
usage() if not defined $schedule_file or not -e $schedule_file;

my $client = Games::Lacuna::Client->new(
  cfg_file => $config_file,
  #debug => 1,
);

$SIG{INT} = sub {
  undef $client; # for session persistence
  warn "Interrupted!\n";
  exit(1);
};


my $to_be_built = YAML::Any::LoadFile($schedule_file);
foreach my $name (keys %$to_be_built) {
  my $build_order = $to_be_built->{$name};
  $build_order->{dependent_on} ||= [];
  prepare_building($build_order);
}

my @work_order = build_topo_sort(%$to_be_built);
print "Working in the following order:\n";
print Dumper(\@work_order);
print "\n";
my $empire = $client->empire;
my $estatus = $empire->get_status->{empire};
my %planets_by_name = map { ($estatus->{planets}->{$_} => $client->body(id => $_)) }
                      keys %{$estatus->{planets}};


my %failed_jobs;
while (1) {
  output("Checking status");

  my %tainted_planets;
  my %checked_planets;
  die if not @work_order;
  my $current_work = $work_order[0];
  output("Current work slice: " . join (", ", @$current_work));

  foreach (my $ibuild = 0; $ibuild < @$current_work; ++$ibuild) {
    my $name = $current_work->[$ibuild];
    my $build_order = $to_be_built->{$name};
    output("Attempting '$name'");

    # check for bad dependencies
    if (grep {$failed_jobs{$_}} @{$build_order->{dependent_on}}) {
      output("Depends on failed job. Removing.");
      $failed_jobs{$name} = 1;
      splice(@$current_work, $ibuild, 1);
      $ibuild--;
      next;
    }
    # check for known (currently) bad planets
    if ($tainted_planets{ $build_order->{planet} }) {
      output("Planet busy, skipping.");
      next;
    }

    my $planet_name = $build_order->{planet};
    my $planet = $planets_by_name{$planet_name};

    if (not $checked_planets{$planet_name}) {
      # This needs better API (understanding)
      #my $buildable = $planet->get_buildable(0, 0, 'Storage');
      #if ($buildable->{build_queue}{max} <= $buildable->{build_queue}{current}) {
      #  output("Planet build queue is full. Marking as tainted. Skipping.");
      #  $tainted_planets{$planet_name} = 1;
      #  next;
      #}
      my $buildings_struct = $planet->get_buildings();
      $checked_planets{$planet_name} = $buildings_struct;
    }

    if (not defined $build_order->{building}) {
      prepare_building($client, $build_order, $checked_planets{$planet_name});
      if (not defined $build_order->{building}) {
        output("Can't infer building type or position, skipping this order");
        $failed_jobs{$name} = 1;
        splice(@$current_work, $ibuild, 1);
        $ibuild--;
        next;
      }
    }
    if (not defined $build_order->{building}->building_id) {
      $build_order->{building}->{building_id}
        = find_building_id($checked_planets{$planet_name}, $build_order->{x}, $build_order->{y});
    }

    my $err;
    my $action;
    if ($build_order->{ship_type}) {
      output("Building new ship");
      $action = 'ship';
      eval { $build_order->{building}->build_ship($build_order->{ship_type}) };
      $err = $@;
    }
    elsif ($build_order->{upgrade}) {
      output("Performing upgrade of building.");
      $action = 'upgrade';
      eval { $build_order->{building}->upgrade() };
      $err = $@;
    }
    else { # fresh build
      output("Constructing new building");
      $action = 'build';
      eval { $build_order->{building}->build($planet->body_id, $build_order->{x}, $build_order->{y}) };
      $err = $@;
    } # end fresh build

    if ($err) {
      output(ucfirst($action) . " failed.");
      $err =~ /^RPC Error \((\d+)\)/ or die $err;
      my $code = $1;
      if ($code == 1009) {
        if ($err =~ /build queue/) {