101 lines
2.1 KiB
Perl
101 lines
2.1 KiB
Perl
package LasTres::EventLoop;
|
|
|
|
use v5.36.0;
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use feature 'signatures';
|
|
|
|
use Moo;
|
|
use JSON qw/to_json from_json/;
|
|
|
|
has _app => ( is => 'lazy' );
|
|
|
|
has _schema => ( is => 'lazy' );
|
|
|
|
has _redis => ( is => 'lazy' );
|
|
|
|
sub _build__app {
|
|
require LasTres;
|
|
return LasTres->new;
|
|
}
|
|
|
|
sub _build__schema {
|
|
require LasTres::Schema;
|
|
return LasTres::Schema->Schema;
|
|
}
|
|
|
|
sub _build__redis {
|
|
require LasTres::Redis;
|
|
return LasTres::Redis->new;
|
|
}
|
|
|
|
sub _exit_the_program {
|
|
exit 0;
|
|
}
|
|
|
|
$SIG{CHLD} = 'IGNORE';
|
|
$SIG{INT} = \&_exit_the_program;
|
|
$SIG{QUIT} = \&_exit_the_program;
|
|
$SIG{TERM} = \&_exit_the_program;
|
|
|
|
sub loop ($self) {
|
|
my $child_pid = fork;
|
|
if ( !$child_pid ) {
|
|
$self->_real_loop;
|
|
}
|
|
}
|
|
|
|
sub _work_frame ($self) {
|
|
$self->_increment_frame_for_movers();
|
|
}
|
|
|
|
sub _increment_frame_for_movers ($self) {
|
|
my $schema = $self->_schema;
|
|
my $result_set_teams = $schema->resultset('Team');
|
|
my @teams = $result_set_teams->search( { -bool => 'is_moving' } );
|
|
for my $team (@teams) {
|
|
$self->_increment_frame_for_mover($team);
|
|
}
|
|
}
|
|
|
|
sub _increment_frame_for_mover ( $self, $team ) {
|
|
$team = $team->get_from_storage;
|
|
my $frame = $team->action_frame;
|
|
$team->action_frame( ++$frame );
|
|
$team->update;
|
|
my $location = $team->location;
|
|
my $target_location =
|
|
LasTres::Location::get( from_json( $team->moving_to )->@* );
|
|
if ( $frame >= $location->parent->frames_to_move ) {
|
|
$team->action_frame(0);
|
|
$team->is_moving(0);
|
|
$team->moving_to('null');
|
|
$team->update;
|
|
$target_location->place_team($team);
|
|
return;
|
|
}
|
|
$team->send_frame_to_members;
|
|
}
|
|
|
|
sub _real_loop ($self) {
|
|
eval {
|
|
my $redis = $self->_redis;
|
|
while (1) {
|
|
if ( !defined $redis->db->get( $redis->executing_frame_key ) ) {
|
|
$redis->db->setex( $redis->executing_frame_key, 10, 1 );
|
|
$self->_work_frame;
|
|
}
|
|
my $ttl = $redis->db->ttl( $redis->executing_frame_key );
|
|
if ( $ttl > 0 ) {
|
|
sleep $ttl;
|
|
}
|
|
}
|
|
};
|
|
if ($@) {
|
|
warn $@;
|
|
}
|
|
}
|
|
1;
|