view release on metacpan or  search on metacpan

lib/HADaemon/Control.pm  view on Meta::CPAN

    my ($self) = @_;
    $self->_main_running() != $self->_expected_main_processes() && $self->_standby_running() == $self->_expected_standby_processes()
        and $self->warn("one of main processes failed to acquire main lock, something is possibly holding it!!!");
}

sub _main_lock_fd {
    my ($self, $ipc) = @_;
    if (   exists $ipc->{main_lock}
        && exists $ipc->{main_lock}->{lock_obj}
        && exists $ipc->{main_lock}->{lock_obj}->{lock_fh})
    {
        my $fd = fileno($ipc->{main_lock}->{lock_obj}->{lock_fh});
        $self->trace("detected lock fd: $fd");
        return $fd;
    }

    $self->warn("failed to detect lock fd");
    return undef;
}

sub _reset_close_on_exec_main_lock_fd {
    my ($self, $ipc) = @_;
    if (   exists $ipc->{main_lock}
        && exists $ipc->{main_lock}->{lock_obj}
        && exists $ipc->{main_lock}->{lock_obj}->{lock_fh})
    {
        $self->info("reset close-on-exec main lock fd");
        my $fh = $ipc->{main_lock}->{lock_obj}->{lock_fh};
        my $flags = fcntl($fh, Fcntl::F_GETFD, 0) or $self->die("fcntl F_GETFD: $!");
        fcntl($fh, Fcntl::F_SETFD, $flags & ~Fcntl::FD_CLOEXEC) or $self->die("fcntl F_SETFD: $!");
    }
}

#####################################
# misc
#####################################
sub pretty_print {
    my ($self, $process_type, $message, $color) = @_;
    return if $self->quiet;

    $color //= "green"; # Green is no color.
    my $code = $self->color_map->{$color} //= 32; # Green is invalid.

    local $| = 1;
    $process_type =~ s/-/ #/;

    if ($ENV{HADC_NO_COLORS}) {
        printf("%-40s: %-40s %40s\n", $self->name, $process_type, "[$message]");
    } else {
        printf("%-40s: %-40s %40s\n", $self->name, $process_type, "\033[$code" ."m[$message]\033[0m");
    }
}

sub _log {
    my ($self, $level, $message) = @_;

    # some commands, such as help|foregournd, don't need loggin
    # so do lazy initialization
    if (not exists $self->{log_fh}) {
        open(my $fh, '>>', $self->log_file) or die "failed to open logfile '" . $self->log_file . "': $!\n";
        chown(($self->uid // -1), ($self->gid // -1), $fh) if $self->uid || $self->gid;
        $self->{log_fh} = $fh;
    }

    if ($self->{log_fh} && defined fileno($self->{log_fh})) {
        my $now = Time::HiRes::time();
        my ($sec, $ms) = split(/[.]/, $now);
        my $date = POSIX::strftime("%Y-%m-%d %H:%M:%S", localtime($now)) . sprintf('.%05d', $ms // 0);
        printf { $self->{log_fh} } "[%s][%d][%s] %s\n", $date, $$, $level, $message;
        $self->{log_fh}->flush();
    }
}

sub _print_check_log_file_for_details {
    my ($self) = @_;
    printf("check %s for details\n", $self->log_file);
}

sub _all_actions {
    my ($self) = @_; 
    no strict 'refs';
    return map { m/^do_(.+)/ ? $1 : () } keys %{ ref($self) . '::' };
}

sub _standby_timeout {
    my $timeout = int(shift->{ipc_cl_options}->{interval} // 0) * 3;
    return $timeout < 1 ? 1 : $timeout;
}

sub info { $_[0]->_log('INFO', $_[1]); }
sub trace { $ENV{HADC_TRACE} and $_[0]->_log('TRACE', $_[1]); }
sub warn { $_[0]->_log('WARN', $_[1]); warn $_[1] . "\n"; }
sub die  { $_[0]->_log('CRIT', $_[1]); die $_[1] . "\n"; }

#####################################
# init script logic
#####################################
sub _dump_init_script {
    my ( $self ) = @_;

    my $data;
    while ( my $line = <DATA> ) {
        last if $line =~ /^__END__$/;
        $data .= $line;
    }

    # So, instead of expanding run_template to use a real DSL
    # or making TT a dependancy, I'm just going to fake template
    # IF logic.
    my $init_source_file = $self->init_config
        ? $self->run_template(
            '[ -r [% FILE %] ] && . [% FILE %]',
            { FILE => $self->init_config } )
        : "";

    print $self->_run_template(
        $data,
        {
            HEADER            => 'Generated at ' . scalar(localtime) . ' with HADaemon::Control ' . ($self->VERSION // 'DEV'),
            NAME              => $self->name      // '',
            REQUIRED_START    => $self->lsb_start // '',