view release on metacpan or  search on metacpan

t/11-coverage-closure.t  view on Meta::CPAN

like( $script_page->canonical_instruction, qr/^CODE1:\s+print 1;/m, 'page document serializes valid meta code entries only' );

my $legacy_nested = Developer::Dashboard::PageDocument->new(
    id    => 'legacy-nested',
    title => 'Legacy Nested',
    state => {
        list => [ 'a', 'b' ],
        map  => { one => 1 },
    },
    meta => { source_format => 'legacy' },
);
like( $legacy_nested->canonical_instruction, qr/list => \[/, 'legacy instruction serializes array stash values' );
like( $legacy_nested->canonical_instruction, qr/map => \{/, 'legacy instruction serializes hash stash values' );

my $form_page = Developer::Dashboard::PageDocument->new(
    id     => 'form-page',
    title  => 'Form Page',
    layout => {
        body    => 'body',
        form    => '<form>FORM</form>',
        form_tt => '<div>FORMTT</div>',
    },
    meta => {
        runtime_errors => ['runtime failure'],
    },
);
my $form_html = $form_page->render_html( page_url => '/app/form-page' );
unlike( $form_html, qr/<form>FORM<\/form>/, 'page render ignores removed FORM blocks' );
unlike( $form_html, qr/<div>FORMTT<\/div>/, 'page render ignores removed FORM.TT blocks' );
like( $form_html, qr/runtime-error/, 'page render includes runtime error markup' );

my $saved_page = Developer::Dashboard::PageDocument->new(
    id          => 'saved-page',
    title       => 'Saved Page',
    layout      => { body => 'saved body' },
    actions     => [
        { id => 'alias-run', kind => 'command', command => 'printf alias-ok', cwd => 'home' },
    ],
    permissions => {},
);
$pages->save_page($saved_page);
my $alias_result = $actions->run_page_action(
    action => $saved_page->as_hash->{actions}[0],
    page   => $saved_page,
    source => 'saved',
);
like( $alias_result->{stdout}, qr/alias-ok/, 'action runner resolves named cwd aliases' );

my $background_result = $actions->run_command_action(
    command    => 'printf background-ok',
    cwd        => $repo,
    background => 1,
    timeout_ms => 1000,
);
ok( $background_result->{pid} > 0, 'background action forks a child process' );
waitpid( $background_result->{pid}, 0 );
ok( !kill( 0, $background_result->{pid} ), 'background action child exits cleanly after running' );

ok(
    !$actions->_is_action_trusted(
        action => { id => 'blocked' },
        page   => Developer::Dashboard::PageDocument->new( permissions => { allow_untrusted_actions => 1, trusted_actions => ['other'] } ),
        source => 'transient',
    ),
    'action runner rejects transient actions missing from trusted_actions allowlist',
);
ok(
    !$actions->_is_action_trusted(
        action => { id => 'blocked' },
        page   => Developer::Dashboard::PageDocument->new( permissions => { allow_untrusted_actions => 1 } ),
        source => 'transient',
    ),
    'action runner rejects transient actions without a trusted_actions array',
);

my $collector = Developer::Dashboard::Collector->new( paths => $paths );
my $indicators = Developer::Dashboard::IndicatorStore->new( paths => $paths );
my $runner = Developer::Dashboard::CollectorRunner->new(
    collectors => $collector,
    files      => $files,
    indicators => $indicators,
    paths      => $paths,
);

my $collector_result = $runner->run_once(
    {
        name      => 'coverage.collector',
        command   => 'printf collector-ok',
        cwd       => 'home',
        interval  => 2,
        indicator => { name => 'coverage.collector', icon => 'C' },
    }
);
is( $collector_result->{exit_code}, 0, 'collector runner executes collector jobs from named cwd aliases' );
is( $indicators->get_indicator('coverage.collector')->{prompt_visible}, 1, 'collector indicator defaults prompt visibility to true' );
my $collector_code_result = $runner->run_once(
    {
        name      => 'coverage.collector.code',
        code      => q{return 0;},
        cwd       => 'home',
        interval  => 2,
        indicator => { name => 'coverage.collector.code', icon => 'K' },
    }
);
is( $collector_code_result->{exit_code}, 0, 'collector runner executes perl code collectors from named cwd aliases' );
ok( $runner->_job_is_due( { schedule => 'cron', cron => '* * * * *' }, 'coverage.collector' ), 'collector runner treats cron jobs as due on first slot' );
ok( !$runner->_cron_due( 'bogus', 'coverage.collector' ), 'collector runner rejects invalid cron expressions' );
my @now = localtime();
my $current_cron = join ' ', $now[1], $now[2], $now[3], $now[4] + 1, $now[6];
ok( $runner->_cron_due( $current_cron, 'coverage.collector.explicit' ), 'collector runner accepts explicit matching cron slots' );
ok( !$runner->_cron_due( $current_cron, 'coverage.collector.explicit' ), 'collector runner de-duplicates repeated explicit cron slots' );
ok( Developer::Dashboard::CollectorRunner::_cron_match( '1-5', 3 ), 'collector runner cron matcher supports numeric ranges' );

my $runtime = Developer::Dashboard::PageRuntime->new;
my $runtime_page = Developer::Dashboard::PageDocument->new(
    id    => 'runtime-page',
    title => 'Runtime Page',
    state => { alpha => 'one' },
    meta  => {
        codes => [
            { id => 'CODE1', body => 'print "OUT"; return { beta => "two" };' },
        ],
    },
);
my $runtime_result = $runtime->run_code_blocks( page => $runtime_page, source => 'saved' );
is( $runtime_page->as_hash->{state}{beta}, 'two', 'page runtime merges returned hash values into page state' );
like( join( '', @{ $runtime_result->{outputs} } ), qr/OUT/, 'page runtime captures printed output' );
like( join( '', @{ $runtime_result->{outputs} } ), qr/beta => 'two'/, 'page runtime dumps returned hash values into runtime output' );
unlike( join( '', @{ $runtime_result->{outputs} } ), qr/OUT1/, 'page runtime does not append Perl print return values to output' );