view release on metacpan or  search on metacpan

lib/Ubic/Watchdog.pm  view on Meta::CPAN

package Ubic::Watchdog;
$Ubic::Watchdog::VERSION = '1.60';
use strict;
use warnings;

# ABSTRACT: watchdog code


use POSIX;
use IO::Handle;
use Params::Validate qw(:all);
use Try::Tiny;
use List::MoreUtils qw(any);
use Ubic;

use Ubic::Logger;

sub run {
    my $class = shift;
    my $options = validate(@_, {
        glob_filter => { type => ARRAYREF, default => [] },
        compile_timeout => { type => SCALAR, regex => qr/^\d+$/ },
        verbose => { type => SCALAR|UNDEF },
    });

    my @filter;
    {
        for my $arg (@{ $options->{glob_filter} }) {
            $arg =~ /^[*\w.-]+$/ or die "Invalid argument '$arg', expected service name or shell-style glob";
            $arg =~ s/\./\\./g;
            $arg =~ s/\*/.*/g;
            push @filter, qr/^$arg$/;
        }
    }
    $options->{filter} = \@filter if @filter;
    delete $options->{glob_filter};

    my $self = bless $options => $class;

    my @services = $self->load_services(Ubic->root_service);
    $self->check_all(@services);
}

sub match($$) {
    my ($name, $filter) = @_;
    do {
        return 1 if $name =~ $filter;
    } while ($name =~ s/\.[^.]+$//);
    return;
}

sub load_services {
    my $self = shift;
    my ($parent) = @_;
    alarm($self->{compile_timeout});
    $SIG{ALRM} = sub {
        die "Couldn't compile $parent services in $self->{compile_timeout} seconds";
    };
    my @services = $parent->services;
    alarm(0);
    return @services;
}

sub check_all {
    my $self = shift;
    my @services = @_;
    for my $service (@services) {
        my $name = $service->full_name;
        if ($service->isa('Ubic::Multiservice')) {
            INFO("$name is multiservice, checking subservices") if $self->{verbose};
            $self->check_all($self->load_services($service));
            next;
        }
        if ($self->{filter}) {
            next unless any { match($name, $_) } @{ $self->{filter} };
        }

        # trying to get logs a little bit more ordered
        STDOUT->flush;
        STDERR->flush;

        my $child = fork;
        unless (defined $child) {
            die "fork failed";
        }
        unless ($child) {
            POSIX::setsid; # so we could kill this watchdog and its children safely later
            $self->check($service);
            exit;
        }
    }
    1 while wait() > 0;
    return;
}

sub check($) {
    my $self = shift;
    my $service = shift;