view release on metacpan or  search on metacpan

t/10migration.t  view on Meta::CPAN

    {id => 12350, code => 'abcdefgm', fitness => 26,  host => 'test2'},
);
for my $id (0..@expected_results-1) {
    is($$ref[$id]{id},      $expected_results[$id]{id},      "loaded $id id right");
    is($$ref[$id]{host},    $expected_results[$id]{host},    "loaded $id host right");
    is($$ref[$id]{code},    $expected_results[$id]{code},    "loaded $id code right");
    is($$ref[$id]{fitness}, $expected_results[$id]{fitness}, "loaded $id fitness right");
}
BEGIN { $num_tests += 9*4 };


# migrate (disconnected from test server)
close($incoming);
lives_ok(sub { $population->migrate() }, 'migrate runs without server connection');
waitpid($serverpid, 0);
lives_ok(sub { $population->migrate() }, 'migrate runs without server connection');
BEGIN { $num_tests += 2 };


# by assigning one side of the socketpair to an external variable, the socket
# will stay open.  When the test script exits, the socket will be closed,
# signalling the child process to exit.
sub spawn_test_server {
    my $listener = IO::Socket::INET->new(
        Listen    => 1,
        LocalAddr => '127.0.0.1',
        Proto     => 'tcp',
        ReuseAddr => 1,
    );
    croak("can't create TCP listener socket") unless defined $listener;
    my $sock2;
    ($incoming, $sock2) = IO::Socket->socketpair(AF_UNIX, SOCK_STREAM, PF_UNSPEC);
    $serverpid = fork();
    if($serverpid) {
        close($sock2);
        my $mysockaddr = $listener->sockname();
        my ($port, $myaddr) = sockaddr_in($mysockaddr);
        return $port;
    }

    for my $fd (0..sysconf(_SC_OPEN_MAX)-1) {
        next if $fd == $listener->fileno();
        next if $fd == $sock2->fileno();
        next if $fd == STDERR->fileno();
        POSIX::close($fd);
    }
    $sock2->blocking(1);
    my $select = IO::Select->new($listener, $sock2);
    while(1) {
#        print(STDERR "sitting in select()\n");
        my @sockets = $select->can_read(10);
#        print(STDERR "select() returned " . scalar(@sockets) . "\n");
        foreach my $socket (@sockets) {
#            print(STDERR "read event from socket " . $socket->fileno() . "\n");
            exit(0) if $socket == $sock2;
            if($socket == $listener) {
#                print(STDERR "new connection\n");
                my $new = $socket->accept();
                $new->blocking(1);
                $new->print(<<EOF);
parse error
[I12345 D3 F31 Htest2\]abcdefgh
[I12346 D3 F30 Htest2\]abcdefgi
[I12347 D3 F29 Htest2\]abcdefgj
[I12348 D3 F28 Htest2\]abcdefgk
[I12349 D3 F27 Htest2\]abcdefgl
[I12350 D3 F26 Htest2\]abcdefgm
EOF
                $select->add($new);
            } else {
                my $data;
                my $rv = $socket->sysread($data, 4096);
                if($rv < 1) {
                    $select->remove($socket);
                } else {
#                    print(STDERR "got data [$data]\n");
                    $sock2->print($data);
                }
            }
        }
    }
}