97 lines
2.0 KiB
Perl
Executable File
97 lines
2.0 KiB
Perl
Executable File
#!/usr/bin/env perl
|
|
|
|
use FindBin;
|
|
use lib "$FindBin::Bin/../lib";
|
|
use App::Netdisco;
|
|
|
|
# for netdisco app config
|
|
use Dancer qw/:moose :script/;
|
|
|
|
# callbacks and local job queue management
|
|
use App::Netdisco::Daemon::Queue ':all';
|
|
|
|
# needed to quench AF_INET6 symbol errors
|
|
use NetAddr::IP::Lite ':lower';
|
|
|
|
use MCE;
|
|
use Role::Tiny;
|
|
use Path::Class 'dir';
|
|
|
|
my $mce = MCE->new(
|
|
tmp_dir => dir($ENV{HOME}, 'tmp'),
|
|
spawn_delay => 0.15,
|
|
job_delay => 0.15,
|
|
user_func => \&call_worker_body,
|
|
on_post_exit => \&restart_worker,
|
|
user_tasks => build_tasks_list(),
|
|
)->run();
|
|
|
|
sub call_worker_body {
|
|
my ($self) = @_;
|
|
$self->worker_body if $self->can('worker_body');
|
|
}
|
|
|
|
sub restart_worker {
|
|
my ($self, $e) = @_;
|
|
reset_jobs($e->{wid});
|
|
$self->restart_worker($e->{wid});
|
|
}
|
|
|
|
sub build_tasks_list {
|
|
my $tasks = [{
|
|
max_workers => 1,
|
|
user_begin => worker_factory('Manager'),
|
|
}];
|
|
|
|
set(daemon_pollers => 2)
|
|
if !defined setting('daemon_pollers');
|
|
set(daemon_interactives => 2)
|
|
if !defined setting('daemon_interactives');
|
|
|
|
# XXX MCE does not like max_workers => 0
|
|
|
|
push @$tasks, {
|
|
max_workers => setting('daemon_pollers'),
|
|
user_begin => worker_factory('Poller'),
|
|
} if setting('daemon_pollers');
|
|
|
|
push @$tasks, {
|
|
max_workers => setting('daemon_interactives'),
|
|
user_begin => worker_factory('Interactive'),
|
|
} if setting('daemon_interactives');
|
|
|
|
return $tasks;
|
|
}
|
|
|
|
sub worker_factory {
|
|
my $role = shift;
|
|
return sub {
|
|
my $self = shift;
|
|
with "App::Netdisco::Daemon::Worker::$role";
|
|
$self->worker_begin if $self->can('worker_begin');
|
|
};
|
|
}
|
|
|
|
sub interruptible_sleep {
|
|
my ($period) = @_;
|
|
my $hires = 0;
|
|
|
|
if ($period * 1000 != int($period * 1000)) {
|
|
$hires = 1;
|
|
require Time::HiRes;
|
|
import Time::HiRes qw(time sleep);
|
|
}
|
|
|
|
my $t = time;
|
|
while (time - $t < $period) {
|
|
if ($hires) {
|
|
my $p = (time - $t < 1)
|
|
? time - $t
|
|
: 1;
|
|
sleep($p);
|
|
} else {
|
|
sleep(1);
|
|
}
|
|
}
|
|
}
|