view release on metacpan or  search on metacpan

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

    }

    return {
        name      => $name,
        exit_code => $exit_code,
        stdout    => $stdout,
        stderr    => $stderr,
        timed_out => $timed_out ? 1 : 0,
    };
}

# _materialize_indicator_state(%args)
# Renders TT-backed collector indicator fields into their live persisted values.
# Input: collector job hash, normalized indicator hash, and stdout text.
# Output: normalized indicator hash reference with rendered live values.
sub _materialize_indicator_state {
    my ( $self, %args ) = @_;
    my $job       = $args{job}       || die 'Missing collector job';
    my $indicator = $args{indicator} || die 'Missing indicator payload';
    my %materialized = %{$indicator};

    if ( defined $materialized{icon_template} && $materialized{icon_template} ne '' ) {
        $materialized{icon} = $self->_render_indicator_icon_template(
            collector_name => $job->{name},
            template       => $materialized{icon_template},
            stdout         => $args{stdout},
        );
    }

    return \%materialized;
}

# _render_indicator_icon_template(%args)
# Renders one collector indicator icon TT template against stdout JSON.
# Input: collector_name string, TT template string, and stdout JSON text.
# Output: rendered icon string.
sub _render_indicator_icon_template {
    my ( $self, %args ) = @_;
    my $collector_name = $args{collector_name} || die 'Missing collector name';
    my $template_text  = $args{template}       || die 'Missing indicator icon template';
    my $vars = $self->_indicator_template_vars(
        collector_name => $collector_name,
        stdout         => $args{stdout},
    );
    my $tt = Template->new();
    my $rendered = '';
    $tt->process( \$template_text, $vars, \$rendered )
      or die sprintf "Collector '%s' indicator icon template failed: %s\n", $collector_name, $tt->error();
    return $rendered;
}

# _indicator_template_vars(%args)
# Decodes collector stdout JSON into the TT variable set for indicator
# templates.
# Input: collector_name string and stdout JSON text.
# Output: hash reference of template variables.
sub _indicator_template_vars {
    my ( $self, %args ) = @_;
    my $collector_name = $args{collector_name} || die 'Missing collector name';
    my $stdout = defined $args{stdout} ? $args{stdout} : '';
    my $decoded = eval { json_decode($stdout) };
    if ($@) {
        my $error = "$@";
        $error =~ s/\s+\z//;
        die sprintf "Collector '%s' indicator icon template requires collector stdout JSON: %s\n", $collector_name, $error;
    }

    my %vars = ( data => $decoded );
    if ( ref($decoded) eq 'HASH' ) {
        %vars = ( %vars, %{$decoded} );
    }
    return \%vars;
}

# _append_error_text($stderr, $error)
# Appends one explicit runtime error line to captured stderr text.
# Input: existing stderr text and error text string.
# Output: merged stderr text string.
sub _append_error_text {
    my ( $self, $stderr, $error ) = @_;
    $stderr = '' if !defined $stderr;
    $error  = '' if !defined $error;
    return $stderr if $error eq '';
    $stderr .= "\n" if $stderr ne '' && $stderr !~ /\n\z/;
    return $stderr . $error . "\n";
}

# _collector_source($job)
# Resolves whether a collector should execute shell command text or Perl code.
# Input: collector job hash reference.
# Output: list of execution mode string and source text string.
sub _collector_source {
    my ( $self, $job ) = @_;
    return ( 'command', $job->{command} ) if defined $job->{command} && $job->{command} ne '';
    return ( 'code', $job->{code} ) if defined $job->{code} && $job->{code} ne '';
    my $name = ref($job) eq 'HASH' ? ( $job->{name} || '(unnamed)' ) : '(unnamed)';
    die "Collector '$name' missing command or code";
}

# _run_job(%args)
# Dispatches collector execution to shell-command or Perl-code mode.
# Input: mode string, source text, cwd path, env hash, and timeout_ms.
# Output: list of stdout, stderr, exit_code, and timed_out flag.
sub _run_job {
    my ( $self, %args ) = @_;
    my $mode = $args{mode} || die 'Missing collector mode';
    return $self->_run_command(%args) if $mode eq 'command';
    return $self->_run_code(%args) if $mode eq 'code';
    die "Unknown collector mode '$mode'";
}

# start_loop($job)
# Starts a managed collector loop for interval or cron schedules.
# Input: collector job hash reference.
# Output: existing or newly forked collector pid integer.
sub start_loop {
    my ( $self, $job ) = @_;
    my $interval = $self->_effective_interval_seconds($job);
    my $configured_interval = defined $job->{interval} ? $job->{interval} : 30;
    my $name = $job->{name} || die 'Collector job missing name';
    my $schedule_mode = $job->{schedule} || ( $job->{cron} ? 'cron' : $job->{interval} ? 'interval' : 'manual' );
    die "Collector '$name' uses manual schedule and should be run on demand" if $schedule_mode eq 'manual';
    my $pidfile = $self->_pidfile($name);
    my $title   = $self->_process_title($name);

    if ( -f $pidfile ) {
        my $pid = _slurp($pidfile);
        chomp $pid;
        if ( $pid && $self->_is_managed_loop( $pid, $name ) ) {
            $self->_write_loop_state(

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

        next if !$pid;
        chomp $pid;
        if ( $pid && $self->_reap_child_process($pid) ) {
            $self->_cleanup_loop_files($name);
            next;
        }
        my $same_namespace = $pid ? $self->_same_pid_namespace($pid) : 0;
        if ( $pid && $same_namespace && ( $self->_is_managed_loop( $pid, $name ) || $self->_state_confirms_managed_loop( $name, $pid ) ) ) {
            push @running, { name => $name, pid => $pid, state => scalar $self->loop_state($name) };
            next;
        }
        next if $pid && !$same_namespace;
        $self->_cleanup_loop_files($name);
    }
    closedir $dh;

    my @sorted = @running;
    @sorted = sort _sort_loop_names @sorted;
    return @sorted;
}

# _state_active_worker_pids($name)
# Reads the persisted loop metadata for one collector and extracts any active
# worker pid list recorded by the loop process itself.
# Input: collector name string.
# Output: sorted list of numeric active worker pids.
sub _state_active_worker_pids {
    my ( $self, $name ) = @_;
    return () if !defined $name || $name eq '';
    my $state = eval { $self->loop_state($name) };
    return () if ref($state) ne 'HASH';
    my $active = $state->{active_worker_pids};
    return () if ref($active) ne 'ARRAY';
    my %seen;
    return sort { $a <=> $b } grep { defined && /^\d+$/ && $_ > 0 && !$seen{$_}++ } @{$active};
}

# _sort_loop_names()
# Sort callback for managed loop metadata rows by collector name.
# Input: package globals $a and $b containing loop hash references.
# Output: string comparison integer suitable for Perl sort.
sub _sort_loop_names {
    return $a->{name} cmp $b->{name};
}

# loop_state($name)
# Loads persisted loop state metadata for a collector.
# Input: collector name string.
# Output: state hash reference or undef.
sub loop_state {
    my ( $self, $name ) = @_;
    my $file = $self->_statefile($name);
    return if !-f $file;
    my $last_error = '';
    for ( 1 .. 3 ) {
        open my $fh, '<', $file or die "Unable to read $file: $!";
        local $/;
        my $payload = scalar <$fh>;
        close $fh;
        if ( defined $payload && $payload ne '' ) {
            my $decoded = eval { json_decode($payload) };
            return $decoded if $decoded;
            $last_error = $@ || 'Unable to decode loop state JSON';
        }
        else {
            $last_error = "Loop state file $file was empty";
        }
        sleep 0.01 if $_ < 3;
    }
    die $last_error;
}

# _pidfile($name)
# Returns the pidfile path for a collector loop.
# Input: collector name string.
# Output: file path string.
sub _pidfile {
    my ( $self, $name ) = @_;
    return File::Spec->catfile( $self->{paths}->collectors_root, "$name.pid" );
}

# _statefile($name)
# Returns the loop state file path for a collector loop.
# Input: collector name string.
# Output: file path string.
sub _statefile {
    my ( $self, $name ) = @_;
    return File::Spec->catfile( $self->{paths}->collector_dir($name), 'loop.json' );
}

# _process_title($name)
# Builds the managed process title string for a collector loop.
# Input: collector name string.
# Output: process title string.
sub _process_title {
    my ( $self, $name ) = @_;
    return "dashboard collector: $name";
}

# _is_managed_loop($pid, $name)
# Checks whether a pid belongs to a managed collector loop.
# Input: process id integer and collector name string.
# Output: boolean managed flag.
sub _is_managed_loop {
    my ( $self, $pid, $name ) = @_;
    return 0 if !$pid || !kill 0, $pid;
    return 0 if !$self->_same_pid_namespace($pid);
    my $marker = $self->_read_process_env_marker( $pid, 'DEVELOPER_DASHBOARD_LOOP_NAME' );
    return 1 if defined $marker && $marker eq $name;
    my $title = $self->_read_process_title($pid);
    return 0 if !defined $title || $title eq '';
    return $title eq $self->_process_title($name) ? 1 : 0;
}

# _state_confirms_managed_loop($name, $pid)
# Confirms a managed collector loop from persisted loop-state metadata when the
# process marker or title is not observable yet.
# Input: collector name string and process id integer.
# Output: boolean managed flag.
sub _state_confirms_managed_loop {
    my ( $self, $name, $pid ) = @_;
    return 0 if !defined $name || $name eq '';