Something went wrong. Try again.
Perl game server for TLE Community
Something went wrong. Try again.
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156use 5.010;use strict;use warnings;
use lib '/home/lacuna/server/lib';use Lacuna::DB;use Lacuna;use Lacuna::Util qw(randint format_date);use Lacuna::CaptchaFactory;
use Getopt::Long;use App::Daemon qw(daemonize );use Data::Dumper;use Try::Tiny;use Log::Log4perl qw(:levels);
# --------------------------------------------------------------------# command line arguments:#my $daemonize = 1; # run the script as a daemonmy $initialize = 1; # (re)initialize the queue from the databaseour $quiet = 1; # don't output any text
GetOptions( 'daemonize!' => \$daemonize, 'quiet!' => \$quiet, 'initialize!' => \$initialize,);
$App::Daemon::loglevel = $quiet ? $WARN : $DEBUG;$App::Daemon::logfile = '/home/lacuna/server/log/scheduler/schedule_captcha.log';$App::Daemon::as_user = 'root';$App::Daemon::as_group = 'root';
chdir '/home/lacuna/server/bin';
my $pid_file = '/home/lacuna/server/bin/schedule_captcha.pid';
my $start = time;
# kill any existing processes#if (-f $pid_file) { open(PIDFILE, $pid_file); my $PID = <PIDFILE>; chomp $PID; if (grep /$PID/, `ps -p $PID`) { close (PIDFILE); out("Killing previous job, PID=$PID"); kill 9, $PID; sleep 5; }}
# --------------------------------------------------------------------# Daemonize
if ($daemonize) { daemonize(); out('Running as a daemon');}else { out('Running in the foreground');}
my $config = Lacuna->config;
my $queue = Lacuna::Queue->new({ max_timeouts => $config->get('beanstalk/max_timeouts'), max_reserves => $config->get('beanstalk/max_reserves'), server => $config->get('beanstalk/server'), ttr => $config->get('beanstalk/ttr'), debug => $config->get('beanstalk/debug'),});
out("queue = $queue");
# --------------------------------------------------------------------# Main processing loop
out('Started');eval { LOOP: do { my $job = $queue->consume('captcha'); out('job received ['.$job->id.']');
try { # process the job
my $captcha_factory = Lacuna::CaptchaFactory->new({ develop_mode => $config->get('develop_mode') ? 1 : 0, fonts => $config->get('captcha/fonts'), font_path => $config->get('captcha/fontpath'), }); $captcha_factory->construct; out("Captcha created [".$captcha_factory->guid."]");
# Remove all captchas older than 1hr (except for one) # # select * from captcha where created < DATE_SUB(now(), INTERVAL 1 HOUR) order by id desc; # my $captchas = Lacuna->db->resultset('Captcha')->search({ created => \"< DATE_SUB(now(), INTERVAL 1 HOUR)", },{ order_by => { -desc => 'id' }, }); # Make sure there is at least one left irrespective of it's age my $captcha = $captchas->next;
while ($captcha = $captchas->next) { out("Deleting captcha [".$captcha->id."]");
my $prefix = substr($captcha->guid, 0,2); my $file = "/home/lacuna/server/public/captcha/$prefix/".$captcha->guid.".png"; out("Deleting file [$file]"); unlink($file); $captcha->delete; }
out("Processing done. Delete job ".$job->id); $job->delete; } catch { # bury the job, it failed out("Job ".$job->id." failed: $_"); $job->bury; }; } while (1);};if ($@) { die unless $@ eq "alarm\n"; # propagate unexpected errors # timed out}
my $finish = time;out('Finished');out(int(($finish - $start)/60)." minutes have elapsed");exit 0;
################# SUBROUTINES###############
sub out { my ($message) = @_; my $logger = Log::Log4perl->get_logger; # STDERR is what actually lands in the log: under compose bin/run_scheduler.sh # tees it to log/scheduler/, and App::Daemon captures it to $logfile when # daemonized. Log4perl is never ->init'd here, so $logger->info is a no-op. print STDERR $message."\n"; $logger->info($message);}