File Coverage

blib/lib/HealthCheck/Parallel.pm

Criterion	Covered	Total	%
statement	54	54	100.0
branch	23	24	95.8
condition	12	19	63.1
subroutine	12	12	100.0
pod	1	1	100.0
total	102	110	92.7

package HealthCheck::Parallel;

use v5.10;
use strict;
use warnings;

use parent 'HealthCheck';

use Carp;
use Parallel::ForkManager;

# ABSTRACT: A HealthCheck that uses parallelization for running checks
use version;
our $VERSION = 'v0.0.2'; # VERSION

sub new {
    my ( $class, %params ) = @_;

    $params{max_procs} //= 4;

    my $self = $class->SUPER::new( %params );

    $self->_validate_max_procs( $params{max_procs} );
    $self->_validate_child_init( $params{child_init} );

    return $self;
}

sub _run_checks {
    my ( $self, $checks, $params ) = @_;

    $self->_validate_max_procs( $params->{max_procs} )
        if exists $params->{max_procs};

    $self->_validate_child_init( $params->{child_init} )
        if exists $params->{child_init};

    my $max_procs  = $params->{max_procs}  // $self->{max_procs};
    my $child_init = $params->{child_init} // $self->{child_init};
    my $tempdir    = $params->{tempdir}    // $self->{tempdir};

    my @results;
    my $forker;

    if ( $max_procs > 1 ) {
        $forker = Parallel::ForkManager->new(
            $max_procs,
            $tempdir ? $tempdir : (),
        );

        $forker->run_on_finish(sub {
            my ( $pid, $exit_code, $ident, $exit_sig, $core_dump, $ret ) = @_;

            # Child process had some error.
            if ( $exit_code != 0 ) {
                $results[ $ident ] = {
                    status => 'CRITICAL',
                    info   => "Child process exited with code $exit_code.",
                };
            }
            else {
                # Keep results in the same order that they were provided.
                $results[ $ident ] = $ret->[0];
            }
        });
    }

    my $i = 0;
    for my $check ( @$checks ) {
        if ( $forker ) {
            $forker->start( $i++ ) and next;
            $child_init->() if $child_init;
        }

        my @r = $self->_run_check( $check, $params );

        $forker->finish( 0, \@r ) and next
            if $forker;

        # Non-forked process.
        push @results, @r;
    }

    $forker->wait_all_children if $forker;

    return @results;
}

sub _validate_max_procs {
    my ( $self, $max_procs ) = @_;

    croak "max_procs must be a zero or positive integer!"
        unless $max_procs =~ /^\d+$/ && $max_procs >= 0;
}

sub _validate_child_init {
    my ( $self, $child_init ) = @_;

    croak "child_init must be a code reference!"
        if defined $child_init && ref( $child_init ) ne 'CODE';
}

1;

__END__