The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
#
# DESCRIPTION:
#	Test client timeouts
#
# LICENCE:
#	GNU GPLv2

package DummyServer;
use Net::Server::Single;
use base qw(Net::Server::Single);

use Data::Dumper;
# Limit rate of reading and replying to catch timeouts
sub process_request {
    my $self = shift;
    while( read(*STDIN, my $data, 1) ) {
        #print STDERR "->$data\n";
        print $data;
        sleep 1;
    }
}

1;

package main;

use lib 't';

use strict;
use NSCATest;
use Test::More;
use Net::Server::Fork;

plan tests => 1;

my $host = 'localhost';
my $port = 7669;

my $pid = fork();
if (! $pid) {
    DummyServer->run(port => $port, background => undef, setsid => 0);
    exit;
}
sleep 1;

END { if ($pid) { print "Killing $pid\n"; kill 'TERM', $pid } };

my $data = [ 
	["hostname", "0", "Plugin output"],
	["long_output", 0, 'x' x 10240 ],
	["hostname-with-other-bits", "1", "More data to be read"],
	["hostname.here", "2", "Check that ; are okay to receive"],
	["host", "service", 0, "A good result here"],
	["host54", "service with spaces", 1, "Warning! My flies are undone!"],
	["host-robin", "service with a :)", 2, "Critical? Alert! Alert!"],
	["host-batman", "another service", 3, "Unknown - the only way to travel"],
	["long_output", "service1", 0, 'x' x 10240 ], #10K of plugin output
	['x' x 1000, 0, 'Host check with big hostname'],
	['x' x 1000, 'service OK', 0, 'Service check with big hostname'],
	['long_svc_name', 'x' x 1000, 0, 'Service check with big service name'],
	];

# When the NRD server cuts a connection we get a SIG_PIPE. Perls default is to die...
$SIG{'PIPE'} = 'IGNORE';

use NRD::Client;

eval { 
    my $client = NRD::Client->new( { timeout => 5, serializer => "plain" } );
    $client->connect( PeerAddr => "127.0.0.1", PeerPort => $port, Proto => "tcp" );
    foreach my $d ( @$data ) {
        $client->send_result( { 
            command => "result", 
            data => { 
                time => time(), 
                %{ $client->{serializer}->from_line( join("\t", @$d) ) },
            },
        } );
    }
    $client->end;
};
like( $@, qr/Timeout/, "Got timeout failure sending" );