The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

NAME

CTK::Daemon - Abstract class to implement Daemons

VERSION

Version 1.03

SYNOPSIS

    use base qw/CTK::Daemon/;

    sub new {
        my $class = shift;
        # ... your code ...
        $class->SUPER::new(shift, @_);
    }

    sub run {
        my $self = shift;
        my $logger = $self->logger;
        $logger->log_info("Code is running");

        my $step = 5;
        while ($self->ok) { # Check it every time

            # If occurred usual error:
            #    $logger->log_error("...");
            #    mysleep SLEEP;
            #    next;

            # If occurred exception error
            #    $logger->log_crit("...");
            #    $self->exception(1);
            #    last;

            # For skip this loop
            #    $self->skip(1);
            #    next;

            last unless $self->ok; # Check it every time (after loop too)
        } continue {
            CTK::Daemon::mysleep $step if $step; # Delay! For avoid fast restarts
        }

        return 1;
    }

DESCRIPTION

Abstract class to implement Daemons

FEATURES

  • Write PID file /var/run/$name.pid to make sure only one instance is running.

  • Correctly daemonize (redirect STDIN/STDOUT)

  • Restart by stop/start, exec, or signal HUP

  • Daemon restart on error

  • Handle worker processes

  • Run as different user using setuid/setgid

METHODS

new
    my $daemon = new CTK::Daemon('testdaemon', (
        ctk         => CTK::App->new(...), # Or create CTKx instance first
        debug       => 1, # Default: 0
        loglevel    => "debug", # Default: undef
        forks       => 3, # Default: 1
        uid         => "username", # Default: undef
        gid         => "groupname", # Default: undef
    ));

Daemon constructor

ctk, get_ctk
    my $ctk = $daemon->get_ctk;

Returns CTK object

ctrl
    exit ctrl( shift @ARGV ); # start, stop, restart, reload, status

LSB Control handler. Dispatching

logger
    my $logger = $daemon->logger;

Returns logger object

logger_close
    $daemon->logger_close;

Destroy logger

exit_daemon
    $self->exit_daemon(0);
    $self->exit_daemon(1);

Exit with status code

init, down, run

Base methods for overwriting in your class.

The init() method is called at startup - before forking

The run() method is called at inside process and describes body of the your code

The down () method is called at cleanup - after processing

start, stop, restart, status and hup

LSB methods. For internal use only

exception
    $exception = $self->exception;
    $self->exception(exception);

Gets/Sets exception value

hangup
    $hangup = $self->hangup;
    $self->hangup($hangup);

Gets/Sets hangup value

interrupt
    $interrupt = $self->interrupt;
    $self->interrupt($interrupt);

Gets/Sets interrupt value

skip
    $skip = $self->skip;
    $self->skip($skip);

Gets/Sets skip value

ok
    sub run {
        my $self = shift;
        my $logger = $self->logger;
        $logger->log_info("Code is running");

        my $step = 5;
        while ($self->ok) { # Check it every time

            # If occurred usual error:
            #    $logger->log_error("...");
            #    mysleep SLEEP;
            #    next;

            # If occurred exception error
            #    $logger->log_crit("...");
            #    $self->exception(1);
            #    last;

            # For skip this loop
            #    $self->skip(1);
            #    next;

            last unless $self->ok; # Check it every time (after loop too)
        } continue {
            CTK::Daemon::mysleep $step if $step; # Delay! For avoid fast restarts
        }

        return 1;
    }

Checks worker's state and allows next iteration in main loop

reinit_worker

ReInitialize worker

worker

Internal use only

mysleep
    mysleep(5);

Provides safety delay

myfork
    my $pid = myfork;

Provides safety forking

EXAMPLE

Classic example:

    package My::App;

    my $ctk = new CTK::App;
    my $daemon = new My::Class('testdaemon', (
        ctk         => $ctk,
        debug       => 1,
        loglevel    => "debug",
        forks       => 3,
    ));
    my $status = $daemon->ctrl("start");
    $daemon->exit_daemon($status);

    1;

    package My::Class;

    use base qw/CTK::Daemon/;

    sub new {
        my $class = shift;
        # ... your code ...
        $class->SUPER::new(shift, @_);
    }

    sub run {
        my $self = shift;
        my $logger = $self->logger;
        $logger->log_info("Code is running");

        my $step = 5;
        while ($self->ok) { # Check it every time

            # If occurred usual error:
            #    $logger->log_error("...");
            #    mysleep SLEEP;
            #    next;

            # If occurred exception error
            #    $logger->log_crit("...");
            #    $self->exception(1);
            #    last;

            # For skip this loop
            #    $self->skip(1);
            #    next;

            last unless $self->ok; # Check it every time (after loop too)
        } continue {
            CTK::Daemon::mysleep $step if $step; # Delay! For avoid fast restarts
        }

        return 1;
    }

    1;

AnyEvent example (better):

    package My::Class;

    use base qw/CTK::Daemon/;
    use AnyEvent;

    sub run {
        my $self = shift;
        my $logger = $self->logger;
        my $quit_program = AnyEvent->condvar;

        # Create watcher timer
        my $watcher = AnyEvent->timer (after => 3, interval => 3, cb => sub {
            $quit_program->send unless $self->ok;
        });

        # Create process timer
        my $timer = AnyEvent->timer(after => 3, interval => 15, cb => sub {
            $quit_program->send unless $self->ok;

            $logger->log_info("[%d] Worker is running #%d", $self->{workerident}, $self->{workerpid});

        });

        # Run!
        $quit_program->recv;

        return 1;
    }

    1;

HISTORY

1.00 Mon Feb 27 12:33:51 2017 GMT

Init version

1.01 Mon 13 May 19:53:01 MSK 2019

Moved to CTKlib project

See Changes file

DEPENDENCIES

CTK, POSIX, Sys::Syslog, Try::Tiny

TO DO

See TODO file

BUGS

* none noted

SEE ALSO

CTK, POSIX

AUTHOR

Serż Minus (Sergey Lepenkov) http://www.serzik.com <abalama@cpan.org>

COPYRIGHT

Copyright (C) 1998-2019 D&D Corporation. All Rights Reserved

Based on PVE::Daemon ideology

LICENSE

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

See LICENSE file and https://dev.perl.org/licenses