view release on metacpan or  search on metacpan

lib/Any/Daemon.pm  view on Meta::CPAN

      { my $signal = shift;
        notice "daemon terminated by signal $signal";

        my $pidfn = $self->pidFilename;
        unlink $pidfn if $pidfn;

        my $intrnr = $signal eq 'INT' ? 2 : 9;
        exit $intrnr+128;
      };

    notice __x"daemon started; proc={proc} uid={uid} gid={gid}"
      , proc => $PID, uid => $EUID, gid => $EGID;

    $run_task->();
}

sub reconfigDaemon(@)
{   my ($self, @childs) = @_;
    notice "HUP: reconfigure deamon not implemented";
}

sub killChilds(@)
{   my ($self, @childs) = @_;
    @childs or return;

    notice "killing ".@childs." children";
    kill TERM => @childs;
}

# standard implementation for starting new childs.
sub childDied($$)
{   my ($self, $max_childs, $run_child) = @_;

    # Clean-up zombies

  ZOMBIE:
    while(1)
    {   my $kid = waitpid -1, WNOHANG;
        last ZOMBIE if $kid <= 0;

        if($? != 0)
        {   my $err = WIFEXITED($?) ? "errno ".WEXITSTATUS($?) : "sig $?";
            notice "$kid process terminated with $err";
            # when children start to die, do not respawn too fast,
            # because usually this means serious troubles with the
            # server (like database) or implementation.
            sleep ERROR_RECOVERY_SLEEP;
        }

        delete $childs{$kid};
    }

    # Start enough childs
    my $silence_warn = 0;

  BIRTH:
    while(keys %childs < $max_childs)
    {   my $kid = fork;
        unless(defined $kid)
        {   alert "cannot fork new children" unless $silence_warn++;
            sleep 1;     # wow, back down!  Probably too busy.
            $silence_warn = 0 if $silence_warn==SLOW_WARN_AGAIN_AFTER;
            next BIRTH;
        }

        if($kid==0)
        {   # new child
            $SIG{HUP} = $SIG{TERM} = $SIG{INT}
               = sub {info 'child says bye'; exit 0};

            # I'll not handle my parent's kids!
            $SIG{CHLD} = 'IGNORE';
            %childs    = ();

            my $rc     = $run_child->();
            exit $rc;
        }

        # parent
        $childs{$kid}++;
    }
}

1;