view release on metacpan or  search on metacpan

t/runner.t  view on Meta::CPAN

        'dies on missing file'
    );
};

# Test 13: Error on invalid module
subtest 'error on invalid module' => sub {
    my $runner = PAGI::Server::Runner->new;
    $runner->{argv} = ['PAGI::App::NonExistent12345'];

    like(
        dies { $runner->load_app },
        qr/Cannot find module/i,
        'dies on invalid module'
    );
};

# Test 14: Error on file that doesn't return coderef
subtest 'error on non-coderef file' => sub {
    my $tmpdir = tempdir(CLEANUP => 1);
    my $bad_app = "$tmpdir/bad_app.pl";

    # Write a file that returns a hashref instead of coderef
    open my $fh, '>', $bad_app or die "Cannot write $bad_app: $!";
    print $fh "{ foo => 'bar' };\n";
    close $fh;

    my $runner = PAGI::Server::Runner->new;
    $runner->{app_spec} = $bad_app;

    like(
        dies { $runner->load_app },
        qr/must return a coderef/i,
        'dies on non-coderef'
    );
};

# Test 15: load_server constructs the configured server class
subtest 'load_server creates server' => sub {
    my $runner = PAGI::Server::Runner->new(server => 'PAGITest::FakeServer', port => 0, quiet => 1);
    $runner->{app} = sub { };
    my $fake = $runner->load_server;

    isa_ok($fake, ['PAGITest::FakeServer'], 'load_server constructs the configured class');
    is($fake->{options}{app}, $runner->{app}, 'app passed to constructor');

    # SSL config must be forwarded unchanged — whether the server honours it
    # (cert-file validation etc.) is tested in PAGI-Server's own suite.
    my $ssl_runner = PAGI::Server::Runner->new(
        server         => 'PAGITest::FakeServer',
        quiet          => 1,
        server_options => { ssl => { cert_file => 'c', key_file => 'k' } },
    );
    $ssl_runner->{app} = sub { };
    my $ssl_fake = $ssl_runner->load_server;
    is($ssl_fake->{options}{ssl}, { cert_file => 'c', key_file => 'k' },
        'ssl config passed through unchanged');
};

# Tests 16-19 (load_server dies without app, integration: server responds to
# requests, integration: module-based app serves files, SSL options validation)
# have been relocated to the PAGI-Server distribution because they exercise
# PAGI::Server internals or require a real socket.  Saved verbatim to
# /tmp/pagi-moved-subtests.pl for that relocation task.

# Test 20: help flag
subtest 'help flag sets show_help' => sub {
    my $runner = PAGI::Server::Runner->new;
    $runner->parse_options('--help');

    ok($runner->{show_help}, 'show_help is set');
};

# Test 21: production CLI options parsing
subtest 'production CLI options parsing' => sub {
    my $runner = PAGI::Server::Runner->new;
    $runner->parse_options(
        '-D',
        '--pid', '/tmp/test.pid',
        '--user', 'nobody',
        '--group', 'nogroup',
    );

    is($runner->{daemonize}, 1, '--daemonize parsed');
    is($runner->{pid_file}, '/tmp/test.pid', '--pid parsed');
    is($runner->{user}, 'nobody', '--user parsed');
    is($runner->{group}, 'nogroup', '--group parsed');
};

# Test 22: _drop_privileges validation
subtest '_drop_privileges validation' => sub {
    # Skip on Windows - getpwnam/getgrnam not available
    if ($^O eq 'MSWin32') {
        skip_all 'User/group privilege tests not supported on Windows';
    }

    # Test 1: Returns early if neither user nor group specified
    my $runner1 = PAGI::Server::Runner->new(port => 0, quiet => 1);
    ok(lives { $runner1->_drop_privileges }, '_drop_privileges returns early when no user/group');

    # Test 2: Requires root for --user
    my $runner2 = PAGI::Server::Runner->new(
        user => 'nobody',
        port => 0,
        quiet => 1,
    );

    if ($> == 0) {
        # Running as root - test should validate user exists
        my $runner3 = PAGI::Server::Runner->new(
            user => 'nonexistent_user_12345',
            port => 0,
            quiet => 1,
        );
        like(
            dies { $runner3->_drop_privileges },
            qr/Unknown user/,
            'rejects unknown user (as root)'
        );
    } else {
        # Not root - should require root
        like(
            dies { $runner2->_drop_privileges },
            qr/Must run as root/,