view release on metacpan or  search on metacpan

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

=head1 COPYRIGHT

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

=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/;
$VERSION = '1.01';

use parent qw/CTK::Daemon/;

use AnyEvent;
use File::Spec;

use CTK::ConfGenUtil;
use CTK::TFVals qw/ :ALL /;
use CTK::Util qw/ preparedir dformat execute /;

use App::MonM::Const;
use App::MonM::Util qw/
        getBit setBit
        node2anode getCheckitByName
        getExpireOffset getTimeOffset
    /;
use App::MonM::Store;
use App::MonM::Checkit;
use App::MonM::QNotifier;
use App::MonM::Report;

use constant {
    START_DELAY         => 3,
    INTERVAL_CTRL       => 3,  # 3 sec
    INTERVAL_MAIN       => 20, # 20 sec
    INTERVAL_REMIND     => 60, # 1 min
    DAEMONFORKS         => 3,
    EXPIRES             => 24*60*60, # 1 day
};

eval { require App::MonM::Notifier };
my $NOTIFIER_LOADED = 1 unless $@;
$NOTIFIER_LOADED = 0 if $NOTIFIER_LOADED && (App::MonM::Notifier->VERSION * 1) < 1.04;

sub new {
    my $class = shift;
    my $name = shift;
    my %daemon_options = @_;

    # Forks (workers)
    my $forks = tv2int8($daemon_options{forks} || DAEMONFORKS);
    $daemon_options{forks} = $forks < 2 ? 2 : $forks;

    my $self = $class->SUPER::new($name, %daemon_options);

    # Create general properties
    $self->{store} = undef; # Store instance
    $self->{notifier} = undef; # Notifier instance
    $self->{checker} = undef; # Checker instance
    #print _explain($self->ctk->config);

    return $self;
}

sub init {
    my $self = shift;
    my $ctk = $self->get_ctk;
    my $logger = $self->logger; # Logger realy is exists?
    #$logger->log_debug(">> Init handler");

    # Check logger
    unless ($logger && $logger->status) {
        printf STDERR "Can't init logger: %s\n", $logger ? $logger->error : "no logger object";
        return;
    }

    # Check configuration
    my $configobj = $ctk->configobj;
    unless ($configobj->status) {
        print STDERR length($configobj->error)
            ? $configobj->error
            : "Can't load configuration file";
        return;
    }

    #print $self->ctk->datadir, "\n";
    #return $self->interrupt(1);

    return 1;
}
sub down {
    my $self = shift;
    my $logger = $self->logger; # Logger realy is exists?
    #$logger->log_info(">> Down handler");

    # Cleaning DB
    my $expire = getExpireOffset(lvalue($self->ctk->config("expires"))
        || lvalue($self->ctk->config("expire")) || EXPIRES);
    $self->store->clean(period => $expire) or do {
        $logger->log_error("Can't cleanup database: %s", $self->store->error)
            if $self->store->error;
    };

    return 1;
}
sub cleanup {
    my $self = shift;
    my $logger = $self->logger; # Logger realy is exists?

    #$logger->log_info(">> CleanUp handler");

    return 1;
}
sub reload {