1#!/usr/bin/env perl
2
3# http://rt.cpan.org/Ticket/Display.html?id=54183
4#
5# Test that the RPC::XML::Server class can handle SIGPIPE issues
6
7# Here, we don't care about the return value of eval's, because of the ALRM
8# signal handlers:
9## no critic(RequireCheckingReturnValueOfEval)
10
11use strict;
12use warnings;
13use subs qw(start_server stop_server);
14
15use Test::More;
16
17use File::Spec;
18
19use RPC::XML::Server;
20use RPC::XML::Client;
21
22my ($dir, $vol, $srv, $child, $port, $cli, $res);
23
24# This suite doesn't run on Windows, since it's based on *NIX signals
25if ($^O eq 'MSWin32' || $^O eq 'cygwin')
26{
27    plan skip_all => 'Skipping *NIX signals-based test on Windows platform';
28    exit;
29}
30
31($vol, $dir, undef) = File::Spec->splitpath(File::Spec->rel2abs($0));
32$dir = File::Spec->catpath($vol, $dir, q{});
33require File::Spec->catfile($dir, 'util.pl');
34
35$srv = RPC::XML::Server->new(host => 'localhost');
36if (! ref $srv)
37{
38    plan skip_all => "Creating server failed: $srv"
39}
40else
41{
42    plan tests => 4;
43    $port = $srv->port;
44}
45
46$cli = RPC::XML::Client->new("http://localhost:$port");
47$srv->add_method({
48    name => 'test',
49    signature => [ 'string' ],
50    code => sub {
51        my ($server) = @_;
52
53        sleep 3;
54
55        return 'foo';
56    }
57});
58
59$child = start_server $srv;
60
61eval {
62    local $SIG{ALRM} = sub { die "alarm\n" };
63    alarm 1;
64    $res = $cli->send_request('test');
65    alarm 0; # Shouldn't reach here
66};
67like($res, qr/alarm/, 'Initial request alarmed-out correctly');
68
69eval {
70    local $SIG{ALRM} = sub { die "alarm\n" };
71    alarm 6;
72    $res = $cli->send_request('test');
73    alarm 0; # Shouldn't reach here
74};
75unlike($res, qr/alarm/, 'Second request did not alarm-out');
76
77ok(ref($res) && $res->value eq 'foo', 'Second request correct value');
78
79eval {
80    local $SIG{ALRM} = sub { die "alarm\n" };
81    alarm 2;
82    $res = $cli->send_request('system.status');
83    alarm 0;
84};
85ok(ref($res) && ref($res->value) eq 'HASH', 'Good system.status return');
86
87stop_server $child, 'final';
88
89exit;
90