#!perl
plan(
skip_all
=>
"LWP::UserAgent 6.04 does not know how to time out, "
.
"see RT #81799"
)
if
$LWP::UserAgent::VERSION
eq
'6.04'
;
my
$server
= IO::Socket::INET->new(
Type
=> SOCK_STREAM,
Reuse
=> 1,
Listen
=> 10,
) or
die
"Could not set up TCP server: $@"
;
my
$port
=
$server
->sockport;
my
$pid
=
fork
;
die
"cannot fork: $!"
unless
defined
$pid
;
if
( 0 ==
$pid
) {
my
$rt
= RT::Client::REST->new(
timeout
=> 2,
);
try
{
$rt
->_submit(
"ticket/1"
,
"aaaa"
,
{
user
=>
'a'
,
pass
=>
'b'
,
}
);
}
catch
{
die
$_
unless
blessed
$_
&&
$_
->can(
'rethrow'
);
if
(
$_
->isa(
'RT::Client::REST::RequestTimedOutException'
) ) {
}
else
{
$_
->rethrow;
}
};
exit
0;
}
plan
tests
=> 3;
my
$buf
;
my
$client
=
$server
->
accept
;
my
$data
;
while
(<
$client
>) {
$data
.=
$_
;
}
unlike(
$data
,
qr/ARRAY\(/
,
"Avoid stringify objects when sending a request"
);
SKIP: {
skip
"Self-tests only for release testing"
, 2
unless
$ENV
{RELEASE_TESTING};
my
$kid
=
waitpid
$pid
, 0;
is(
$kid
,
$pid
,
"self-test: we reaped process correctly"
);
is( $?, 0,
"self-test: child process ran successfully"
);
}