From c4231f2d4e85f756112bda3330c301d6ac96ca32 Mon Sep 17 00:00:00 2001 From: Darin McBride Date: Thu, 24 Dec 2015 21:49:02 -0700 Subject: [PATCH] Christmas 2015 scripts. --- bin/util/christmas_2015a.pl | 128 +++++++++++++++++++++++++++++++++ bin/util/christmas_2015b.pl | 71 ++++++++++++++++++ bin/util/christmas_2015pre.pl | 132 ++++++++++++++++++++++++++++++++++ 3 files changed, 331 insertions(+) create mode 100755 bin/util/christmas_2015a.pl create mode 100755 bin/util/christmas_2015b.pl create mode 100755 bin/util/christmas_2015pre.pl diff --git a/bin/util/christmas_2015a.pl b/bin/util/christmas_2015a.pl new file mode 100755 index 00000000..df1338c3 --- /dev/null +++ b/bin/util/christmas_2015a.pl @@ -0,0 +1,128 @@ +#!/data/apps/bin/perl + +use strict; +use warnings; +use lib '/data/Lacuna-Server/lib'; +use L; +use List::Util qw(sum); +use Getopt::Long; + +LD->class('Empire')->has_many('selflogins', 'Lacuna::DB::Result::Log::Login', sub { + my $args = shift; + return ( + { + "$args->{foreign_alias}.empire_id" => { -ident => "$args->{self_alias}.id" }, + "$args->{foreign_alias}.is_sitter" => 0, + }, + $args->{self_rowobj} && { + "$args->foreign_alias}.empire_id" => $args->{self_rowobj}->id, + "$args->{foreign_alias}.is_sitter" => 0, + } + ) +}); + +# this is a hack shown to me on IRC in #dbix-class for reregistering +# a DBIC class after having modified the relationships at runtime +# as per above. +my $rec_class = LD->class('Empire'); +LD->unregister_source('Empire'); +LD->register_class('Empire' => $rec_class); + + +$|=1; +our $quiet; +GetOptions( + 'quiet' => \$quiet, +); + +out('Started'); +my $start = time; + +# this will take ~45 seconds to query, but we're only running it once. +my $empires = LD->resultset('Empire') + ->search( + { + 'me.id' => { '>' => 1 }, + 'selflogins.date_stamp' => { '>=' => '2015-12-01 00:00:00' }, + }, + { + join => 'selflogins', + group_by => 'me.id', + } + ); + +my $santa = LD->empire('Santa Claus'); + +my $message = << 'MESSAGE'; +Ho! Ho! Ho! + +It appears that the Christmas spirit has infected %s, the whole planet is so much happier now! + +It might just have something to do with that new plan left behind. Though you may not be able to build it, my elves will keep an eye out for when you're ready. All you have to do is move the plan to your desired colony, go into the Planetary Command Center's Notes tab, and put the magic word "pyramid31" in, save it, and the next time the elves notice, it will be done! + +But, beware the Ides of March - if the plan isn't used by March 15th, it will disappear! Be sure to use it! +MESSAGE + +out('Sending messages'); +while (my $e = $empires->next) +{ + out("Updating ". $e->name); + my $home = $e->home_planet; + next unless defined $home; + + my $notes = $e->notes; + my $target = $home; + + my $find_happy = qr/" \s* + happy \s* : \s* + ([^"]*?) \s* + "/xi; # i = some people may have capitalised something. + + if ( + defined $notes && length $notes && + $notes =~ $find_happy) + { + # $1 is somehow magical - stringify to lose said magic. + my $request = "$1"; + out(" User requested planet '$request'."); + my $happy = LD->body($request); + if ($happy && + $happy->empire_id == $e->id && + $happy->get_type ne 'space station' + ) + { + # found it, keep it. + out(" " . $happy->name . " is owned by empire " . $e->name . ", using it and marking it done in empire notes."); + + $notes =~ s/$find_happy\K/ -- DONE/; + + $e->notes($notes); + $e->update; + $target = $happy; + } + } + + out(" Planet: ".$target->name); + + # give out 3Q happy + my $happy_bonus = 3e15; + + # but if the target is already 3Q in the hole, bring them to zero. + $happy_bonus = -$target->happiness if $target->happiness < -$happy_bonus; + + out(" happy + $happy_bonus"); + $target->add_happiness($happy_bonus); + $target->update; + + out(" Pyramid 31+0"); + $target->add_plan('Lacuna::DB::Result::Building::Permanent::PyramidJunkSculpture',31,0,1); + + $e->send_message( + tag => 'Correspondence', + subject => 'A Gift.', + from => $santa, + body => sprintf($message,$target->name), + ); + +} + diff --git a/bin/util/christmas_2015b.pl b/bin/util/christmas_2015b.pl new file mode 100755 index 00000000..8106fba1 --- /dev/null +++ b/bin/util/christmas_2015b.pl @@ -0,0 +1,71 @@ +#!/data/apps/bin/perl + +use strict; +use warnings; +use lib '/data/Lacuna-Server/lib'; +use L; +use List::Util qw(sum); +use Getopt::Long; + +$|=1; +our $quiet; +GetOptions( + 'quiet' => \$quiet, +); + +out('Started'); +my $start = time; + +my $bodies = LD->resultset('Map::Body') + ->search( + { + 'me.notes' => { like => '%pyramid31%' }, + '_plans.class' => 'Lacuna::DB::Result::Building::Permanent::PyramidJunkSculpture', + '_plans.level' => 31, + '_plans.extra_build_level' => 0, + '_plans.quantity' => { '>' => 0 }, + '_buildings.class' => 'Lacuna::DB::Result::Building::Permanent::PyramidJunkSculpture', + '_buildings.level' => 30, + }, + { + join => [ '_plans', '_buildings' ], + prefetch => [ 'empire' ], + } + ); + +my $santa = LD->empire('Santa Claus'); + +my $message = << 'MESSAGE'; +Ho! Ho! Ho! + +My elves have reported back to me that they found a request for a pyramid upgrade to level 31 on %s and have completed their work! + +Don't forget to remove the magic word from the colony notes! + +Merry Christmas! +MESSAGE + +out('Looking for upgrades'); +while (my $b = $bodies->next) +{ + out("Updating ". $b->name); + + my $pyr = $b->get_a_building('Permanent::PyramidJunkSculpture'); + die "What?" unless $pyr->level == 30; + + my $plan = $b->get_plan($pyr->class, 31); + die "No plan??" unless $plan; + + $b->delete_one_plan($plan); + $pyr->level(31); # no build time, Christmas magic + $pyr->update; + + $b->empire->send_message( + tag => 'Correspondence', + subject => 'Elven magic.', + from => $santa, + body => sprintf($message,$b->name), + ); + +} + diff --git a/bin/util/christmas_2015pre.pl b/bin/util/christmas_2015pre.pl new file mode 100755 index 00000000..615cf7a7 --- /dev/null +++ b/bin/util/christmas_2015pre.pl @@ -0,0 +1,132 @@ +#!/data/apps/bin/perl + +use strict; +use warnings; +use lib '/data/Lacuna-Server/lib'; +use L; +use List::Util qw(sum); +use Getopt::Long; + +LD->class('Empire')->has_many('selflogins', 'Lacuna::DB::Result::Log::Login', sub { + my $args = shift; + return ( + { + "$args->{foreign_alias}.empire_id" => { -ident => "$args->{self_alias}.id" }, + "$args->{foreign_alias}.is_sitter" => 0, + }, + $args->{self_rowobj} && { + "$args->foreign_alias}.empire_id" => $args->{self_rowobj}->id, + "$args->{foreign_alias}.is_sitter" => 0, + } + ) +}); + +# this is a hack shown to me on IRC in #dbix-class for reregistering +# a DBIC class after having modified the relationships at runtime +# as per above. +my $rec_class = LD->class('Empire'); +LD->unregister_source('Empire'); +LD->register_class('Empire' => $rec_class); + +$|=1; +our $quiet; +GetOptions( + 'quiet' => \$quiet, +); + +out('Started'); +my $start = time; + +my $empires = LD->resultset('Empire') + ->search( + { + 'notes' => { like => '%happy%' }, + 'me.id' => { '>' => 1 }, + 'selflogins.date_stamp' => { '>=' => '2015-12-01 00:00:00' }, + }, + { + join => 'selflogins', + group_by => 'me.id', + } + ); + +my $santa = LD->empire('Santa Claus'); + +my $message = << 'MESSAGE'; +Santa's elves here. We've been helping Santa with his Christmas list this year, and have noticed that your Christmas wish may be misunderstood. + +When Santa comes along, he'll be in a great hurry, so if your empire notes don't match exactly, he'll end up leaving your presents in the wrong place. + +Your empire notes have the word "happy" in there, but do not exactly match the required format to help speed Santa's delivery with accuracy. + +The format must look like this: + +"happy: your planet" + +or + +"happy: your planet body ID" + +The quotes, and their positioning around the whole request, are important, or Santa won't find them. + +In your case, %s + +Tou Ra Ell +Elf In Charge of TLE Gift Targetting + +PS: If you have the word "happy" in your notes and don't intend on it being part of this Christmas' event, please accept my apologies - we have so much expanse to review, it's too easy to misread requests. + +PPS: No, I am not related to Tou Re Ell. I think I got this job only because Santa was being funny and noticed the name similarity. +MESSAGE + +out('Finding empires'); +while (my $e = $empires->next) +{ + out("Checking ". $e->name); + next; + my $notes = $e->notes; + my $error; + + my $find_happy = qr/" \s* + happy \s* : \s* + ([^"]*?) \s* + "/xi; # i = some people may have capitalised something. + + if ($notes =~ $find_happy) + { + # $1 is somehow magical - stringify to lose said magic. + my $request = "$1"; + out(" User requested '$request'."); + my $happy = LD->body($request); + if (!$happy) { + if ($request =~ /\D/) { + $error = "we cannot find '$request' as a target planet."; + } else { + $error = "we cannot find '$request' as a target planet ID (be sure you get the planet ID, not an ID for a building on the planet)."; + } + } + elsif ($happy->get_type eq 'space station') { + $error = "we cannot target a space station."; + } + elsif ($happy->empire_id != $e->id) { + $error = "'$request' is not your planet"; + } + } + else + { + $error = "format not followed."; + } + + if ($error) { + out($error); + + $e->send_message( + tag => 'Correspondence', + subject => 'Error detected in empire notes.', + from => $santa, + body => sprintf($message,$error), + ); + } + +} + -- 2.51.2