From eb652b1887c457ee8c9f46a0a22df10bad6899a0 Mon Sep 17 00:00:00 2001 From: Natalie Rose Date: Thu, 10 Sep 2026 00:03:31 +1000 Subject: [PATCH] Add logging for existing messages that are getting lost in stdout --- lib/Lacuna/AI.pm | 147 +++++++++++++++++---------------- lib/Lacuna/AI/DeLambert.pm | 65 ++++++++------- lib/Lacuna/AI/Jackpot.pm | 19 +++-- lib/Lacuna/AI/Saben.pm | 13 +-- lib/Lacuna/Cache.pm | 55 ++++++------ lib/Lacuna/DB/Result/Empire.pm | 9 +- lib/Lacuna/DB/Result/Ships.pm | 5 +- lib/Lacuna/DB/Result/Spies.pm | 7 +- lib/Lacuna/Mailer.pm | 3 +- 9 files changed, 167 insertions(+), 156 deletions(-) diff --git a/lib/Lacuna/AI.pm b/lib/Lacuna/AI.pm index e6aec5d0..682763c6 100644 --- a/lib/Lacuna/AI.pm +++ b/lib/Lacuna/AI.pm @@ -8,6 +8,7 @@ use Lacuna::Constants qw(FOOD_TYPES ORE_TYPES); use List::Util qw(shuffle); use 5.010; use Module::Find; +use Log::Any qw($log); has empire => ( is => 'ro', @@ -45,7 +46,7 @@ sub next_viable_colony { sub create_empire { my $self = shift; - say 'Founding Empire'; + $log->debug('Founding Empire'); my %attributes = ( %{$self->empire_defaults}, id => $self->empire_id, @@ -69,7 +70,7 @@ sub create_empire { sub build_colony { my ($self,$body) = @_; - say 'Upgrading PCC'; + $log->debug('Upgrading PCC'); my $pcc = $body->command; $pcc->level(15); $pcc->update; @@ -101,7 +102,7 @@ sub build_colony { } } - say 'Placing structures on '.$body->name; + $log->debug('Placing structures on '.$body->name); my @plans = $self->colony_structures; my $extras = $self->extra_glyph_buildings; @@ -127,7 +128,7 @@ sub build_colony { body_id => $body->id, body => $body, }); - say $building->name; + $log->debug($building->name); $body->build_building($building); $building->finish_upgrade; $plot_use++ unless $plan =~ /::Permanent::/; @@ -142,9 +143,9 @@ sub run_all_hourly_colony_updates { my $self = shift; my $colonies = $self->empire->planets; while (my $colony = $colonies->next) { - say '###############'; - say '#### UPDATE COLONY : '.$colony->name; - say '###############'; + $log->debug('###############'); + $log->debug('#### UPDATE COLONY : '.$colony->name); + $log->debug('###############'); $colony->tick; $self->run_hourly_colony_updates($colony); @@ -153,9 +154,9 @@ sub run_all_hourly_colony_updates { sub run_all_hourly_empire_updates { my $self = shift; - say '###############'; - say '#### UPDATE EMPIRE '; - say '###############'; + $log->debug('###############'); + $log->debug('#### UPDATE EMPIRE '); + $log->debug('###############'); $self->run_hourly_empire_updates($self->empire); } @@ -169,29 +170,29 @@ sub add_colonies { { distinct => 1 } )->get_column('zone')->all; - say 'getting existing colonies'; + $log->debug('getting existing colonies'); my $colonies = $empire->planets; my @existing_zones = $colonies->get_column('zone')->all; - say 'getting neutral zones'; + $log->debug('getting neutral zones'); my $na_param = Lacuna->config->get('neutral_area'); my @neutral_zones = (); if ($na_param->{zone}) { @neutral_zones = @{$na_param->{zone_list}}; } - say 'Adding colonies...'; + $log->debug('Adding colonies...'); ZONE: foreach my $zone (@all_zones) { next unless (grep { $zone eq $_} @all_zones); if (grep { $zone eq $_} @existing_zones) { - say 'Colony already exists in '.$zone.'.'; + $log->debug('Colony already exists in '.$zone.'.'); next; } if (grep { $zone eq $_} @neutral_zones) { - say 'Skip '.$zone.' because of neutral zone.'; + $log->debug('Skip '.$zone.' because of neutral zone.'); next; } - say $zone; - say 'Finding colony in '.$zone.'...'; + $log->debug($zone); + $log->debug('Finding colony in '.$zone.'...'); # Need to narrow search if neutral area defined by coordinates. my @bodies = $self->viable_colonies->search({ 'me.zone' => $zone, @@ -204,10 +205,10 @@ ZONE: foreach my $zone (@all_zones) { my $body = random_element(\@bodies); if (defined $body) { - say 'Clearing '.$body->name; + $log->debug('Clearing '.$body->name); my @to_demolish = @{$body->building_cache}; $body->delete_buildings(\@to_demolish); - say 'Colonizing '.$body->name; + $log->debug('Colonizing '.$body->name); $body->found_colony($empire); $self->build_colony($body); $body->happiness(1000000000); @@ -215,14 +216,14 @@ ZONE: foreach my $zone (@all_zones) { last ZONE if $add_one; } else { - say 'Could not find a colony to occupy in '.$zone.'.'; + $log->debug('Could not find a colony to occupy in '.$zone.'.'); } } } sub run_missions { my ($self, $colony) = @_; - say 'RUN MISSIONS'; + $log->debug('RUN MISSIONS'); my @missions = $self->spy_missions; my $mission = $missions[rand @missions]; my $infiltrated_spies = Lacuna->db->resultset('Lacuna::DB::Result::Spies')->search({from_body_id => $colony->id, on_body_id => {'!=', $colony->id}}); @@ -231,18 +232,18 @@ sub run_missions { if ($spy->is_available) { if ($spy->on_body->id != $spy->from_body->id and $spy->on_body->in_neutral_area ) { # Check if spy is in neutral zone, if it is, send someone to fetch? - say " Spy ID: ".$spy->id." escaping from neutral zone..."; + $log->debug(" Spy ID: ".$spy->id." escaping from neutral zone..."); my $result = eval{$spy->assign("Bugout")}; - say " ".$result->{result}; + $log->debug(" ".$result->{result}); } else { - say " Spy ID: ".$spy->id." running mission..."; + $log->debug(" Spy ID: ".$spy->id." running mission..."); my $result = eval{$spy->assign($mission)}; - say " ".$result->{result}; + $log->debug(" ".$result->{result}); } } else { - say " Spy ID: ".$spy->id." not available"; + $log->debug(" Spy ID: ".$spy->id." not available"); } } } @@ -250,19 +251,19 @@ sub run_missions { sub repair_buildings { my ($self, $colony) = @_; - say 'REPAIR DAMAGED BUILDINGS'; + $log->debug('REPAIR DAMAGED BUILDINGS'); foreach my $building (@{$colony->building_cache}) { if ($building->efficiency < 100) { - say " ".$building->name." needs repairing"; + $log->debug(" ".$building->name." needs repairing"); my $costs = $building->get_repair_costs; my $can = eval{$building->can_repair($costs)}; my $reason = $@; if ($can) { $building->repair($costs); - say " repaired"; + $log->debug(" repaired"); } else { - say " ".$reason->[1]; + $log->debug(" ".$reason->[1]); } } } @@ -270,14 +271,14 @@ sub repair_buildings { sub demolish_bleeders { my ($self, $colony) = @_; - say 'DEMOLISH BLEEDERS'; + $log->debug('DEMOLISH BLEEDERS'); my @bleeders = $colony->get_buildings_of_class('Lacuna::DB::Result::Building::DeployedBleeder'); foreach my $bleeder (@bleeders) { if (randint(0,9) < 5) { - say ' missed bleeder'; + $log->debug(' missed bleeder'); } else { - say ' demolish bleeder'; + $log->debug(' demolish bleeder'); $bleeder->demolish; } } @@ -294,7 +295,7 @@ sub pod_check { for $attrib (@ore) { $ore_stored += $colony->$attrib; } if ($food_stored <= 0 or $ore_stored <= 0 or $colony->water_stored <= 0 or $colony->energy_stored <= 0) { - say 'DEPLOY SUPPLY POD'; + $log->debug('DEPLOY SUPPLY POD'); my ($x, $y) = eval{ $colony->find_free_space }; # Check to see if spot found, if not, clear off a crater if found. unless ($@) { @@ -306,7 +307,7 @@ sub pod_check { body_id => $colony->id, body => $colony, }); - say $deployed->name; + $log->debug($deployed->name); $colony->build_building($deployed, 1); $deployed->finish_upgrade; Lacuna->cache->set('supply_pod_sent',$colony->id,1,60*60*24); @@ -315,21 +316,21 @@ sub pod_check { my @craters = $colony->get_buildings_of_class('Lacuna::DB::Result::Building::Permanent::Crater'); if (@craters) { my $crater = random_element \@craters; - say 'DEMOLISH CRATER'; + $log->debug('DEMOLISH CRATER'); $crater->demolish; } } $colony->recalc_stats; my $add_it = $colony->water_capacity - $colony->water_stored; - say "Adding Water: $add_it"; + $log->debug("Adding Water: $add_it"); $colony->add_type("water", $add_it); $add_it = $colony->energy_capacity - $colony->energy_stored; - say "Adding Energy: $add_it"; + $log->debug("Adding Energy: $add_it"); $colony->add_type("energy", $add_it); my $food_room = $colony->food_capacity - $food_stored; - say "Adding Food: $food_room"; + $log->debug("Adding Food: $food_room"); my $ore_room = $colony->ore_capacity - $ore_stored; - say "Adding Ore: $ore_room"; + $log->debug("Adding Ore: $ore_room"); my @foods = shuffle FOOD_TYPES; my @ores = shuffle ORE_TYPES; my @food_type = splice(@foods, 0, 4); @@ -346,7 +347,7 @@ sub pod_check { sub train_spies { my ($self, $colony, $chance, $subsidise ) = @_; - say 'TRAIN SPIES'; + $log->debug('TRAIN SPIES'); my $intelligence = $colony->get_building_of_class('Lacuna::DB::Result::Building::Intelligence'); @@ -359,9 +360,9 @@ sub train_spies { my $max_spies = $intelligence->level * 3; my $room_for = $max_spies - $spies; my $train_count = 0; - say " Training $room_for spies for total of $max_spies with chance of $chance"; + $log->debug(" Training $room_for spies for total of $max_spies with chance of $chance"); if ($subsidise) { - say " Subsidizing"; + $log->debug(" Subsidizing"); my $deception = $colony->empire->effective_deception_affinity * 50; while ($train_count < $room_for) { $train_count++; @@ -385,7 +386,7 @@ sub train_spies { ->update_level ->insert; - say " Subsidised spy being trained"; + $log->debug(" Subsidised spy being trained"); $spies++; } } @@ -400,10 +401,10 @@ sub train_spies { if ($can) { $intelligence->spend_resources_to_train_spy($costs); $intelligence->train_spy($costs->{time}); - say " Spy being trained."; + $log->debug(" Spy being trained."); } else { - say ' '.$reason->[1]; + $log->debug(' '.$reason->[1]); $can_train = 0; } } @@ -413,16 +414,16 @@ sub train_spies { sub build_ships { my ($self, $colony) = @_; - say 'BUILD SHIPS'; + $log->debug('BUILD SHIPS'); if ($colony->happiness < -1_000_000) { - say "Too unhappy to build ships."; + $log->debug("Too unhappy to build ships."); return; } my @shipyards = sort {$a->work_ends cmp $b->work_ends} $colony->get_buildings_of_class('Lacuna::DB::Result::Building::Shipyard'); my @priorities = $self->ship_building_priorities($colony); my $ships = Lacuna->db->resultset('Lacuna::DB::Result::Ships'); foreach my $priority (@priorities) { - say $priority->[0]; + $log->debug($priority->[0]); my $count = $ships->search({body_id => $colony->id, type => $priority->[0]})->count; if ($count < $priority->[1]) { my $shipyard = shift @shipyards; @@ -432,17 +433,17 @@ sub build_ships { my $can = eval{$shipyard->can_build_ship($ship, $costs)}; my $reason = $@; if ($can) { - say "building ".$ship->type; + $log->debug("building ".$ship->type); $shipyard->spend_resources_to_build_ship($costs); $shipyard->build_ship($ship, $costs->{seconds}); } else { - say $reason->[1]; + $log->debug($reason->[1]); } push @shipyards, $shipyard; } else { - say "have enough"; + $log->debug("have enough"); } } } @@ -450,9 +451,9 @@ sub build_ships { # Fill the shipyards as full as they can be sub build_ships_max { my ($self, $colony) = @_; - say 'BUILD SHIPS'; + $log->debug('BUILD SHIPS'); if ($colony->happiness < -1_000_000) { - say "Too unhappy to build ships."; + $log->debug("Too unhappy to build ships."); return; } my @ship_yards = sort {$a->work_ends cmp $b->work_ends} $colony->get_buildings_of_class('Lacuna::DB::Result::Building::Shipyard'); @@ -467,7 +468,7 @@ sub build_ships_max { my $no_of_ships = $ships->search({body_id => $colony->id, type => $ship_type})->count; my $ships_needed = $quota - $no_of_ships; if ($ships_needed <= 0) { - say " quota met for $ship_type"; + $log->debug(" quota met for $ship_type"); } while ($ships_needed > 0) { # loop around filling shipyards one at a time until either there are no more @@ -485,12 +486,12 @@ sub build_ships_max { my $can_build = eval{$ship_yard->can_build_ship($ship, $costs)}; my $reason = $@; if ($can_build) { - say " building ".$ship->type; + $log->debug(" building ".$ship->type); $ship_yard->spend_resources_to_build_ship($costs); $ship_yard->build_ship($ship, $costs->{seconds}); } else { - say " ".$reason->[1]; + $log->debug(" ".$reason->[1]); next SHIP; } $ships_needed--; @@ -502,7 +503,7 @@ sub build_ships_max { sub set_defenders { my ($self, $colony) = @_; - say 'SET DEFENDERS'; + $log->debug('SET DEFENDERS'); my $local_spies = Lacuna->db->resultset('Lacuna::DB::Result::Spies')->search({empire_id => $colony->empire_id, on_body_id => $colony->id}); my $on_sweep = Lacuna->db->resultset('Lacuna::DB::Result::Spies')->search({empire_id => $colony->empire_id, on_body_id => $colony->id, task => "Security Sweep"})->count; my $enemies = Lacuna->db->resultset('Lacuna::DB::Result::Spies')->search({on_body_id => $colony->id, task => { '!=' => 'Captured'}, empire_id => { '!=' => $self->empire_id }})->count; @@ -512,31 +513,31 @@ sub set_defenders { if ( $spy->date_created < DateTime->now->subtract(hours => 8) and ($spy->task eq 'Security Sweep' or $on_sweep < 10)) { - say " Spy ID: ".$spy->id." sweeping"; + $log->debug(" Spy ID: ".$spy->id." sweeping"); my $spy_result = $spy->assign('Security Sweep'); $spy->update; if ($spy_result->{message_id}) { my $message = Lacuna->db->resultset('Lacuna::DB::Result::Message')->find($spy_result->{message_id}); - say "message: ".$message->subject; + $log->debug("message: ".$message->subject); if ($message && $message->subject =~ /^Spy Report/) { $on_sweep += 10; #No spies to find - say " spy report, no more sweeps."; + $log->debug(" spy report, no more sweeps."); } elsif ($message && $message->subject eq "Enemy Captured") { $on_sweep--; - say " caught someone, more sweeps."; + $log->debug(" caught someone, more sweeps."); } } $on_sweep++; } elsif ($spy->task ne 'Counter Espionage') { - say " Spy ID: ".$spy->id." setting to defend"; + $log->debug(" Spy ID: ".$spy->id." setting to defend"); $spy->task('Counter Espionage'); $spy->update; } } else { - say " Spy ID: ".$spy->id." is currently unavailable"; + $log->debug(" Spy ID: ".$spy->id." is currently unavailable"); } } } @@ -545,7 +546,7 @@ sub kill_prisoners { my ($self, $colony, $when) = @_; #When is in hours from prisoner being released. - say 'KILL PRISONERS'; + $log->debug('KILL PRISONERS'); my $prisoners = Lacuna->db->resultset('Lacuna::DB::Result::Spies')->search({on_body_id => $colony->id, task => 'Captured', empire_id => { '!=' => $self->empire_id }}); my $now = DateTime->now; my $prisoner_cnt = 0; @@ -563,26 +564,26 @@ sub kill_prisoners { $prisoner_cnt++; } } - say $prisoner_cnt." prisoners executed."; + $log->debug($prisoner_cnt." prisoners executed."); } sub start_attack { my ($self, $attacking_colony, $target_colony, $ship_types) = @_; - say 'LOOK FOR PROBES'; + $log->debug('LOOK FOR PROBES'); my $attack = AnyEvent->condvar; my $db = Lacuna->db; my $seconds = 0; my $count = $db->resultset('Lacuna::DB::Result::Probes')->search({ empire_id => $self->empire_id, star_id => $target_colony->star_id })->count; if ($count) { - say ' Has one at star already...'; + $log->debug(' Has one at star already...'); $seconds = 1; } my $probe = $db->resultset('Lacuna::DB::Result::Ships')->search({body_id => $attacking_colony->id, type => 'probe', task=>'Docked'})->first; if (defined $probe and $seconds == 0) { - say ' Has a probe to launch for '.$target_colony->name.'...'; + $log->debug(' Has a probe to launch for '.$target_colony->name.'...'); $probe->send(target => $target_colony->star); $seconds = $probe->date_available->epoch - time(); - say ' Probe will arrive in '.$seconds.' seconds.'; + $log->debug(' Probe will arrive in '.$seconds.' seconds.'); } if ($seconds) { my $timer; $timer = AnyEvent->timer( @@ -596,7 +597,7 @@ sub start_attack { return $attack; } else { - say ' No probe. Cancel assault.'; + $log->debug(' No probe. Cancel assault.'); $attack->send; return $attack; } @@ -641,7 +642,7 @@ STYPE: foreach my $type (@$ship_types) { my $two_months = DateTime->now->add(days=>60); if ($earliest > $two_months) { - say "$type can't make it in two months."; + $log->debug("$type can't make it in two months."); next STYPE; } if ($earliest > $arrival) { @@ -733,7 +734,7 @@ STYPE: foreach my $type (@$ship_types) { task => 'Docked', number_of_docks => $attack_group->{number_of_docks}, })->insert; - say "Sending Attack Group from ".$attacking_body->name." to ".$target_body->name; + $log->debug("Sending Attack Group from ".$attacking_body->name." to ".$target_body->name); $ag->send(target => $target_body, arrival => $arrival, payload => $payload); $attacking_body->add_to_neutral_entry($attack_group->{combat}); } diff --git a/lib/Lacuna/AI/DeLambert.pm b/lib/Lacuna/AI/DeLambert.pm index eedd1e7d..961f0f18 100644 --- a/lib/Lacuna/AI/DeLambert.pm +++ b/lib/Lacuna/AI/DeLambert.pm @@ -7,6 +7,7 @@ no warnings qw(uninitialized); use Data::Dumper; use Lacuna::Util qw(randint random_element); use Lacuna::Constants qw(ORE_TYPES); +use Log::Any qw($log); extends 'Lacuna::AI'; @@ -151,7 +152,7 @@ sub ship_building_priorities { my ($self, $colony) = @_; my $status = $self->scratch->pad->{status} || 'peace'; - print " Status is [$status]\n"; + $log->debug("Status is [$status]"); my $scratch = $self->get_colony_scratchpad($colony); my $level = $scratch->pad->{level}; @@ -285,7 +286,7 @@ sub get_colony_scratchpad { sub check_enemy_spy_action { my ($self, $colony) = @_; - say "#### CHECK ENEMY SPY ACTION ####"; + $log->debug("#### CHECK ENEMY SPY ACTION ####"); my $scratchpad = $self->scratch->pad; @@ -320,7 +321,7 @@ sub check_enemy_spy_action { }); } my $add_hours = $spy_ref->{$empire_id}; - say " adding $add_hours spy attack hours from empire $empire_id"; + $log->debug(" adding $add_hours spy attack hours from empire $empire_id"); $ai_battle_summary->attack_spy_hours($ai_battle_summary->attack_spy_hours + $add_hours); $ai_battle_summary->update; } @@ -329,13 +330,13 @@ sub check_enemy_spy_action { sub sell_glyph_trade { my ($self, $colony) = @_; - say "#### SELL GLYPH TRADE ####"; + $log->debug("#### SELL GLYPH TRADE ####"); my $scratchpad = $self->scratch->pad; my $trade_min = $colony->get_building_of_class('Lacuna::DB::Result::Building::Trade'); if (not $trade_min) { - say " ERROR: No trade ministry found on ".$colony->name; + $log->debug(" ERROR: No trade ministry found on ".$colony->name); return; } @@ -366,7 +367,7 @@ sub sell_glyph_trade { has_glyph => 1, })->count; if ($trades_in_zone >= $scratchpad->{sell_max_glyph_trades_in_zone}) { - say "Already enough trades ($trades_in_zone) in zone!"; + $log->debug("Already enough trades ($trades_in_zone) in zone!"); return; } my $quantity = randint(1,$scratchpad->{sell_glyph_max_batch}); @@ -382,7 +383,7 @@ sub sell_glyph_trade { # glyph_id => 0, } ]; if ($quantity) { - say "Creating a trade for $quantity glyphs"; + $log->debug("Creating a trade for $quantity glyphs"); $ship->task('Waiting On Trade'); $ship->update; my %trade = ( @@ -406,12 +407,12 @@ sub sell_glyph_trade { sub sell_plan_trade { my ($self, $colony) = @_; - say "#### SELL PLAN TRADE ####"; + $log->debug("#### SELL PLAN TRADE ####"); my $trade_min = $colony->get_building_of_class('Lacuna::DB::Result::Building::Trade'); if (not $trade_min) { - say " ERROR: No trade ministry found on ".$colony->name; + $log->debug(" ERROR: No trade ministry found on ".$colony->name); return; } @@ -421,7 +422,7 @@ sub sell_plan_trade { # sell some plans my $ship = $self->get_trade_ship($colony); if ( not $ship ) { - say "No Ship to use for trade!"; + $log->debug("No Ship to use for trade!"); return; } @@ -431,11 +432,11 @@ sub sell_plan_trade { })->count; if ($trades_in_zone >= $scratchpad->{sell_max_plan_trades_in_zone}) { - say "Already enough trades ($trades_in_zone) in zone!"; + $log->debug("Already enough trades ($trades_in_zone) in zone!"); return; } my $level = randint($scratchpad->{sell_plan_min_level},$scratchpad->{sell_plan_max_level}); - say "Offering level ($level) plan"; + $log->debug("Offering level ($level) plan"); my $hall_factor = rand( $scratchpad->{sell_plan_max_hall_factor} - $scratchpad->{sell_plan_min_hall_factor} ) + $scratchpad->{sell_plan_min_hall_factor}; my $cost_per = $hall_factor * $level; my $quantity = randint(1, $scratchpad->{sell_plan_max_batch}); @@ -456,7 +457,7 @@ sub sell_plan_trade { }; } if ($quantity) { - say "Creating a trade for $quantity plans"; + $log->debug("Creating a trade for $quantity plans"); $ship->task('Waiting On Trade'); $ship->update; my %trade = ( @@ -491,7 +492,7 @@ sub get_trade_ship { sub buy_trade { my ($self, $colony) = @_; - say "#### BUY TRADE ####"; + $log->debug("#### BUY TRADE ####"); my $scratchpad = $self->scratch->pad; @@ -582,7 +583,7 @@ sub buy_trade { sub retaliate { my ($self) = @_; - say "#### Retaliate! ####"; + $log->debug("#### Retaliate! ####"); my $empire = $self->empire; $self->scratch->discard_changes; my $scratch_pad = $self->scratch->pad; @@ -594,7 +595,7 @@ sub retaliate { empire_id => -9, }); - say " Checking daily attack time '".DateTime->now->hour."'"; + $log->debug(" Checking daily attack time '".DateTime->now->hour."'"); my $attack_daily = DateTime->now->hour eq 14; TARGET: @@ -602,7 +603,7 @@ TARGET: my $target = Lacuna->db->resultset('Lacuna::DB::Result::Empire')->find($target_id); if ($target) { my $freq = $attack->{$target_id}{frequency} || 'never'; - say " Target empire '".$target->name."' frequency '$freq'"; + $log->debug(" Target empire '".$target->name."' frequency '$freq'"); if ($freq eq 'hourly' or $freq eq 'once' or ($freq eq 'daily' and $attack_daily)) { my $target_colony_id = $attack->{$target_id}{colony_id}; my $num_sweepers = $attack->{$target_id}{sweepers}; @@ -611,7 +612,7 @@ TARGET: my $target_colony = Lacuna->db->resultset('Lacuna::DB::Result::Map::Body')->find($target_colony_id); next TARGET unless $target_colony; next TARGET if $target_colony->empire_id != $target_id; - say " Attack '".$target_colony->name."' with $num_sweepers sweepers, $num_scows scows, $num_snarks snarks"; + $log->debug(" Attack '".$target_colony->name."' with $num_sweepers sweepers, $num_scows scows, $num_snarks snarks"); # Sort the DeLamberti colonies, closest to the target first @del_colonies = sort {$self->distance_comp($a,$b,$target_colony)} @del_colonies; @@ -636,13 +637,13 @@ DEL_COLONY: }); # 20% of sweepers my $quantity = int(@ships / 5); - say " Colony has ".scalar(@ships)." sweepers"; + $log->debug(" Colony has ".scalar(@ships)." sweepers"); if (@sweepers + $quantity > $num_sweepers) { $quantity = $num_sweepers - @sweepers; } - say " taking $quantity sweepers from ".$del_colony->name; + $log->debug(" taking $quantity sweepers from ".$del_colony->name); @sweepers = (@sweepers, splice(@ships, 0, $quantity)); - say " Now got ".scalar(@sweepers)." sweepers"; + $log->debug(" Now got ".scalar(@sweepers)." sweepers"); } if (@scows < $num_scows) { my @ships = Lacuna->db->resultset('Lacuna::DB::Result::Ships')->search({ @@ -655,7 +656,7 @@ DEL_COLONY: if (@scows + $quantity > $num_scows) { $quantity = $num_scows - @scows; } - say " taking $quantity scows from ".$del_colony->name; + $log->debug(" taking $quantity scows from ".$del_colony->name); @scows = (@scows, splice(@ships, 0, $quantity)); } if (@snarks < $num_snarks) { @@ -669,20 +670,20 @@ DEL_COLONY: if (@snarks + $quantity > $num_snarks) { $quantity = $num_snarks - @snarks; } - say " taking $quantity snarks from ".$del_colony->name; + $log->debug(" taking $quantity snarks from ".$del_colony->name); @snarks = (@snarks, splice(@ships, 0, $quantity)); } } # Send all the ships and adjust their travel time to the latest arrival my $arrival_time; for my $ship (@snarks,@sweepers,@scows) { - say " sending ship ID".$ship->id; + $log->debug(" sending ship ID".$ship->id); $ship->send(target => $target_colony); if (not defined $arrival_time or $ship->date_available > $arrival_time) { $arrival_time = $ship->date_available; } } - say " Latest arrival time is $arrival_time"; + $log->debug(" Latest arrival time is $arrival_time"); for my $ship (@sweepers,@snarks,@scows) { $ship->date_available($arrival_time); $ship->update; @@ -715,7 +716,7 @@ sub process_email { }); MESSAGE: while (my $message = $messages->next) { - print("Received message [".$message->subject."]\n"); + $log->debug("Received message [".$message->subject."]"); if ($message->from_id == $self->empire->id) { if ($message->subject eq "Trade Withdrawn") { $message->has_read(1); @@ -734,7 +735,7 @@ sub process_email { # Check for special offer if ($message->subject eq "Re: Special Offer") { - print("Special offer request from ".$message->from_name."\n"); + $log->info("Special offer request from ".$message->from_name); # Check if this user has received an offer previously $self->scratch->discard_changes; @@ -751,7 +752,7 @@ sub process_email { my @lines = split(/\n/, $message->body); for my $line (@lines) { my ($quantity,$glyph) = $line =~ m/(\d+)\s*(anthracite|bauxite|beryl|chalcopyrite|chromite|fluorite|galena|goethite|gold|gypsum|halite|kerogen|magnetite|methane|monazite|rutile|sulfur|trona|uraninite|zircon)/i; - print(" [$glyph][$quantity]\n") if $quantity; + $log->debug(" [$glyph][$quantity]") if $quantity; if ($total_glyphs + $quantity > 20) { $quantity = 20 - $total_glyphs; @@ -768,7 +769,7 @@ sub process_email { if ($total_glyphs < 20) { # asked for too few, possible problem with order - print "### TOO FEW GLYPHS\n"; + $log->warn("### TOO FEW GLYPHS"); $self->spoiled_order_email($request_empire,"100: Less than 20 glyphs on order form"); $self->special_offer_email($request_empire); $message->has_read(1); @@ -776,7 +777,7 @@ sub process_email { } elsif ($asked_for_too_many) { # asked for too many, possible problem with order - print "### TOO MANY GLYPHS\n"; + $log->warn("### TOO MANY GLYPHS"); $self->spoiled_order_email($request_empire,"101: More than 20 glyphs on order form"); $self->special_offer_email($request_empire); $message->has_read(1); @@ -803,7 +804,7 @@ sub process_email { }); if ($ship) { - print "Sending ship from ".$ship->body->name."\n"; + $log->info("Sending ship from ".$ship->body->name); $ship->send( target => $request_empire->home_planet, payload => $payload @@ -817,7 +818,7 @@ sub process_email { $message->update; } else { - print "Cannot find ship to send\n"; + $log->warn("Cannot find ship to send"); } # Mark this user as having received their order } diff --git a/lib/Lacuna/AI/Jackpot.pm b/lib/Lacuna/AI/Jackpot.pm index 4ee8845e..21e7abb0 100644 --- a/lib/Lacuna/AI/Jackpot.pm +++ b/lib/Lacuna/AI/Jackpot.pm @@ -6,6 +6,7 @@ no warnings qw(uninitialized); extends 'Lacuna::AI'; use Lacuna::Constants qw(ORE_TYPES); +use Log::Any qw($log); use constant empire_id => -4; has viable_colonies => ( @@ -121,23 +122,23 @@ sub run_hourly_colony_updates { sub reset_stuff { my ($self, $colony) = @_; - print "Resetting Happiness\n"; + $log->debug("Resetting Happiness"); if ($colony->happiness < 1_000_000_000_000) { $colony->happiness(1_000_000_000_000); $colony->update; } - print "Resetting Buildings\n"; + $log->debug("Resetting Buildings"); my %structures = map { $_->[0] => $_->[1] } $self->colony_structures; foreach my $building (@{$colony->building_cache}) { if ($structures{$building->class} and $structures{$building->class} > $building->level ) { - print "Resetting ".$building->class." to ".$structures{$building->class}." from ".$building->level.".\n"; + $log->debug("Resetting ".$building->class." to ".$structures{$building->class}." from ".$building->level."."); $building->level($structures{$building->class}); $building->update; } } - print "Resetting Glyphs\n"; + $log->debug("Resetting Glyphs"); my $glyphs = $colony->glyph; my %ghash = map {$_ => 0 } (ORE_TYPES); while (my $glyph = $glyphs->next) { @@ -148,19 +149,19 @@ sub reset_stuff { $colony->add_glyph($type, 250 - $ghash{$type}); } } - print "Resetting Plans\n"; + $log->debug("Resetting Plans"); my $plans = $colony->plan_cache; my %phash; for my $plan (@{$plans}) { my $key = join(":",$plan->class,$plan->level,$plan->extra_build_level); $phash{$key} = $plan->quantity; } - print "Checking Plans\n"; + $log->debug("Checking Plans"); my $qplans = plan_list(); for my $plan (@{$qplans}) { my $key = join(":",$plan->{class},$plan->{level},$plan->{extra}); if ( (!defined $phash{$key} or $phash{$key} < $plan->{quantity}) and $plan->{chance} > rand(100)) { - printf "Adding %d %s\n", $plan->{quantity} - $phash{$key}, $key; + $log->debug(sprintf "Adding %d %s", $plan->{quantity} - $phash{$key}, $key); $colony->add_plan($plan->{class}, $plan->{level}, $plan->{extra}, $plan->{quantity} - $phash{$key}); } } @@ -169,7 +170,7 @@ sub reset_stuff { sub reject_badspy { my ($self, $colony) = @_; - print "Bouncing Spies that are too advanced\n"; + $log->debug("Bouncing Spies that are too advanced"); my %empires; my $spies = Lacuna->db->resultset('Spies')->search({ 'me.on_body_id' => $colony->id, @@ -183,7 +184,7 @@ sub reject_badspy { join => 'empire', }); while (my $spy = $spies->next) { - printf " Spy ID: %d from %s sent home\n",$spy->id, $spy->empire->name; + $log->info(sprintf "Spy ID: %d from %s sent home", $spy->id, $spy->empire->name); $spy->task("Idle"); my $result = eval { $spy->assign("Bugout") }; unless ($empires{$spy->empire->id} ) { diff --git a/lib/Lacuna/AI/Saben.pm b/lib/Lacuna/AI/Saben.pm index 2172956c..ac65f185 100644 --- a/lib/Lacuna/AI/Saben.pm +++ b/lib/Lacuna/AI/Saben.pm @@ -6,6 +6,7 @@ no warnings qw(uninitialized); extends 'Lacuna::AI'; use 5.010; use Lacuna::Util qw(randint format_date); +use Log::Any qw($log); use constant empire_id => -1; @@ -159,7 +160,7 @@ sub run_hourly_colony_updates { sub destroy_world { my ($self, $colony) = @_; if ($colony->is_bhg_neutralized) { - say sprintf("BHG of %s is neutralized by a space station.",$colony->name); + $log->debug(sprintf("BHG of %s is neutralized by a space station.",$colony->name)); return; } my $enemies = Lacuna->db->resultset('Lacuna::DB::Result::Spies') @@ -167,10 +168,10 @@ sub destroy_world { task => 'Sabotage BHG', empire_id => { '!=' => $self->empire_id }})->count; if ($enemies) { - say "Annoying non-saben on planet trying to Sabotage our BHG"; + $log->debug("Annoying non-saben on planet trying to Sabotage our BHG"); return; } - say "Looking for world to destroy..."; + $log->debug("Looking for world to destroy..."); my $targets = Lacuna->db->resultset('Map::Body')->search({ "me.zone" => $colony->zone, size => { between => [46, 75] }, @@ -193,7 +194,7 @@ sub destroy_world { my $target = $targets->search({}, { offset => $targetidx, rows => 1, order_by => 'me.id' })->first; if ($target) { - say "Found ".$target->name; + $log->debug("Found ".$target->name); my @to_demolish = @{$target->building_cache}; $target->delete_buildings(\@to_demolish); $target->update({ @@ -201,11 +202,11 @@ sub destroy_world { size => randint(1,10), usable_as_starter_enabled => 0, }); - say "Turned into ".$target->class; + $log->debug("Turned into ".$target->class); $colony->add_news(100, 'We are Sābēn. We have destroyed '.$target->name.'. Leave now.'); } else { - say "Nothing to destroy."; + $log->debug("Nothing to destroy."); } } diff --git a/lib/Lacuna/Cache.pm b/lib/Lacuna/Cache.pm index 9fd91f9d..ef69d8c5 100644 --- a/lib/Lacuna/Cache.pm +++ b/lib/Lacuna/Cache.pm @@ -6,6 +6,7 @@ use utf8; no warnings qw(uninitialized); use Memcached::libmemcached; use JSON; +use Log::Any qw($log); has 'servers' => ( is => 'ro', @@ -44,26 +45,26 @@ sub delete { my $memcached = $self->memcached; Memcached::libmemcached::memcached_delete($memcached, $key); if ($memcached->errstr eq 'SYSTEM ERROR Unknown error: 0') { - warn "Cannot connect to memcached server."; + $log->warn("Cannot connect to memcached server."); } elsif ($memcached->errstr eq 'UNKNOWN READ FAILURE' ) { if ($retry) { - warn "Cannot connect to memcached server."; + $log->warn("Cannot connect to memcached server."); } else { - warn "Memcached went away, reconnecting."; + $log->warn("Memcached went away, reconnecting."); $self->clear_memcached; $self->delete($namespace, $id, 1); } } elsif ($memcached->errstr eq 'NO SERVERS DEFINED') { - warn "No memcached servers specified."; + $log->warn("No memcached servers specified."); } elsif ($memcached->errstr ne 'SUCCESS' # deleted && $memcached->errstr ne 'PROTOCOL ERROR' # doesn't exist to delete && $memcached->errstr ne 'NOT FOUND' # doesn't exist to delete ) { - warn "Couldn't delete $key from cache because ".$memcached->errstr; + $log->warn("Couldn't delete $key from cache because ".$memcached->errstr); } } @@ -72,54 +73,56 @@ sub flush { my $memcached = $self->memcached; Memcached::libmemcached::memcached_flush($memcached); if ($memcached->errstr eq 'SYSTEM ERROR Unknown error: 0') { - warn "Cannot connect to memcached server."; + $log->warn("Cannot connect to memcached server."); } elsif ($memcached->errstr eq 'UNKNOWN READ FAILURE' ) { confess "Cannot connect to memcached server." if $retry; - warn "Memcached went away, reconnecting."; + $log->warn("Memcached went away, reconnecting."); $self->clear_memcached; return $self->flush(1); } elsif ($memcached->errstr eq 'NO SERVERS DEFINED') { - warn "No memcached servers specified."; + $log->warn("No memcached servers specified."); } elsif ($memcached->errstr ne 'SUCCESS') { - warn "Couldn't flush cache because ".$memcached->errstr; + $log->warn("Couldn't flush cache because ".$memcached->errstr); } } sub get { my ($self, $namespace, $id, $retry) = @_; my $key = $self->fix_key($namespace, $id); + $log->info("[Cache]: getting key $key"); my $memcached = $self->memcached; my $content = Memcached::libmemcached::memcached_get($memcached, $key); if ($memcached->errstr eq 'SUCCESS') { + $log->info("[Cache]: got value $content"); return $content; } elsif ($memcached->errstr eq 'NOT FOUND' ) { return undef; } elsif ($memcached->errstr eq 'NO SERVERS DEFINED') { - warn "No memcached servers specified."; + $log->warn("No memcached servers specified."); return undef; } elsif ($memcached->errstr eq 'SYSTEM ERROR Unknown error: 0' || $retry) { - warn "Cannot connect to memcached server."; + $log->warn("Cannot connect to memcached server."); return undef; } elsif ($memcached->errstr eq 'UNKNOWN READ FAILURE' ) { - warn "Memcached went away, reconnecting."; + $log->warn("Memcached went away, reconnecting."); $self->clear_memcached; return $self->get($namespace, $id, 1); } - warn "Couldn't get $key from cache because [".$memcached->errstr."]"; + $log->error("[Cache]: couldn't get $key from cache because [".$memcached->errstr."]"); } sub get_and_deserialize { my ($self, $namespace, $id) = @_; my $value = $self->get($namespace, $id); $value = eval{JSON::from_json($value)} if ($value); - warn $@ if ($@); + $log->warn($@) if ($@); return $value; } @@ -138,17 +141,17 @@ sub add { return undef; } elsif ($memcached->errstr eq 'SYSTEM ERROR Unknown error: 0' || $retry) { - warn "Cannot connect to memcached server."; + $log->warn("Cannot connect to memcached server."); } elsif ($memcached->errstr eq 'UNKNOWN READ FAILURE' ) { - warn "Memcached went away, reconnecting."; + $log->warn("Memcached went away, reconnecting."); $self->clear_memcached; return $self->set($namespace, $id, $value, $ttl, 1); } elsif ($memcached->errstr eq 'NO SERVERS DEFINED') { - warn "No memcached servers specified."; + $log->warn("No memcached servers specified."); } - warn "Couldn't set $key to cache because ".$memcached->errstr; + $log->warn("Couldn't set $key to cache because ".$memcached->errstr); } @@ -163,17 +166,17 @@ sub set { return $value; } elsif ($memcached->errstr eq 'SYSTEM ERROR Unknown error: 0' || $retry) { - warn "Cannot connect to memcached server."; + $log->warn("Cannot connect to memcached server."); } elsif ($memcached->errstr eq 'UNKNOWN READ FAILURE' ) { - warn "Memcached went away, reconnecting."; + $log->warn("Memcached went away, reconnecting."); $self->clear_memcached; return $self->set($namespace, $id, $value, $ttl, 1); } elsif ($memcached->errstr eq 'NO SERVERS DEFINED') { - warn "No memcached servers specified."; + $log->warn("No memcached servers specified."); } - warn "Couldn't set $key to cache because ".$memcached->errstr; + $log->warn("Couldn't set $key to cache because ".$memcached->errstr); } @@ -192,17 +195,17 @@ sub increment { return $self->set($namespace, $id, $amount, $ttl); } elsif ($memcached->errstr eq 'SYSTEM ERROR Unknown error: 0' || $retry) { - warn "Cannot connect to memcached server."; + $log->warn("Cannot connect to memcached server."); } elsif ($memcached->errstr eq 'UNKNOWN READ FAILURE' ) { - warn "Memcached went away, reconnecting."; + $log->warn("Memcached went away, reconnecting."); $self->clear_memcached; return $self->set($namespace, $id, $amount, 1); } elsif ($memcached->errstr eq 'NO SERVERS DEFINED') { - warn "No memcached servers specified."; + $log->warn("No memcached servers specified."); } - warn "Couldn't set $key to cache because ".$memcached->errstr; + $log->warn("Couldn't set $key to cache because ".$memcached->errstr); } diff --git a/lib/Lacuna/DB/Result/Empire.pm b/lib/Lacuna/DB/Result/Empire.pm index 03412272..b7b73c24 100644 --- a/lib/Lacuna/DB/Result/Empire.pm +++ b/lib/Lacuna/DB/Result/Empire.pm @@ -15,6 +15,7 @@ use UUID::Tiny ':std'; use Lacuna::Constants qw(INFLATION); use PerlX::Maybe qw(provided maybe); use Lacuna::Mailer; +use Log::Any qw($log); __PACKAGE__->table('empire'); __PACKAGE__->add_columns( @@ -554,11 +555,11 @@ sub reset_rpc { my $cache = Lacuna->cache; my $id = $self->id; - printf "RPC count was: %d\n", $cache->get('rpc_count_'.format_date(undef,'%d'), $id); - printf "RPC rate was: %d\n", $cache->get('rpc_rate_'.format_date(undef,'%M'), $id); + $log->info(sprintf "RPC count was: %d", $cache->get('rpc_count_'.format_date(undef,'%d'), $id)); + $log->info(sprintf "RPC rate was: %d", $cache->get('rpc_rate_'.format_date(undef,'%M'), $id)); $cache->delete('rpc_count_'.format_date(undef,'%d'), $id); $cache->delete('rpc_rate_'.format_date(undef,'%M'), $id); - printf "Reset to zero."; + $log->info("Reset to zero."); } # The number of times the rate limit has been exceeded @@ -1063,7 +1064,7 @@ sub send_predefined_message { ); } else { - warn "Couldn't send message using $path"; + $log->error("Couldn't send message using $path"); } } diff --git a/lib/Lacuna/DB/Result/Ships.pm b/lib/Lacuna/DB/Result/Ships.pm index 9003505f..a83e9942 100644 --- a/lib/Lacuna/DB/Result/Ships.pm +++ b/lib/Lacuna/DB/Result/Ships.pm @@ -9,6 +9,7 @@ use Lacuna::Constants qw(HIGH_SPEED_TEST_TRAVEL_DIVISOR HIGH_SPEED_TEST_TRAVEL_M use DateTime; use Scalar::Util qw(weaken); use Switch::Right; +use Log::Any qw($log); has 'hostile_action' => ( is => 'rw', @@ -222,8 +223,8 @@ sub arrive { # Log it loudly and still resolve the journey (land / turn around) so the # ship is recoverable. my $detail = ref $reason eq 'ARRAY' ? join(' ', map { defined $_ ? $_ : '' } @$reason) : "$reason"; - warn sprintf("Ship %s (%s) arrival handling failed, landing anyway: %s", - $self->id, $self->type, $detail); + $log->error(sprintf("Ship %s (%s) arrival handling failed, landing anyway: %s", + $self->id, $self->type, $detail)); } # If a role deleted the ship before dying, there's nothing left to resolve. diff --git a/lib/Lacuna/DB/Result/Spies.pm b/lib/Lacuna/DB/Result/Spies.pm index ddf4bae5..d97f4ca8 100644 --- a/lib/Lacuna/DB/Result/Spies.pm +++ b/lib/Lacuna/DB/Result/Spies.pm @@ -12,6 +12,7 @@ use Scalar::Util qw(weaken); use Switch::Right; use Lacuna::Constants qw(ORE_TYPES FOOD_TYPES SHIP_TYPES); +use Log::Any qw($log); __PACKAGE__->table('spies'); @@ -430,12 +431,12 @@ sub tick_all_spies { }); # TODO further efficiencies could be made by ignoring spies not yet 'available' - say "Number of spies selected: ".$spies->count; + $log->debug("Number of spies selected: ".$spies->count); while (my $spy = $spies->next) { if ($verbose) { - say format_date(DateTime->now), + $log->debug(format_date(DateTime->now). sprintf(" Tick Spy %s:%s %s Task: %s since %s", - $spy->id, $spy->name, $spy->empire_id, $spy->task, format_date($spy->started_assignment)); + $spy->id, $spy->name, $spy->empire_id, $spy->task, format_date($spy->started_assignment))); } my $starting_task = $spy->task; $spy->is_available; diff --git a/lib/Lacuna/Mailer.pm b/lib/Lacuna/Mailer.pm index 173a8b44..7b1127d6 100644 --- a/lib/Lacuna/Mailer.pm +++ b/lib/Lacuna/Mailer.pm @@ -5,6 +5,7 @@ use utf8; use LWP::UserAgent; use Data::Dumper; use MIME::Base64; +use Log::Any qw($log); no warnings qw(uninitialized); @@ -40,7 +41,7 @@ sub send { ); if (!$response->is_success) { - print Dumper($response); + $log->error("Failed to send mail: ".Dumper($response)); } } -- 2.51.2