view release on metacpan or  search on metacpan

t/sukkal.t  view on Meta::CPAN

#!perl
use 5.006;
use strict;
use warnings;
use Test::More;

BEGIN {
	plan skip_all => 'unix domain sockets and fork required'
		if $^O eq 'MSWin32';
}

use File::Temp qw(tempdir);
use IO::Socket::UNIX;
use Socket      qw(SOCK_STREAM);
use POSIX       ();
use Time::HiRes qw(sleep);
use Algorithm::EventsPerSecond::Sukkal;

my $dir  = tempdir( CLEANUP => 1 );
my $path = "$dir/sukkal.sock";

my $pid = fork;
die "fork failed: $!" unless defined $pid;

if ( $pid == 0 ) {
	# daemon child; _exit so the parent's Test::More END block does
	# not run twice
	my $ok = eval {
		my $d = Algorithm::EventsPerSecond::Sukkal->new(
			socket   => $path,
			window   => 5,
			max_keys => 4,
		);
		$SIG{TERM} = sub { $d->stop };
		$d->run;
		1;
	};
	warn $@ if !$ok;
	POSIX::_exit( $ok ? 0 : 1 );
} ## end if ( $pid == 0 )

my $sock;
for ( 1 .. 100 ) {
	last if $sock = IO::Socket::UNIX->new( Type => SOCK_STREAM, Peer => $path );
	sleep 0.1;
}
if ( !$sock ) {
	kill 'KILL', $pid;
	waitpid $pid, 0;
	BAIL_OUT("daemon did not come up on $path");
}
ok( $sock, 'connected to daemon socket' );

# send a command, read its single-line reply
sub req {
	my ($cmd) = @_;
	print $sock "$cmd\n";
	my $line = <$sock>;
	return undef unless defined $line;
	$line =~ s/\r?\n\z//;
	return $line;
}

# send a command with a multi-line reply; returns (header, lines up to END)
sub req_multi {
	my ($cmd) = @_;
	print $sock "$cmd\n";
	my $hdr = <$sock>;
	$hdr =~ s/\r?\n\z//;
	my @lines;
	while ( my $l = <$sock> ) {
		$l =~ s/\r?\n\z//;
		last if $l eq 'END';
		push @lines, $l;
	}
	return ( $hdr, @lines );
} ## end sub req_multi

is( req('PING'), 'OK PONG', 'PING' );
like( req('STATS'), qr/^OK keys=0 clients=1 /, 'daemon STATS while empty' );

print $sock "MARK foo\nMARK foo 4\n";
is( req('COUNT foo'), 'OK 5', 'pipelined marks coalesced and counted' );
is( req('TOTAL foo'), 'OK 5', 'TOTAL' );

# rate uses elapsed lifetime while younger than the window, so give the