view release on metacpan or  search on metacpan

t/91-streamd.t  view on Meta::CPAN

	close $c4;
	is( stop_daemon($daemon), 0, 'munged daemon exits 0' );
	undef $daemon;
}; ## end 'raw munged values that CSV could never carry' => sub

subtest '--set runs named instances side by side' => sub {
	my $sdir  = "$tmp/sets";
	my @knobs = ( '--save-interval' => 60, '-n' => 10, '--window' => 64, '--eta' => 8 );
	my $alpha = spawn_daemon(
		"$tmp/alpha.sock",
		'--set'       => 'alpha',
		'--socket'    => $tmp,
		'--pid'       => $tmp,
		'--model-dir' => $sdir,
		'-s'          => 1,
		@knobs
	);
	my $beta = spawn_daemon(
		"$tmp/beta.sock",
		'--set'       => 'beta',
		'--socket'    => $tmp,
		'--pid'       => $tmp,
		'--model-dir' => $sdir,
		'-s'          => 2,
		@knobs
	);

	ok( -S "$tmp/alpha.sock", 'set alpha listens on <rundir>/alpha.sock' ) or diag( scalar `cat $logf` );
	ok( -f "$tmp/alpha.pid",  'and writes <rundir>/alpha.pid' );
	ok( -S "$tmp/beta.sock",  'set beta listens on <rundir>/beta.sock' );

	my $ca = connect_client("$tmp/alpha.sock");
	my $cb = connect_client("$tmp/beta.sock");
	srand(6);
	rt( $ca, { rows => [ map { [ rand, rand ] } 1 .. 30 ], mode => 'learn' } );
	rt( $cb, { rows => [ map { [ rand, rand ] } 1 .. 5 ],  mode => 'learn' } );

	my $sa = rt( $ca, { cmd => 'stats' } );
	my $sb = rt( $cb, { cmd => 'stats' } );
	is( $sa->{ok}{set},  'alpha', 'stats reports the set name' );
	is( $sa->{ok}{seen}, 30,      'alpha learned its own stream' );
	is( $sb->{ok}{set},  'beta',  'beta reports its set name' );
	is( $sb->{ok}{seen}, 5,       'beta is independent of alpha' );

	my $saved = rt( $ca, { cmd => 'save' } )->{ok}{saved};
	ok( -f "$sdir/alpha/$saved", 'saves land under <model-dir>/<set>/' );
	is( readlink("$sdir/alpha/latest.json"), $saved, 'the set has its own latest.json symlink' );
	ok( !-e "$sdir/beta/$saved", 'and beta did not get alpha\'s save' );

	close $ca;
	close $cb;
	is( stop_daemon($alpha), 0, 'alpha exits 0' );
	is( stop_daemon($beta),  0, 'beta exits 0' );
	ok( !-e "$tmp/alpha.sock" && !-e "$tmp/alpha.pid", 'alpha cleaned up its socket and pid' );

	# Set names that could mangle paths are refused before anything runs.
	for my $bad ( 'bad/name', 'a.b', '..' ) {
		my $quoted = quotemeta $bad;
		my $out    = `$^X -Ilib $bin streamd -f --set $quoted 2>&1`;
		isnt( $?, 0, "--set '$bad' exits non-zero" );
		like( $out, qr/--set/, 'the error names the flag' );
	}
}; ## end '--set runs named instances side by side' => sub

subtest 'default directories refused when not writable' => sub {
	plan skip_all => 'running as root; the /var defaults would work'
		if $> == 0;
	plan skip_all => '/var/db/iforest_streamd is creatable here; nothing to refuse'
		if -w '/var/db/iforest_streamd' || ( !-e '/var/db/iforest_streamd' && -w '/var/db' );

	my $out = `$^X -Ilib $bin streamd -f 2>&1`;
	isnt( $?, 0, 'streamd with unwritable default dirs exits non-zero' );
	like( $out, qr/--model-dir/, 'the error names the flag to override' );
}; ## end 'default directories refused when not writable' => sub

done_testing;