view release on metacpan or  search on metacpan

t/90-cli-commands.t  view on Meta::CPAN

		my @a = do { open my $fh, '<', $pred_csv;  <$fh> };
		my @b = do { open my $fh, '<', $pred2_csv; <$fh> };
		is( scalar @a, scalar @b, 'same row count' );

		my $diffs = 0;
		for my $i ( 0 .. $#a ) {
			chomp( my $la = $a[$i] );
			chomp( my $lb = $b[$i] );
			my ( $sa, $ya ) = split /,/, $la;
			my ( $sb, $yb ) = split /,/, $lb;
			$diffs++ if abs( $sa - $sb ) > 1e-9;
			$diffs++ if $ya != $yb;
		}
		is( $diffs, 0, 'packed-input scores and labels match CSV-input output' );
	}; ## end 'predict on packed input agrees with CSV input' => sub

	subtest 'predict with -d works on packed input' => sub {
		my $out = `$^X -Ilib $bin predict -m $model -i $packed -d 2>&1`;
		is( $?, 0, 'predict -d (packed) exits 0' );
		my @lines = split /\n/, $out;
		is( scalar @lines, 7, 'one row per query point' );
		my $first = $lines[0];
		my @f     = split /,/, $first;
		is( scalar @f, 5, '-d output has 3 features + score + label (5 columns)' );
	};
} ## end SKIP:

# --- online model workflow: stream + info -------------------------------
{
	my $stream_csv = "$tmp/stream.csv";
	my $omodel     = "$tmp/online_model.json";
	my $oscores    = "$tmp/stream_scores.csv";

	{
		open my $fh, '>', $stream_csv or die $!;
		srand(3);
		for ( 1 .. 120 ) {
			print $fh join( ',', map { sprintf( '%.4f', rand() - 0.5 ) } 1 .. 3 ), "\n";
		}
		print $fh "9,9,9\n";
		close $fh;
	}

	subtest 'stream creates an online model and emits prequential scores' => sub {
		my $out = `$^X -Ilib $bin stream -i $stream_csv -m $omodel -n 20 --window 64 --eta 16 -s 42 2>&1`;
		is( $?, 0, 'stream exits 0' );
		ok( -s $omodel, 'online model was written' );
		my @lines = split /\n/, $out;
		is( scalar @lines, 121, 'one output row per input row' );
		like( $lines[-1], qr/^[\d.eE+-]+,[01]$/, 'rows match "score,label"' );
	};

	subtest 'stream resumes a saved model' => sub {
		my $out = `$^X -Ilib $bin stream -i $stream_csv -m $omodel 2>&1`;
		is( $?, 0, 'stream (resume) exits 0' );
		my @lines = split /\n/, $out;
		is( scalar @lines, 121, 'one output row per input row on resume' );
	};

	subtest 'stream --score-only does not advance the model' => sub {
		my $before = do { local ( @ARGV, $/ ) = ($omodel); <> };
		my $out    = `$^X -Ilib $bin stream --score-only -i $stream_csv -m $omodel -o $oscores 2>&1`;
		is( $?, 0, 'stream --score-only exits 0' );
		ok( -s $oscores, 'score output file written' );
		my $after = do { local ( @ARGV, $/ ) = ($omodel); <> };
		is( $after, $before, 'model file unchanged by --score-only' );
	};

	subtest 'stream --learn-only emits nothing but updates the model' => sub {
		my $before = do { local ( @ARGV, $/ ) = ($omodel); <> };
		my $out    = `$^X -Ilib $bin stream --learn-only -i $stream_csv -m $omodel 2>&1`;
		is( $?,   0,  'stream --learn-only exits 0' );
		is( $out, '', 'no score output' );
		my $after = do { local ( @ARGV, $/ ) = ($omodel); <> };
		isnt( $after, $before, 'model file advanced by --learn-only' );
	};

	subtest 'info recognises an online model' => sub {
		my $out = `$^X -Ilib $bin info -m $omodel 2>&1`;
		is( $?, 0, 'info exits 0 on an online model' );
		like( $out, qr/type\s+online/,          'info reports type=online' );
		like( $out, qr/window_size\s+64/,       'info reports window_size' );
		like( $out, qr/max_leaf_samples\s+16/,  'info reports max_leaf_samples' );
		like( $out, qr/tree_total_nodes\s+\d+/, 'info reports tree stats' );
	};

	subtest 'info --json on an online model parses' => sub {
		my $out = `$^X -Ilib $bin info -m $omodel --json 2>&1`;
		is( $?, 0, 'info --json exits 0' );
		require JSON::PP;
		my $obj = eval { JSON::PP->new->decode($out) };
		ok( !$@, 'output parses as JSON' ) or diag("error: $@");
		if ($obj) {
			is( $obj->{type},    'online', 'JSON type matches' );
			is( $obj->{n_trees}, 20,       'JSON n_trees matches' );
		}
	}; ## end 'info --json on an online model parses' => sub

	subtest 'stream refuses a batch model' => sub {
		my $out = `$^X -Ilib $bin stream -i $stream_csv -m $model 2>&1`;
		isnt( $?, 0, 'stream exits non-zero on a batch model' );
		like( $out, qr/not an online model/, 'error explains the mismatch' );
	};
}

# --- munger workflow: fit/predict/stream with raw (non-numeric) CSV -----
SKIP: {
	skip 'Algorithm::ToNumberMunger is not installed', 5
		unless eval { require Algorithm::ToNumberMunger; 1 };

	my $munger_json = "$tmp/mungers.json";
	my $raw_csv     = "$tmp/raw.csv";
	my $mmodel      = "$tmp/munged_model.json";
	my $momodel     = "$tmp/munged_online_model.json";

	{
		open my $fh, '>', $munger_json or die $!;
		print $fh '{ "method": { "munger": "http_method_enum", "default": -1 },'
			. ' "path_len": { "munger": "length", "from": "path" } }';
		close $fh;
	}
	{
		open my $fh, '>', $raw_csv or die $!;
		srand(4);
		my @methods = qw(GET GET GET POST HEAD);
		for my $i ( 1 .. 80 ) {
			printf $fh "%s,%s,%.4f\n", $methods[ $i % 5 ], '/' . ( 'p' x ( 3 + $i % 20 ) ), 500 + rand(400);
		}
		print $fh 'BREW,/' . ( 'a' x 90 ) . ",60000\n";
		close $fh;
	}

	subtest 'fit --mungers accepts raw CSV and saves the spec' => sub {
		my $out
			= `$^X -Ilib $bin fit -i $raw_csv -o $mmodel -n 30 -m 32 -s 42 -t method -t path_len -t bytes --mungers $munger_json 2>&1`;
		is( $?, 0, 'fit --mungers exits 0' ) or diag $out;
		ok( -s $mmodel, 'model written' );
		like(
			scalar(
				do { local ( @ARGV, $/ ) = ($mmodel); <> }
			),
			qr/"mungers"/,
			'model JSON carries the munger spec'
		);
	}; ## end 'fit --mungers accepts raw CSV and saves the spec' => sub

	subtest 'fit --mungers without -t is refused' => sub {
		my $out = `$^X -Ilib $bin fit -i $raw_csv -o $tmp/nope.json -w --mungers $munger_json 2>&1`;
		isnt( $?, 0, 'exits non-zero' );
		like( $out, qr/requires feature tags/, 'error explains -t is needed' );
	};

	subtest 'predict munges raw CSV against a munger-bearing model' => sub {
		my $out = `$^X -Ilib $bin predict -m $mmodel -i $raw_csv 2>&1`;
		is( $?, 0, 'predict exits 0' ) or diag $out;
		my @lines = split /\n/, $out;
		is( scalar @lines, 81, 'one output row per input row' );
		like( $lines[-1], qr/^[\d.eE+-]+,[01]$/, 'rows match "score,label"' );
	};

	subtest 'info shows the munger summary' => sub {
		my $out = `$^X -Ilib $bin info -m $mmodel 2>&1`;
		is( $?, 0, 'info exits 0' );
		like( $out, qr/mungers\s+2 configured/,        'munger count shown' );
		like( $out, qr/method\s+http_method_enum/,     'munger names listed' );
		like( $out, qr/munger_module_version\s+[\d.]/, 'module version shown' );
	};

	subtest 'stream --mungers creates and resumes a munged online model' => sub {
		my $out
			= `$^X -Ilib $bin stream -i $raw_csv -m $momodel -n 20 --window 64 --eta 16 -s 7 -t method -t path_len -t bytes --mungers $munger_json 2>&1`;
		is( $?, 0, 'stream --mungers exits 0' ) or diag $out;
		ok( -s $momodel, 'online model written' );

		# Resume: the model carries its spec, so raw CSV still works with
		# no --mungers flag.
		my $out2 = `$^X -Ilib $bin stream -i $raw_csv -m $momodel 2>&1`;
		is( $?, 0, 'resumed stream exits 0' ) or diag $out2;
		my @lines = split /\n/, $out2;
		is( scalar @lines, 81, 'one output row per input row on resume' );
	}; ## end 'stream --mungers creates and resumes a munged online model' => sub
} ## end SKIP:

# --- prototype workflow: fit/stream --prototype, proto command ----------
{
	my $bproto  = "$tmp/proto_batch.json";
	my $oproto  = "$tmp/proto_online.json";
	my $pmodel  = "$tmp/proto_model.json";
	my $pomodel = "$tmp/proto_online_model.json";

	{
		open my $fh, '>', $bproto or die $!;
		print $fh '{ "format": "Algorithm::Classifier::IsolationForest::Prototype",'
			. ' "class": "batch", "schema_version": "2026.07.08-1",'
			. ' "schema_description": "three synthetic metrics",'
			. ' "schema": { "feature_names": ["cpu", "mem", "disk"],'
			. ' "feature_descriptions": { "cpu": "cpu utilisation fraction" } },'
			. ' "params": { "n_trees": 30, "sample_size": 16 } }';
		close $fh;
	}