view release on metacpan or  search on metacpan

t/mungers-eps.t  view on Meta::CPAN

#!perl
# The eps munger against a real iqbi-damiq daemon (Algorithm::EventsPerSecond::
# Sukkal) forked for the duration of the test. Skips when that dist is not
# installed -- the munger itself only speaks the wire protocol and never loads
# it, so this is purely a test-time dependency.
use 5.006;
use strict;
use warnings;
use Test::More;
use File::Temp qw(tempdir);

BEGIN {
	eval { require Algorithm::EventsPerSecond::Sukkal; 1 }
		or plan skip_all => 'Algorithm::EventsPerSecond::Sukkal not available';
	eval { require IO::Socket::UNIX; require Socket; 1 }
		or plan skip_all => 'IO::Socket::UNIX not available';
}

use Algorithm::ToNumberMunger;
my $M = 'Algorithm::ToNumberMunger';

# ---- fork daemons -----------------------------------------------------------
my $dir    = tempdir( CLEANUP => 1 );
my $parent = $$;
my @PIDS;

END {
	if ( $$ == $parent ) {
		for my $p (@PIDS) { kill 'TERM', $p; waitpid $p, 0 }
	}
}

# Fractional sleep via 4-arg select, deliberately: Time::HiRes would be this
# test's only use of it and the dist nominally supports pre-5.8 perls.
sub nap {
	select( undef, undef, undef, $_[0] );    ## no critic (ProhibitSleepViaSelect)
	return;
}

# Fork an iqbi-damiq on $sock_path, wait until it answers PING; returns true
# on ready, false when fork/startup failed. The window is much longer than the
# test will ever run: count/rate assertions read marks made earlier, and a
# short window let them age out under scheduling delay (flaky failures).
sub start_daemon {
	my ( $sock_path, %opts ) = @_;
	my $pid = fork;
	return 0 unless defined $pid;
	if ( !$pid ) {
		my $daemon = Algorithm::EventsPerSecond::Sukkal->new(
			socket => $sock_path,
			window => 300,
			%opts
		);
		local $SIG{TERM} = sub { $daemon->stop };
		$daemon->run;
		exit 0;
	} ## end if ( !$pid )
	push @PIDS, $pid;
	for ( 1 .. 100 ) {
		my $c = IO::Socket::UNIX->new(
			Type => Socket::SOCK_STREAM(),
			Peer => $sock_path
		);
		if ($c) {
			print {$c} "PING\n";
			my $reply = <$c>;
			return 1 if defined $reply && $reply =~ /\AOK PONG/;
		}
		nap(0.1);
	} ## end for ( 1 .. 100 )
	return 0;
} ## end sub start_daemon

my $sock = "$dir/eps.sock";
start_daemon($sock) or plan skip_all => 'iqbi-damiq did not come up';

# ---- mark + read ------------------------------------------------------------
{
	my $rate = $M->build( { munger => 'eps', socket => $sock, prefix => 't1:' } );
	my $r;
	$r = $rate->('k') for 1 .. 5;    # five marks against t1:k
	ok( defined $r && $r >= 0, 'marked rate read back a number' );

	# a meter's rate is count/elapsed-seconds, so a brand-new key reads 0
	# until the second boundary passes; age it, then a read-only rate is > 0.
	nap(1.1);
	my $rate_ro = $M->build(
		{
			munger => 'eps',
			socket => $sock,
			prefix => 't1:',
			mark   => 0
		}
	);
	ok( $rate_ro->('k') > 0, 'rate is positive once the meter has aged' );