#!/usr/bin/env perl use Dancer qw/:moose :script/; use Daemon::Generic::While1; use Parallel::Prefork; use Role::Tiny; # with 'Netdisco::Daemon::Manager'; my $pp = Parallel::Prefork->new( max_workers => (setting('daemon_workers') || 2), spawn_interval => 2, after_fork => \®ister_worker, on_child_reap => \&unregister_worker, trap_signals => { TERM => 'TERM', INT => 'TERM', HUP => undef, # catch but don't relay to workers }, ); # tracks worker pids and their roles my %workers = (); my $next_role = undef; # must come after globals initialization newdaemon( progname => 'netdisco-daemon', ($> != 0 ? (pidbase => './') : ()), logpriority => 'daemon.info', ); # main manager loop sub gd_run_body { my $self = shift; $self->handle_term if $pp->signal_received =~ m/^(?:TERM|INT)$/; $self->handle_hup if $pp->signal_received eq 'HUP'; if ($pp->num_workers < $pp->max_workers) { $next_role = $self->next_worker_role or return; $pp->start and return; with "Netdisco::Daemon::Worker::$next_role"; $self->worker_body; $pp->finish; } # check for new jobs, take one if available # $self->manager_body; $self->gd_sleep( setting('daemon_sleep_time') || 5 ); } sub register_worker { my (undef, $pid) = @_; $workers{$pid} = $next_role; } sub unregister_worker { my (undef, $pid, $status) = @_; delete $workers{$pid}; # also check for bad exit status? } sub next_worker_role { my $self = shift; my @cur = values %workers; my $poller = scalar grep {$_ eq 'Poller'} @cur; my $inter = scalar grep {$_ eq 'Interactive'} @cur; my $need_poller = $poller < (setting('daemon_pollers') || 0); my $need_inter = $inter < (setting('daemon_interactive') || 2); if ($need_poller and $need_inter) { return (int(rand(2)) ? 'Interactive' : 'Poller'); } return 'Interactive' if $need_inter; return 'Poller' if $need_poller; return undef; } sub handle_term { my $self = shift; $pp->wait_all_children; $self->gd_quit_event } sub handle_hup { my $self = shift; # clear signal $pp->signal_received(''); # reload dancer config %Dancer::Config::_LOADED = (); Dancer::Config::load(); # kill workers (they will be restarted) $pp->signal_all_children('TERM'); $pp->wait_all_children; $pp->{_no_adjust_until} = 0; # BUG in Prefork.pm } # do not remove - must be redefined for Daemon::Generic sub gd_preconfig { return () } # nullify this to permit Parallel::Prefork to register handlers instead sub gd_setup_signals {}