view release on metacpan or  search on metacpan

lib/Developer/Dashboard/RuntimeManager.pm  view on Meta::CPAN

        $self->_progress_emit(
            $progress,
            {
                task_id => 'start_web',
                status  => 'failed',
                label   => 'Start dashboard web service',
            }
        ) if $attempt == $attempts || $error !~ /Address already in use|Unable to confirm dashboard web service stayed running/;
        die $error if $error !~ /Address already in use|Unable to confirm dashboard web service stayed running/;
        die $error if $attempt == $attempts;
        sleep 0.25;
    }
}

# _progress_emit($progress, $event)
# Sends one lifecycle progress event to an optional progress callback.
# Input: optional progress coderef and event hash reference.
# Output: true value.
sub _progress_emit {
    my ( $self, $progress, $event ) = @_;
    return 1 if !$progress || ref($progress) ne 'CODE';
    $progress->($event);
    return 1;
}

# _web_runtime_ready($pid, $port)
# Confirms that one reported web pid is still the active managed web process
# and that the configured listen port is actually bound, then keeps checking
# only long enough to catch an immediate post-ready crash.
# Input: process id integer and configured TCP port integer.
# Output: boolean true when the runtime exposed its listener and survived the
# short confirmation window afterwards.
sub _web_runtime_ready {
    my ( $self, $pid, $port ) = @_;
    return 0 if !defined $pid || $pid !~ /^\d+$/ || $pid < 1;
    return 0 if defined $port && $port ne '' && ( $port !~ /^\d+$/ || $port < 1 );
    my $ready_polls = 0;
    for ( 1 .. $self->_runtime_stability_polls ) {
        my $running = $self->running_web;
        my $listening = 0;
        if ( $running && ( $running->{pid} || 0 ) == $pid ) {
            my $listener_port = $port || $running->{port} || 0;
            if ($listener_port) {
                $listening = scalar $self->_listener_pids_for_port($listener_port) ? 1 : 0;
                $listening = 1 if !$listening && $self->_port_accepting_connections($listener_port);
            }
        }
        if ($listening) {
            $ready_polls++;
            return 1 if $ready_polls >= $self->_runtime_confirmation_polls;
        }
        elsif ($ready_polls) {
            return 0;
        }
        sleep $self->_runtime_poll_interval;
    }
    return 0;
}

# _collector_runtime_ready($name, $pid)
# Confirms that a newly started collector loop became visible and stayed alive
# long enough to catch an immediate post-ready crash.
# Input: collector name string and process id integer.
# Output: boolean true when the collector loop became visible and survived the
# short confirmation window afterwards.
sub _collector_runtime_ready {
    my ( $self, $name, $pid ) = @_;
    return 0 if !defined $name || $name eq '';
    return 0 if !defined $pid || $pid !~ /^\d+$/ || $pid < 1;
    my $ready_polls = 0;
    for ( 1 .. $self->_runtime_stability_polls ) {
        my $state = $self->{runner}->can('loop_state') ? $self->{runner}->loop_state($name) : undef;
        my $state_ready = $state
          && ( $state->{pid} || 0 ) == $pid
          && ( $state->{name} || $name ) eq $name
          && ( $state->{status} || '' ) =~ /^(?:starting|running|error)$/
          && kill( 0, $pid );
        my ($running) = $state_ready
          ? ()
          : grep { $_->{name} eq $name && ( $_->{pid} || 0 ) == $pid } $self->{runner}->running_loops;
        if ( $state_ready || $running ) {
            $ready_polls++;
            return 1 if $ready_polls >= $self->_runtime_confirmation_polls;
        }
        elsif ($ready_polls) {
            return 0;
        }
        sleep $self->_runtime_poll_interval;
    }
    return 0;
}

# _runtime_stability_polls()
# Returns the number of readiness polls used to prove that a replacement
# runtime had enough time to become visible before it is declared dead on
# arrival.
# Input: none.
# Output: positive integer poll count.
sub _runtime_stability_polls {
    my $override = $ENV{DEVELOPER_DASHBOARD_RUNTIME_STABILITY_POLLS};
    return $override if defined $override && $override =~ /^\d+$/ && $override > 0;

    my $perl5opt = join ' ', grep { defined && $_ ne '' } @ENV{qw(PERL5OPT HARNESS_PERL_SWITCHES)};
    return 300 if $perl5opt =~ /Devel::Cover/;

    return 100;
}

# _runtime_confirmation_polls()
# Returns the number of consecutive ready polls required after startup first
# becomes visible before the runtime is declared stable.
# Input: none.
# Output: positive integer poll count.
sub _runtime_confirmation_polls {
    my $override = $ENV{DEVELOPER_DASHBOARD_RUNTIME_CONFIRMATION_POLLS};
    return $override if defined $override && $override =~ /^\d+$/ && $override > 0;
    return 3;
}

# _runtime_poll_interval()
# Returns the sleep interval in seconds between runtime readiness polls.