view release on metacpan or  search on metacpan

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

        } 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;

=head1 HISTORY

=over 8

=item B<1.00 Mon Feb 27 12:33:51 2017 GMT>

Init version

=item B<1.01 Mon 13 May 19:53:01 MSK 2019>

Moved to CTKlib project

=back

See C<Changes> file

=head1 DEPENDENCIES

L<CTK>, L<POSIX>, L<Sys::Syslog>, L<Try::Tiny>

=head1 TO DO

See C<TODO> file

=head1 BUGS

* none noted

=head1 SEE ALSO

L<CTK>, L<POSIX>

=head1 AUTHOR

Serż Minus (Sergey Lepenkov) L<https://www.serzik.com> E<lt>abalama@cpan.orgE<gt>

=head1 COPYRIGHT

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

Based on PVE::Daemon ideology

=head1 LICENSE

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

See C<LICENSE> file and L<https://dev.perl.org/licenses>

=cut

use vars qw/$VERSION @EXPORT $DEV_DEBUG/;
$VERSION = '1.06';

use Carp;
use File::Spec;
use POSIX qw/ :sys_wait_h /;
use Try::Tiny;
use Sys::Syslog ();

use CTKx;
use CTK::Util qw/ :API :CORE /;
use CTK::ConfGenUtil;
use CTK::TFVals qw/ :ALL /;
use CTK::FilePid;
use CTK::Log;

use base qw/Exporter/;

use constant {
    SLEEP       => 60,
    STEP        => 5,
    TRIES       => 3,
    KILL_TIMEOUT=> 3, # For killing
    FORKS       => 1,
    MIN_FORKS   => 1,
    MAX_FORKS   => 255,
    LSB_COMMANDS=> [qw/start stop reload restart status/],
    SIGS_DEF    => {
            HUP     => undef,
            TERM    => undef,
            INT     => undef,
            KILL    => undef,
            QUIT    => undef,
        },
};

@EXPORT = (qw/
        mysleep myfork
    /);

$DEV_DEBUG = 0;

sub mysleep;

my $daemon_initialized = 0; # we only allow one instance

my %LOCAL_SIG;
my $sigproxy = sub { $LOCAL_SIG{shift(@_)} = 1; };

sub new {
    my $class = shift;
    my $name = shift; # Should not happen
    my %params = @_;

    # Check instance
    croak "Can't create more that one Daemon\n" if $daemon_initialized;
    $daemon_initialized = 1;

    # Check name
    croak "Can't create unnamed daemon\n" unless $name;
    croak "Incorrect daemon name: \"$name\"\n" unless $name =~ /[a-z0-9\-_.]+/i;

    # Check root permissions
    die "Please run as root\n" if $> != 0;

    my $ctk = $params{ctk} || CTKx->instance->ctk;
    croak "CTK object required\n" unless $ctk && ref($ctk);