NAME

CTK::Daemon - Abstract class to implement Daemons

VERSION

Version 1.06

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 = CTK::Daemon->new('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
        saferun     => 0, # Set to 1 to enable safe mode for the run method calling
    ));

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, reload, cleanup

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. This code is called at startup of each forks

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

The reload() method is called at received HUP signal, this code is called at before running of each forks

The cleanup() method is called at before exit from main fork

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 = CTK::App->new;
    my $daemon = My::Class->new('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) https://www.serzik.com <abalama@cpan.org>

COPYRIGHT

Copyright (C) 1998-2022 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

cpanm CTK

perl -MCPAN -e shell
install CTK