view release on metacpan or  search on metacpan

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

my $seen_at_shutdown = rt( $c, { cmd => 'stats' } )->{ok}{seen};

subtest 'clean shutdown and resume' => sub {
	is( stop_daemon($daemon), 0, 'SIGTERM exits 0' );
	undef $daemon;
	ok( !-e $sock, 'socket removed' );
	ok( !-e $pidf, 'pid file removed' );

	# latest.json is a complete model; the parent class loads it and it
	# carries everything learned (the shutdown save flushed the tail).
	require Algorithm::Classifier::IsolationForest;
	my $m = Algorithm::Classifier::IsolationForest->load($latest);
	isa_ok( $m, 'Algorithm::Classifier::IsolationForest::Online', 'latest.json' );
	is( $m->seen, $seen_at_shutdown, 'shutdown save captured everything learned' );

	# Restart with no creation knobs: resumes from latest.json.
	$daemon = start_daemon( '--save-interval' => 60 );
	my $c3 = connect_client();
	is( rt( $c3, { cmd => 'stats' } )->{ok}{seen}, $seen_at_shutdown, 'restart resumed from latest.json' );
	close $c3;
	is( stop_daemon($daemon), 0, 'second daemon exits 0' );
	undef $daemon;
}; ## end 'clean shutdown and resume' => sub

subtest 'raw munged values that CSV could never carry' => sub {
	plan skip_all => 'Algorithm::ToNumberMunger is not installed'
		unless eval { require Algorithm::ToNumberMunger; 1 };

	# A munged online model via a prototype, in its own model dir.
	my $mdir2 = "$tmp/models2";
	my $proto = "$tmp/proto.json";
	{
		open my $fh, '>', $proto or die $!;
		print {$fh} $JSON->encode(
			{
				format             => 'Algorithm::Classifier::IsolationForest::Prototype',
				class              => 'online',
				schema_version     => 'd1',
				schema_description => 'streamd munger test',
				schema             => {
					feature_names => [ 'method', 'path_len' ],
					mungers       => {
						method   => { munger => 'http_method_enum', default => -1 },
						path_len => { munger => 'length',           from    => 'path' },
					},
				},
				params => { n_trees => 20, window_size => 64, max_leaf_samples => 8 },
			}
		);
		close $fh;
	}

	$daemon = start_daemon(
		'--save-interval' => 60,
		'--model-dir'     => $mdir2,
		'-s'              => 7,
		'--prototype'     => $proto
	);
	my $c4 = connect_client();

	# Raw values with embedded commas, quotes, newline escapes, and
	# unicode -- the reason the protocol is JSON.
	my @raw = map { { method => 'GET', path => '/a,b/"c"/' . ( 'p' x ( 3 + $_ % 15 ) ) . "\x{2603}" } } 1 .. 60;
	is_deeply(
		rt( $c4, { rows => \@raw, mode => 'learn' } ),
		{ ok => { learned => 60 } },
		'raw tagged rows with hostile content learn cleanly'
	);
	my $r = rt( $c4, { row => { method => 'BREW', path => '/' . ( 'a' x 90 ) . ',oh no' }, tag => "t,\x{2603}" } );
	like( $r->{score}, qr/\A[\d.eE+-]+\z/, 'raw anomalous row scores' );
	is( $r->{tag}, "t,\x{2603}", 'unicode/comma tag round-trips' );

	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' );