Rename tool to urn: vessel of time from GoW.

1 files changed, 175 insertions, 0 deletions

diff --git a/urn.t b/urn.t
new file mode 100644
index 0000000..734bb06
--- /dev/null
+++ b/urn.t
@@ -0,0 +1,175 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use File::Spec;
+use File::Path qw(make_path remove_tree);
+use Digest::SHA qw(sha1_hex);
+
+# Setup testing environment
+my $sandbox    = File::Spec->rel2abs("sandbox_env");
+my $script_bin = File::Spec->catfile(File::Spec->rel2abs("."), "urn"); 
+my $repo_meta  = ".urn";
+
+remove_tree($sandbox);
+make_path($sandbox);
+chdir($sandbox) or die "Cannot chdir to $sandbox: $!";
+
+sub run_cmd {
+	my $cmd = shift;
+	my $out = `perl $script_bin $cmd 2>&1`;
+	if ($? != 0) {
+		die "\nCommand '$cmd' failed with exit code $?:\n$out\n";
+	}
+	return $out;
+}
+
+sub get_head_id {
+	my $head_path = File::Spec->catfile($repo_meta, "head");
+	return undef unless -f $head_path;
+	open(my $fh, '<', $head_path) or return undef;
+	my $id = <$fh>;
+	close($fh);
+	chomp($id //= "");
+	$id =~ s/^\s+|\s+$//g;
+	return $id;
+}
+
+print "Starting tests...\n";
+run_cmd("init");
+
+# --- Subtest 1: All-In Integration ---
+print "Subtest 1: Initial commit with symlink...\t";
+{
+	open(my $fh, '>', "file1.txt") or die $!;
+	print $fh "Original content\n" x 10;
+	close($fh);
+	
+	symlink("file1.txt", "link1.txt") or die "Symlink failed: $!";
+	
+	run_cmd("commit -am 'initial'");
+	
+	my $idx_path = File::Spec->catfile($repo_meta, "index");
+	open(my $idx, '<', $idx_path) or die "Could not open $idx_path: $!";
+	my %index_hashes;
+	while (<$idx>) {
+		chomp;
+		# Updated parser: split on tabs and trim padding from hashes
+		my ($shash, $chash, $bhash, $m, $s, $path) = split(/\t/, $_, 6);
+		$shash =~ s/\s+$//; # Remove fixed-width padding
+		$index_hashes{$path} = $shash;
+	}
+	close($idx);
+
+	die "Missing file1" unless $index_hashes{"file1.txt"};
+	# Symlink hash is the SHA of the target path string
+	die "Symlink hash mismatch" unless $index_hashes{"link1.txt"} eq sha1_hex("file1.txt");
+}
+print "OK\n";
+
+# --- Subtest 2: Large Source, Small Patch (Text Patching) ---
+print "Subtest 2: Large source, small patch...\t";
+{
+	my $large_p = "large.txt";
+	open(my $lf, '>', $large_p) or die $!;
+	print $lf "Line $_\n" for 1..1000;
+	close($lf);
+	
+	run_cmd("commit -am 'large file base'");
+	
+	open($lf, '>>', $large_p) or die $!;
+	print $lf "One small change\n";
+	close($lf);
+	run_cmd("commit -am 'patch commit'");
+	
+	my $head_id = get_head_id();
+	my $rev_path = File::Spec->catfile($repo_meta, "rev", $head_id);
+	open(my $rf, '<', $rev_path) or die "Could not open $rev_path: $!";
+	my $has_patch = 0;
+	while (<$rf>) { $has_patch = 1 if /^patch:[a-f0-9]/; }
+	close($rf);
+	die "Expected patch in rev $head_id" unless $has_patch;
+}
+print "OK\n";
+
+# --- Subtest 3: Small Source, Large Patch (Full Store) ---
+print "Subtest 3: Small source, large patch...\t";
+{
+	my $small_p = "small.txt";
+	open(my $sf, '>', $small_p) or die $!;
+	print $sf "A";
+	close($sf);
+	run_cmd("commit -am 'small file base'");
+	
+	open($sf, '>', $small_p) or die $!;
+	print $sf "Completely different content" x 200;
+	close($sf);
+	run_cmd("commit -am 'full store commit'");
+
+	my $restored = run_cmd("show HEAD $small_p");
+	my $actual = `cat $small_p`;
+	die "Reconstruction mismatch" unless $restored eq $actual;
+}
+print "OK\n";
+
+# --- Subtest 4: Binary Integrity ---
+print "Subtest 4: Binary patch integrity...\t\t";
+{
+	my $bin_p = "data.bin";
+	my $orig_data = pack("C*", map { int(rand(256)) } 1..2048);
+	open(my $bf, '>:raw', $bin_p) or die $!;
+	print $bf $orig_data;
+	close($bf);
+	run_cmd("commit -am 'initial bin'");
+	
+	my $old_rev = get_head_id();
+
+	open($bf, '+<:raw', $bin_p) or die $!;
+	seek($bf, 1024, 0);
+	print $bf pack("C", 255);
+	close($bf);
+	run_cmd("commit -am 'mod bin'");
+
+	my $v_old = run_cmd("show $old_rev $bin_p");
+	my $v_new = run_cmd("show HEAD $bin_p");
+	
+	die "Old version corrupted" unless $v_old eq $orig_data;
+	die "Binary restore error" unless length($v_new) == 2048;
+}
+print "OK\n";
+
+# --- Subtest 5: CRUD (Deletion) ---
+print "Subtest 5: File deletion...\t\t\t";
+{
+	unlink("file1.txt");
+	run_cmd("commit -am 'delete file1'");
+	
+	my $head_id = get_head_id();
+	my $rev_path = File::Spec->catfile($repo_meta, "rev", $head_id);
+	my $rev_data = `cat $rev_path`;
+	my ($tree_h) = $rev_data =~ /^tree:([a-f0-9]+)/m;
+	
+	my $t_obj = File::Spec->catfile($repo_meta, "obj", substr($tree_h, 0, 2), substr($tree_h, 2));
+	my $tree_content = `cat $t_obj`;
+	die "File1 still in tree after deletion" if $tree_content =~ /file1\.txt/;
+}
+print "OK\n";
+
+# --- Subtest 6: Dirty Status ---
+print "Subtest 6: Dirty state detection...\t\t";
+{
+	open(my $fh, '>', "dirty.txt") or die $!;
+	print $fh "Clean state\n";
+	close($fh);
+	run_cmd("add dirty.txt");
+	
+	open($fh, '>>', "dirty.txt") or die $!;
+	print $fh "Dirty edit\n";
+	close($fh);
+	
+	my $status = run_cmd("status");
+	die "Failed to detect dirty state" unless $status =~ /\[M\].*dirty\.txt.*\(dirty\)/;
+}
+print "OK\n";
+
+print "\nAll tests passed successfully.\n";
+