IPC-Manager

 view release on metacpan or  search on metacpan

lib/IPC/Manager/Test.pm  view on Meta::CPAN

    is($resp2->{response}, 'ok', "Service survived on_general_message exception");

    # 4) handle_request: send a request that throws — should get an error response
    my $err_resp = $handle->sync_request(ie_svc => 'crash');
    ok($err_resp->{ipcm_error}, "Got error response from crashing request");
    like($err_resp->{ipcm_error}, qr/request boom/, "Error response contains exception details");
    ok(!defined $err_resp->{response}, "Response is undef on error");

    # 5) Service still works after all the exceptions
    my $resp3 = $handle->sync_request(ie_svc => 'ping');
    is($resp3->{response}, 'ok', "Service still alive after all intercepted errors");

    $handle = undef;
}

sub test_watch_pids {
    # Verifies that a service terminates when a watched PID exits.
    # Uses watch_pids => [$$] by watching the parent.  The parent forks a
    # temporary child to own the IPC bus while the service runs; the parent
    # then exits that scope so the service sees the pid die.

lib/IPC/Manager/Test.pm  view on Meta::CPAN

    is($resp->{response}, 'ok', "Normal request succeeds");
    ok(!$resp->{ipcm_error}, "No error on normal request");

    # Crashing request returns a generic error (default: expose_error_details off)
    my $err_resp = $handle->sync_request(err_generic_svc => 'crash');
    ok($err_resp->{ipcm_error}, "Error response has ipcm_error flag");
    is($err_resp->{ipcm_error}, 'Internal service error', "Error message is generic");
    unlike($err_resp->{ipcm_error}, qr/secret/, "Internal details not exposed");
    ok(!defined $err_resp->{response}, "Response is undef on error");

    # Service is still alive after the error
    my $resp2 = $handle->sync_request(err_generic_svc => 'hello');
    is($resp2->{response}, 'ok', "Service still works after error");

    $handle = undef;
}

sub test_request_error_detailed {
    my $handle = ipcm_service(
        'err_detail_svc',
        class                => 'IPC::Manager::Service',

lib/IPC/Manager/Test.pm  view on Meta::CPAN

            return "ok";
        },
    );

    # Crashing request returns the actual exception text
    my $err_resp = $handle->sync_request(err_detail_svc => 'crash');
    ok($err_resp->{ipcm_error}, "Error response has ipcm_error flag");
    like($err_resp->{ipcm_error}, qr/detailed failure info/, "Error exposes exception details");
    ok(!defined $err_resp->{response}, "Response is undef on error");

    # Service is still alive
    my $resp = $handle->sync_request(err_detail_svc => 'hello');
    is($resp->{response}, 'ok', "Service still works after detailed error");

    $handle = undef;
}

sub test_post_fork_hook {
    # Verifies that the post_fork_hook allows a double-fork pattern where the
    # middle process goes off to do its own work and the grandchild becomes
    # the service.

lib/IPC/Manager/Test.pm  view on Meta::CPAN

    # Verify the response came from the grandchild
    like($resp->{response}, qr/^pfh_\d+$/, "Response includes a PID");
    is($resp->{response}, "pfh_$svc_pid", "Response came from the grandchild service process");

    # Reap the middle process so it doesn't linger as a zombie
    waitpid($middle_pid, 0) if $middle_pid;

    # child_pid on the handle is the first-fork pid from ipcm_service.
    # In this daemonize case that is the middle process, which has now
    # exited - so it is no longer alive.
    my $cpid = $handle->child_pid;
    ok($cpid, "Handle carries a child_pid");
    is($cpid, $middle_pid, "child_pid == first-fork (middle) pid");
    ok(!kill(0, $cpid), "First-fork pid no longer alive after daemonize");

    $handle = undef;
}

sub test_child_pid {
    # Basic accessor: handle returned by ipcm_service carries the
    # first-fork pid, and it is alive while the service is up.

    my $handle = ipcm_service(
        'child_pid_svc',
        class          => 'IPC::Manager::Service',
        handle_request => sub { return "ok" },
    );

    my $cpid = $handle->child_pid;
    ok($cpid, "Handle has child_pid");
    like($cpid, qr/^\d+$/, "child_pid is a positive integer");
    ok(kill(0, $cpid), "child_pid is alive while service is up");

    # No post_fork_hook: first-fork pid == service pid
    is($handle->service_pid, $cpid, "child_pid == service_pid (no post_fork_hook)");

    $handle = undef;
}

sub test_child_pid_nested {
    # Nested ipcm_service from inside a running service should also
    # stamp child_pid onto the peer it returns.

lib/IPC/Manager/Test.pm  view on Meta::CPAN

    require IPC::Manager::Service::Handle;
    my $h = IPC::Manager::Service::Handle->new(
        service_name => 'nope',
        ipcm_info    => 'fake',
    );
    is($h->child_pid, undef, "Bare handle has undef child_pid");
}

sub test_child_pid_interpose {
    # post_fork_hook interpose pattern: first-fork pid stays alive as
    # the long-lived "wrapper", and a deeper fork runs the service loop.
    # child_pid should equal the wrapper (first-fork) pid, and that pid
    # should stay alive as long as the service is up.

    my $marker_dir   = File::Temp::tempdir(CLEANUP => 1);
    my $wrapper_file = File::Spec->catfile($marker_dir, 'wrapper_pid');
    my $service_file = File::Spec->catfile($marker_dir, 'service_pid');

    my $handle = ipcm_service(
        'cp_interpose_svc',
        class => 'IPC::Manager::Service',

        post_fork => sub {
            my $self = shift;

            my $pid = fork // die "Could not fork in post_fork: $!";

            if ($pid) {
                # Wrapper: record our pid, stay alive, wait for service to exit.
                open my $fh, '>', $wrapper_file or die "open: $!";
                print $fh "$$\n";
                close $fh;
                waitpid($pid, 0);
                POSIX::_exit(0);
            }

            # Deeper child: return to become the service
        },

lib/IPC/Manager/Test.pm  view on Meta::CPAN

    chomp(my $wrapper_pid = <$wfh>);
    close $wfh;

    open my $sfh, '<', $service_file or die "open: $!";
    chomp(my $svc_pid = <$sfh>);
    close $sfh;

    my $cpid = $handle->child_pid;
    is($cpid, $wrapper_pid, "child_pid == wrapper (first-fork) pid");
    isnt($cpid, $svc_pid, "Wrapper pid differs from service pid");
    ok(kill(0, $cpid), "Wrapper pid alive while service is up");

    $handle = undef;
}

1;

__END__

=pod

lib/IPC/Manager/Test.pm  view on Meta::CPAN

=item IPC::Manager::Test->test_child_pid_unset

Tests that C<child_pid> is C<undef> on a handle constructed outside the
C<ipcm_service> spawn path.

=item IPC::Manager::Test->test_child_pid_interpose

Tests the interpose C<post_fork_hook> pattern: the parent becomes a
long-lived wrapper and the deeper child runs the service loop.  Verifies
C<child_pid> equals the wrapper pid, differs from the service pid, and that
the wrapper pid stays alive for as long as the service is up.

=back

=head1 SOURCE

The source code repository for IPC::Manager can be found at
L<https://github.com/exodist/IPC-Manager>.

=head1 MAINTAINERS

t/unit/peer_active_timeout.t  view on Meta::CPAN

alarm 30;

{
    package TestPeerReady::MockClient;
    use parent -norequire, 'IPC::Manager::Client';

    # Instance-level toggles so tests can flip state mid-call via SIGALRM.
    sub new {
        my ($class, %args) = @_;
        my $self = {
            alive    => 0,
            peer_pid => $$,     # use our own pid so pid_is_running returns 1
            pid      => $$,     # satisfy pid_check in disconnect
            want_peer_change_handles => 0,
            %args,
        };
        return bless $self, $class;
    }

    sub peer_pid                     { $_[0]->{alive} ? $_[0]->{peer_pid} : 0 }
    sub have_handles_for_peer_change { $_[0]->{want_peer_change_handles} }
    sub handles_for_peer_change      { () }
    sub reset_handles_for_peer_change { }
    sub disconnect                   { }
    sub write_stats                  { }
    sub activate_peer                { $_[0]->{alive} = 1 }
}

subtest 'no timeout = one-shot behavior (backward compat)' => sub {
    my $c = TestPeerReady::MockClient->new;
    is($c->peer_active('foo'), 0, "inactive one-shot returns 0");

    $c->activate_peer;
    is($c->peer_active('foo'), 1, "active one-shot returns 1");
};

subtest 'positive timeout: returns immediately when peer is already active' => sub {
    my $c = TestPeerReady::MockClient->new(alive => 1);

    my $start = time;
    my $got = $c->peer_active('foo', 5);
    my $elapsed = time - $start;

    ok($got, "returns truthy when peer is active");
    ok($elapsed < 0.5, "returned quickly (${elapsed}s)");
};

subtest 'positive timeout: returns 0 after timeout when peer never becomes active' => sub {

t/unit/sync_request_peer_death.t  view on Meta::CPAN

# 30s rather than hanging the harness forever.
local $SIG{ALRM} = sub { die "test timed out after 30s\n" };
alarm 30;

{
    package TestPeerDeath::MockClient;

    sub new {
        my ($class, %args) = @_;
        my $self = {
            alive    => 1,
            peer_pid => 99999,
            %args,
        };
        return bless $self, $class;
    }

    sub suspend_supported       { 0 }
    sub peer_exists             { $_[0]->{alive} ? 1 : 0 }
    sub peer_pid                { $_[0]->{peer_pid} }
    sub pid_is_running          { $_[0]->{alive} ? 1 : 0 }
    sub peer_active             { $_[0]->{alive} ? 1 : 0 }
    sub have_handles_for_select { 0 }
    sub handles_for_select      { () }
    sub get_messages            { () }
    sub send_message            { }
    sub disconnect              { }

    sub die_now { $_[0]->{alive} = 0 }
}

subtest 'await_response croaks when peer dies' => sub {
    my $client = TestPeerDeath::MockClient->new;

    my $h = IPC::Manager::Service::Handle->new(
        service_name => 'my-svc',
        ipcm_info    => 'fake_info',
        client       => $client,
        interval     => 0.01,

t/unit/sync_request_peer_suspend.t  view on Meta::CPAN

use IPC::Manager::Service::Handle;

local $SIG{ALRM} = sub { die "test timed out after 30s\n" };
alarm 30;

{
    package TestSuspend::SuspendableClient;

    # Mimics a protocol that supports suspend/reconnect.  Tests control
    # peer state via alive / registered flags.  peer_exists stays true
    # until the peer is fully unregistered, mirroring Base::FS.

    sub new {
        my ($class, %args) = @_;
        my $self = {
            suspend_supported => 1,
            alive             => 1,         # pidfile present + pid running
            registered        => 1,         # path/row present
            peer_pid          => 99999,
            %args,
        };
        return bless $self, $class;
    }

    sub suspend_supported       { $_[0]->{suspend_supported} }
    sub peer_exists             { $_[0]->{registered} }
    sub peer_pid                { $_[0]->{alive} ? $_[0]->{peer_pid} : 0 }
    sub pid_is_running          { $_[0]->{alive} ? 1 : 0 }
    sub peer_active             { $_[0]->{alive} ? 1 : 0 }
    sub have_handles_for_select { 0 }
    sub handles_for_select      { () }
    sub get_messages            { () }
    sub send_message            { }
    sub disconnect              { }

    sub suspend_peer    { $_[0]->{alive} = 0 }
    sub unregister_peer { $_[0]->{alive} = 0; $_[0]->{registered} = 0 }
    sub resume_peer_as  { $_[0]->{alive} = 1; $_[0]->{peer_pid} = $_[1] }
}

# await_response has no timeout parameter yet in this commit; we assert the
# "keeps waiting" cases by setting a short local alarm and verifying that
# the ALRM handler's die — not a 'went away' croak — is what terminated
# the call.
sub await_waits {
    my ($h, $id) = @_;

    my $err;

t/unit/sync_request_timeout.t  view on Meta::CPAN

use IPC::Manager::Service::Handle;

# Fail-safe so a regression doesn't hang the harness.
local $SIG{ALRM} = sub { die "test timed out after 30s\n" };
alarm 30;

{
    package TestTimeout::MockClient;

    # Use our own pid so the real kill(0, $pid) in await_response always
    # reports the peer as alive; that isolates these tests to the timeout
    # behavior specifically.
    sub new {
        my ($class, %args) = @_;
        return bless {peer_pid => $$, %args}, $class;
    }

    sub suspend_supported       { 0 }
    sub peer_exists             { 1 }
    sub peer_pid                { $_[0]->{peer_pid} }
    sub pid_is_running          { 1 }
    sub peer_active             { 1 }
    sub have_handles_for_select { 0 }
    sub handles_for_select      { () }
    sub get_messages            { () }
    sub send_message            { }
    sub disconnect              { }
}

subtest 'sync_request with timeout croaks when peer is alive but never responds' => sub {
    my $h = IPC::Manager::Service::Handle->new(
        service_name => 'my-svc',
        ipcm_info    => 'fake_info',
        client       => TestTimeout::MockClient->new,
        interval     => 0.05,
    );

    my $start = time;
    my $err = dies { $h->sync_request(peer1 => 'hello', 0.5) };
    my $elapsed = time - $start;

    like($err, qr/timed out/, "croaks with timeout message");
    ok($elapsed >= 0.4, "waited at least close to the timeout (got ${elapsed}s)");
    ok($elapsed < 5,    "did not wait much past the timeout (got ${elapsed}s)");
};

subtest 'await_response with timeout croaks when peer is alive but never responds' => sub {
    my $h = IPC::Manager::Service::Handle->new(
        service_name => 'my-svc',
        ipcm_info    => 'fake_info',
        client       => TestTimeout::MockClient->new,
        interval     => 0.05,
    );

    my $id = $h->send_request(peer1 => 'hello');
    like(
        dies { $h->await_response($id, 0.3) },