File: SpawnRedisTimeoutServer.pm

package info (click to toggle)
libredis-fast-perl 0.22%2Bdfsg-1
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 488 kB
  • sloc: perl: 2,539; makefile: 3
file content (33 lines) | stat: -rw-r--r-- 805 bytes parent folder | download | duplicates (4)
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
package    # Hide from PAUSE
  Test::SpawnRedisTimeoutServer;

use strict;
use warnings;
use Test::TCP;

sub create_server_with_timeout {
    my $timeout = shift;

    Test::TCP->new(
        code => sub {
            my $port   = shift;
            my $socket = IO::Socket::INET->new(
                Listen    => 5,
                Timeout   => 1,
                Reuse     => 1,
                Blocking  => 1,
                LocalPort => $port
            ) or die "failed to connect to RedisTimeoutServer: $!";

            my $buffer;
            while (1) {
                my $client = $socket->accept();
                if (defined (my $got = <$client>)) {
                    sleep $timeout;
                    $client->print("+42\r\n");
                }
            }
        },
    );
}
1;