-
Notifications
You must be signed in to change notification settings - Fork 0
/
test-test-tcp.pl
executable file
·47 lines (35 loc) · 960 Bytes
/
test-test-tcp.pl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
#!/usr/bin/env perl
use Test::TCP;
use IO::Pipe;
use Net::HTTPServer;
our $pipe = IO::Pipe->new();
test_tcp(
server => sub {
my $port = shift;
$pipe->writer;
print 'server: port = ' . $port . "\n";
print 'server: pid = ' . $$ . "\n";
sleep 5;
my $server = Net::HTTPServer->new(
port => $port,
docroot => undef,
log => 'STDOUT'
);
$server->Start();
$server->Process(15);
print $pipe "SERVER BLABLABLA\n";
sleep 10;
$server->Stop();
},
client => sub {
my ( $port, $server_pid ) = @_;
$pipe->reader;
my $msg = <$pipe>;
chomp $msg;
print 'client: port = ' . $port . "\n";
print 'client: pid = ' . $$ . "\n";
print 'client: server sent msg (' . $msg . ")\n";
waitpid( $server_pid, 0 );
print "client: bailing out...\n";
},
);