App-Base

 view release on metacpan or  search on metacpan

lib/App/Base/Daemon.pm  view on Meta::CPAN

Rather than double-forking and detaching from the console, the daemon
runs in the foreground (parent) process. Useful for debugging or
interactive invocations.

=head2 --pid-file

Writes PID of the daemon into specified file, by default writes pid into /var/run/__PACKAGE__.pid

=head2 --no-pid-file

Do not write pid file, and do not check if it is exist and locked.

=head2 --no-warn

Do not produce warnings, silent mode

=head1 REQUIRED SUBCLASS METHODS

=cut

use namespace::autoclean;

lib/App/Base/Daemon.pm  view on Meta::CPAN

            name          => 'no-fork',
            documentation => "Do not detach and run in the background",
        },
        {
            name          => 'pid-file',
            option_type   => 'string',
            documentation => "Use specified file to save PID",
        },
        {
            name          => 'no-pid-file',
            documentation => "Do not check if pidfile exists and locked",
        },
        {
            name          => 'user',
            documentation => "User to run as",
        },
        {
            name          => 'group',
            documentation => "Group to run as",
        },
        {

lib/App/Base/Daemon/Supervisor.pm  view on Meta::CPAN

}

my $pid;

# kill the old daemon and lock pid file
sub _control_takeover {
    my $self = shift;

    ## no critic (RequireLocalizedPunctuationVars)

    # if it is first generation, when pid file should be already locked in App::Base::Daemon
    if ($ENV{APP_BASE_DAEMON_GEN} > 1 and $ENV{APP_BASE_DAEMON_PID} != $$) {
        kill QUIT => $ENV{APP_BASE_DAEMON_PID};
        if ($self->getOption('no-pid-file')) {

            # we don't have pid file, so let's just poke it to death
            my $attempts = 14;
            while (kill(($attempts == 1 ? 'KILL' : 'ZERO') => $ENV{APP_BASE_DAEMON_PID})
                and $attempts--)
            {
                Time::HiRes::usleep(500_000);
            }
        } else {
            local $SIG{ALRM} = sub {
                warn("Couldn't lock the file. Sending KILL to previous generation process") unless $self->getOption('no-warn');
            };
            alarm 5;

            # We may fail because two reasons:
            # a) previous process didn't exit and still holds the lock
            # b) new process was started and locked pid
            $pid = eval { File::Flock::Tiny->lock($self->pid_file) };
            unless ($pid) {

                # So let's try killing old process, if after that locking still will fail
                # then probably it is the case b) and we should exit
                kill KILL => $ENV{APP_BASE_DAEMON_PID};
                $SIG{ALRM} = sub { $self->error("Still couldn't lock pid file, aborting") };
                alarm 5;
                $pid = File::Flock::Tiny->lock($self->pid_file);
            }

lib/App/Base/Script/OnlyOne.pm  view on Meta::CPAN

=head1 SYNOPSIS

    use Moose;
    extends 'App::Base::Script';
    with 'App::Base::Script::OnlyOne';

=head1 DESCRIPTION

With this role your script will refuse to start if another copy of the script
is running already (or if it is deadlocked or entered an infinite loop because
of programming error). After start it tries to lock pid file, and if this is
not possible, it dies.

=cut

around script_run => sub {
    my $orig = shift;
    my $self = shift;

    my $class   = ref $self;

t/daemon.t  view on Meta::CPAN

    exits_ok(sub { Test::Daemon->new->error("This is an error message") }, "error() forces exit");
}
[qr/This is an error message/], "Expected warning";

my $pdir    = Path::Tiny->tempdir;
my $pidfile = $pdir->child('Test::Daemon.pid');

FORK:
{
    local $ENV{APP_BASE_DAEMON_PIDDIR} = $pdir;
    ok(File::Flock::Tiny->trylock($pidfile), "Pidfile is not locked");
    is(Test::Daemon->new->run, 0, 'Test daemon spawns detached child process');
    wait_file($pidfile);
    ok(-f $pidfile, "Pid file exists");
    chomp(my $pid = read_file($pidfile));
    ok $pid, "Have read daemon PID";
    BAIL_OUT("No PID file, can't continue") unless $pid;
    ok !File::Flock::Tiny->trylock($pidfile), "Pidfile is locked";
    ok kill(0 => $pid),                       "Grandchild process is running";
    throws_ok { Test::Daemon->new->run } qr/another copy of this daemon already running/, "Can not start second copy";
    ok kill(INT => $pid), "Able to send SIGINT signal to process";

    #wait pid to exit at most 5 seconds
    for (my $i = 0; $i <= 10; $i++) {
        last unless kill(0 => $pid);
        Time::HiRes::usleep(5e5);
    }
    ok !kill(0 => $pid), "Grandchild process has shut down";