view release on metacpan or  search on metacpan

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

	{
		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;
	}
	{
		open my $fh, '>', $oproto or die $!;
		print $fh '{ "format": "Algorithm::Classifier::IsolationForest::Prototype",'
			. ' "class": "online", "schema_version": "s2",'
			. ' "schema_description": "online metrics stream",'
			. ' "schema": { "feature_names": ["cpu", "mem", "disk"] },'
			. ' "params": { "n_trees": 20, "window_size": 64, "max_leaf_samples": 16 } }';
		close $fh;
	}

	subtest 'fit --prototype creates a model carrying the schema metadata' => sub {
		my $out = `$^X -Ilib $bin fit --prototype $bproto -i $train_csv -o $pmodel -s 42 2>&1`;
		is( $?, 0, 'fit --prototype exits 0' ) or diag $out;
		ok( -s $pmodel, 'model written' );

		my $info = `$^X -Ilib $bin info -m $pmodel 2>&1`;
		is( $?, 0, 'info exits 0' );
		like( $info, qr/schema_version\s+2026\.07\.08-1/,              'schema_version shown, unmangled' );
		like( $info, qr/schema_description\s+three synthetic metrics/, 'schema_description shown' );
		like( $info, qr/\[0\]\s+cpu -- cpu utilisation fraction/,      'feature description beside its tag' );
		like( $info, qr/\[1\]\s+mem\s*$/m,                             'undescribed tag rendered bare' );
		like( $info, qr/n_trees\s+30/,                                 'prototype param applied' );
	}; ## end 'fit --prototype creates a model carrying the schema metadata' => sub

	subtest 'fit --prototype refusals' => sub {
		my $out = `$^X -Ilib $bin fit --prototype $bproto -t cpu -i $train_csv -p 2>&1`;
		isnt( $?, 0, 'combining --prototype with -t exits non-zero' );
		like( $out, qr/may not be combined/, 'error explains the conflict' );

		$out = `$^X -Ilib $bin fit --prototype $oproto -i $train_csv -p 2>&1`;
		isnt( $?, 0, 'an online prototype is refused by fit' );
		like( $out, qr/use `iforest stream`/, 'error points at stream' );
	};

	subtest 'stream --prototype creates an online model' => sub {
		my $out = `$^X -Ilib $bin stream --prototype $oproto -i $train_csv -m $pomodel -s 7 2>&1`;
		is( $?, 0, 'stream --prototype exits 0' ) or diag $out;
		ok( -s $pomodel, 'online model written' );

		my $info = `$^X -Ilib $bin info -m $pomodel 2>&1`;
		like( $info, qr/type\s+online/,                              'created model is online' );
		like( $info, qr/schema_version\s+s2/,                        'schema_version carried' );
		like( $info, qr/schema_description\s+online metrics stream/, 'schema_description carried' );
		like( $info, qr/window_size\s+64/,                           'prototype param applied' );

		# Resume ignores the creation knob, like the rest of them.
		my $out2 = `$^X -Ilib $bin stream --prototype $oproto -i $train_csv -m $pomodel 2>&1`;
		is( $?, 0, 'resumed stream with the flag still exits 0' ) or diag $out2;

		$out = `$^X -Ilib $bin stream --prototype $bproto -i $train_csv -m $tmp/nope_online.json 2>&1`;
		isnt( $?, 0, 'a batch prototype is refused by stream' );
		like( $out, qr/use `iforest fit`/, 'error points at fit' );
	}; ## end 'stream --prototype creates an online model' => sub

	subtest 'proto --from-model extracts a working prototype' => sub {
		my $extracted = "$tmp/extracted_proto.json";
		my $out       = `$^X -Ilib $bin proto --from-model $pmodel -o $extracted 2>&1`;
		is( $?, 0, 'proto --from-model exits 0' ) or diag $out;
		ok( -s $extracted, 'prototype file written' );

		my $check = `$^X -Ilib $bin proto --check $extracted 2>&1`;
		is( $?, 0, 'extracted prototype passes --check' ) or diag $check;
		like( $check, qr/class\s+batch/,                           'summary shows the class' );
		like( $check, qr/schema_version\s+2026\.07\.08-1/,         'summary keeps the schema_version' );
		like( $check, qr/\[0\]\s+cpu -- cpu utilisation fraction/, 'summary lists feature descriptions' );

		# The extraction closes the loop: fit a fresh model from it.
		my $refit = `$^X -Ilib $bin fit --prototype $extracted -i $train_csv -o $tmp/refit.json -s 42 2>&1`;
		is( $?, 0, 'fit from the extracted prototype exits 0' ) or diag $refit;
	}; ## end 'proto --from-model extracts a working prototype' => sub

	subtest 'proto --check rejects invalid input' => sub {
		my $bad = "$tmp/bad_proto.json";
		{
			open my $fh, '>', $bad or die $!;
			print $fh '{ "format": "Algorithm::Classifier::IsolationForest::Prototype", "class": "batch" }';
			close $fh;
		}
		my $out = `$^X -Ilib $bin proto --check $bad 2>&1`;
		isnt( $?, 0, 'invalid prototype exits non-zero' );
		like( $out, qr/is not a valid prototype/, 'error says the file is invalid' );

		$out = `$^X -Ilib $bin proto --check $bad --from-model $pmodel 2>&1`;
		isnt( $?, 0, 'combining --check and --from-model exits non-zero' );
		like( $out, qr/exactly one of/, 'error explains the exclusivity' );

		$out = `$^X -Ilib $bin proto 2>&1`;
		isnt( $?, 0, 'neither switch exits non-zero' );
	}; ## end 'proto --check rejects invalid input' => sub
}

# Ensure the module's HAS_C flag was probed before any SKIP block.
BEGIN { require Algorithm::Classifier::IsolationForest; }

done_testing;