diff options
| -rw-r--r-- | test_vcx.t | 167 | ||||
| -rw-r--r-- | vcx | 201 | ||||
| -rw-r--r-- | vcx.t | 153 | ||||
| -rw-r--r-- | vcx_patch.t | 104 |
4 files changed, 397 insertions, 228 deletions
diff --git a/test_vcx.t b/test_vcx.t deleted file mode 100644 index 2467819..0000000 --- a/test_vcx.t +++ /dev/null @@ -1,167 +0,0 @@ -use strict; -use warnings; -use Test::More; -use File::Path qw(remove_tree make_path); -use File::Spec; -use Cwd; -use File::Glob qw(:bsd_glob); - -use constant ROOT => '.vcx'; -use constant HEAD => ROOT . '/head'; # Current commit ID -use constant OBJ_DIR => ROOT . '/obj'; # Latest version of a file -use constant REV_DIR => ROOT . '/rev'; # Commits - -# Staging area -use constant TMP_DIR => ROOT . '/index'; -use constant TMP_TREE => TMP_DIR . '/tree'; - -# Setup Sandbox -my $sandbox = "sandbox"; -remove_tree($sandbox) if -d $sandbox; -make_path($sandbox); - -my $orig_dir = getcwd(); -chdir($sandbox) or die "Cant enter sandbox: $!"; - -my $cmd = File::Spec->catfile($orig_dir, "vcx"); - -# Test 'init' -ok(system("perl $cmd init > /dev/null") == 0, "Init command ran successfully"); -ok(-d ROOT, "ROOT directory created"); -ok(-e HEAD, "Head file created"); -ok(-d OBJ_DIR, "OBJ_DIR directory created"); -ok(-d REV_DIR, "REV_DIR directory created"); - -# Test 'add' -open my $fh, '>', "test.txt" or die $!; -print $fh "Hello, world!"; -close $fh; - -ok(system("perl $cmd add test.txt > /dev/null") == 0, - "Add command ran successfully"); -ok(-d TMP_TREE, "Staging tree created"); - -# Test 'commit -m' -ok(system("perl $cmd commit -m 'Initial commit' > /dev/null") == 0, - "Commit with -m ran successfully"); -my $rev1 = File::Spec->catdir(REV_DIR, "0000001"); -ok(-d $rev1, "Revision 0000001 created"); - -# Check the message content -my $msg_file = File::Spec->catfile($rev1, "message"); -ok(-f $msg_file, "Message file exists in revision 1"); - -open my $msg_fh, '<', $msg_file or die $!; -my $saved_msg = <$msg_fh>; chomp $saved_msg; close $msg_fh; -is($saved_msg, "Initial commit", "Commit message matches the input"); - -# Test 'commit -am' (Auto-staging) -open my $fh2, '>>', "test.txt" or die $!; -print $fh2 "\nMore content"; -close $fh2; - -ok(system("perl $cmd commit -am 'Second commit' > /dev/null") == 0, - "Commit -am (auto-staging) ran successfully"); - -# Check if the object store updated -opendir(my $dh, OBJ_DIR) or die $!; -my @objs = grep { /[a-f0-9]{40}/ } readdir($dh); -closedir($dh); - -ok(scalar @objs >= 1, "Objects exist in store"); - -# Shuffle subdirectories -make_path("dirA/dirB"); -write_file("dirA/dirB/shuffle.txt", "Same Content"); -system("perl $cmd add dirA/dirB/shuffle.txt > /dev/null"); -system("perl $cmd commit -m 'Shuffle part 1' > /dev/null"); - -# Move and delete -make_path("dirC"); -rename("dirA/dirB/shuffle.txt", "dirC/shuffle.txt"); -remove_tree("dirA"); - -# Commit the move -system("perl $cmd commit -am 'Shuffle part 2' > /dev/null"); - -# Verify Revision 4's tree structure -my $head = read_file(HEAD); -my ($tree_ptr) = bsd_glob(File::Spec->catfile(REV_DIR, $head, "tree-*")); -my ($tree_hash) = $tree_ptr =~ /tree-([a-f0-9]{40})$/; -my $actual_tree_path = File::Spec->catdir(OBJ_DIR, $tree_hash); - -# Check for new path -ok(-l File::Spec->catfile($actual_tree_path, "dirC/shuffle.txt"), - "New path dirC/shuffle.txt exists in object store"); - -# Check for deleted path (Should NOT exist) -ok(!-d File::Spec->catdir($actual_tree_path, "dirA"), - "Deleted directory removed from tree snapshot"); - -# Verify the symlink still points to the correct content blob -my $link_target = readlink(File::Spec->catfile($actual_tree_path, "dirC/shuffle.txt")); -like($link_target, qr/obj\/[a-f0-9]{40}/, "Symlink in tree points to a valid object blob"); - -## Symlink-to-symlink -write_file("target.txt", "Final Destination"); -symlink("target.txt", "link_a"); -symlink("link_a", "link_b"); - -system("perl $cmd add link_b > /dev/null"); -system("perl $cmd commit -m 'Double link' > /dev/null"); - -$head = read_file(HEAD); -($tree_ptr) = bsd_glob(File::Spec->catfile(REV_DIR, $head, "tree-*")); -my $staged_link = File::Spec->catfile(OBJ_DIR, $tree_ptr =~ s/.*tree-//r, "link_b"); - -is(readlink($staged_link), "link_a", "Symlink-to-symlink preserved literal target"); - -## Empty file -write_file("empty.txt", ""); -system("perl $cmd add empty.txt > /dev/null"); -system("perl $cmd commit -m 'Empty file' > /dev/null"); - -ok(-e File::Spec->catfile(OBJ_DIR, "da39a3ee5e6b4b0d3255bfef95601890afd80709"), - "Empty file object created (da39a3...)"); - -# The overwrite -write_file("repeat.txt", "Version A"); -system("perl $cmd add repeat.txt > /dev/null"); -system("perl $cmd commit -m 'State A' > /dev/null"); -my $tree_v1 = (bsd_glob(File::Spec->catfile(REV_DIR, read_file(HEAD), "tree-*")))[0]; - -write_file("repeat.txt", "Version B"); -system("perl $cmd add repeat.txt > /dev/null"); -system("perl $cmd commit -m 'State B' > /dev/null"); - -## Revert content -write_file("repeat.txt", "Version A"); -system("perl $cmd add repeat.txt > /dev/null"); -system("perl $cmd commit -m 'Back to State A' > /dev/null"); -my $tree_v3 = (bsd_glob(File::Spec->catfile(REV_DIR, read_file(HEAD), "tree-*")))[0]; - -is($tree_v1 =~ s/.*tree-//r, $tree_v3 =~ s/.*tree-//r, - "Tree hash reverted perfectly after content restoration"); - -# Cleanup -chdir($orig_dir); -# remove_tree($sandbox); # Uncomment this once you're sure it works - -done_testing(); - -sub write_file { - my ($path, $content) = @_; - open my $fh, '>', $path or die "Could not open '$path' for writing: $!"; - print $fh $content; - close $fh or die "Could not close '$path' after writing: $!"; -} - -sub read_file { - my $path = shift; - open my $fh, '<', $path or return ""; - my $content = <$fh>; - chomp $content if $content; - close $fh; - return $content; -} - @@ -16,15 +16,17 @@ use POSIX qw(strftime); use Digest::SHA qw(sha1_hex); use constant VCX_DIR => '.vcx'; -use constant HEAD => VCX_DIR . '/head'; # Current commit ID -use constant OBJ_DIR => VCX_DIR . '/obj'; # Latest version of a file +use constant HEAD => VCX_DIR . '/head'; # Current commit ID +use constant OBJ_DIR => VCX_DIR . '/obj'; # Data store: file snapshots, trees use constant REV_DIR => VCX_DIR . '/rev'; # Commits +use constant REG_FILE => VCX_DIR . '/reg'; # File version registry. # Staging area -use constant TMP_DIR => VCX_DIR . '/index'; -use constant TMP_TREE => TMP_DIR . '/tree'; -use constant TMP_META => TMP_DIR . '/meta'; -use constant TMP_DIFF => TMP_DIR . '/delta.tar.gz'; +use constant TMP_DIR => VCX_DIR . '/index'; +use constant TMP_TREE => TMP_DIR . '/tree'; +use constant TMP_META => TMP_DIR . '/meta'; +use constant TMP_DIFF => TMP_DIR . '/delta.tar.gz'; +use constant TMP_REG => REG_FILE . '.tmp'; Getopt::Long::Configure("bundling"); @@ -52,6 +54,7 @@ if ($cmd eq 'init') { sub run_init { make_path(OBJ_DIR, REV_DIR); + touch_file(REG_FILE); my $initial_hex = to_hex_id(0); my $rev0_dir = File::Spec->catfile(REV_DIR, $initial_hex); @@ -151,13 +154,14 @@ sub run_add { my ($latest_tree_hash) = $latest_tree_ptr =~ /tree-([a-f0-9]{40})$/; my $latest_tree_dir = File::Spec->catdir(OBJ_DIR, $latest_tree_hash); - my $next_id_hex = to_hex_id(from_hex_id($head) + 1); - my %entries; open my $afh, '>>', TMP_META or die $!; init_stage($latest_tree_dir, \%entries); + my $reg = load_registry(); + my $reg_updated = 0; + foreach my $input (@targets) { my @expanded = bsd_glob($input); foreach my $t (@expanded) { @@ -171,8 +175,8 @@ sub run_add { return if -d $_; my $rel = $File::Find::name =~ s|^\./||r; - $entries{$rel} = 1; + $entries{$rel} = 1; my $staged_path = File::Spec->catfile(TMP_TREE, $rel); my $prev_link = File::Spec->catfile($latest_tree_dir, $rel); @@ -185,13 +189,23 @@ sub run_add { return if compare($_, $obj_in_head) == 0; } - my $obj_name = sha1_hex($rel); + my $obj_name; + my $path_hash = sha1_hex($rel); + + if (exists $reg->{$path_hash}) { + $obj_name = $reg->{$path_hash}; + } else { + $obj_name = hash_file_content($_); + $reg->{$path_hash} = $obj_name; + $reg_updated = 1; + } + my $obj_path = File::Spec->catfile(OBJ_DIR, $obj_name); # Prepare patches in memory and save to disk in one write. - make_patch($File::Find::name, $obj_name, $obj_path, \%patches); + make_patch($File::Find::name, $obj_path, \%patches); stage_file($File::Find::name, $obj_path, $staged_path); - print $afh "$rel\n"; # Record in meta file for the commit command + print $afh "$rel\0$obj_path\n"; # Record in meta file for the commit command } # CASE 2: Symlink @@ -213,6 +227,10 @@ sub run_add { save_patches(\%patches); + if ($reg_updated == 1) { + write_registry($reg); + } + # Pass 2: History -> Workspace (Detects Deletions) foreach my $path (keys %entries) { if (!-e $path && !-l $path) { @@ -234,9 +252,9 @@ sub run_add { close $afh; my @sorted_paths = sort keys %entries; - my $tree_ents = join("\n", @sorted_paths); + my $tree_ents = join("\n", @sorted_paths); my $tree_header = "tree " . scalar(@sorted_paths) . "\n"; - my $tree_data = $tree_header . $tree_ents; + my $tree_data = $tree_header . $tree_ents; my $tree_hash = sha1_hex($tree_data); my $tree_file = File::Spec->catfile(TMP_DIR, "tree-$tree_hash"); @@ -274,15 +292,19 @@ sub run_commit { # Save file to store if (-e TMP_META) { open my $mfh, '<', TMP_META or die $!; - while (my $rel = <$mfh>) { - chomp $rel; - my $obj_name = sha1_hex($rel); - my $obj_path = File::Spec->catfile(OBJ_DIR, $obj_name); + while (my $line = <$mfh>) { + chomp $line; + my ($rel, $obj_path) = split("\0", $line); copy($rel, $obj_path) or die "Failed to update store for $rel: $!"; } close $mfh; } + # Update registry + if (-e TMP_REG) { + rename(TMP_REG, REG_FILE) or die "Failed to update registry: $!"; + } + # Save tree (snapshots the structure) if (!$tree_exists) { make_path($tree_path); @@ -377,13 +399,13 @@ sub stage_link { } sub make_patch { - my ($src, $obj_name, $obj_path, $patches) = @_; + my ($src, $obj_path, $patches) = @_; - return unless -e $obj_path; + return unless -f $obj_path; my $patch; - # TODO: implement a disk-based diff for large files, esp bin files + # TODO: implement a disk-based diff for large files if (-T $src) { if (compare($src, $obj_path) != 0) { $patch = qx(diff -u '$obj_path' '$src'); @@ -392,44 +414,69 @@ sub make_patch { $patch = make_bin_patch($src, $obj_path); } - if ($patch) { $patches->{$obj_name} = $patch; } + if ($patch) { + my $obj_name = basename($obj_path); + $patches->{$obj_name} = $patch; + } } sub make_bin_patch { my ($new_file, $old_file) = @_; - open my $f_new, '<:raw', $new_file or die "Cannot open file: $!"; - open my $f_old, '<:raw', $old_file or die "Cannot open object file: $!"; - my $f_out; + my $new_size = -s $new_file; + + open my $f_new, '<:raw', $new_file or die $!; + open my $f_old, '<:raw', $old_file or die $!; + + # Start the patch with the new total size + my $patch = pack("Q", $new_size); - my $patch = ""; - my $offset = 0; + my $offset = 0; my $blk_size = 4096; while (1) { my $read_new = sysread($f_new, my $buf_new, $blk_size); my $read_old = sysread($f_old, my $buf_old, $blk_size); + last if !$read_new && !$read_old; - # Stop when we've processed the entire new file - last if $read_new == 0 && $read_old == 0; - - # Handle file size differences (pad with nulls if one is shorter) - $buf_new .= "\0" x ($blk_size - length($buf_new)) if length($buf_new) < $blk_size; - $buf_old .= "\0" x ($blk_size - length($buf_old)) if length($buf_old) < $blk_size; - - # If they differ, we save the OLD buffer (reverse delta) if ($buf_new ne $buf_old) { - # Header: [64-bit offset][32-bit length][data] - # 'Q' is 64-bit unsigned (quad), 'L' is 32-bit unsigned (long) - $patch .= pack("QL", $offset, length($buf_old)) . $buf_old; + # Offset (Q) and Length (L) + $patch .= pack("QL", $offset, length($buf_new)) . $buf_new; } - $offset += $blk_size; } close $f_new; close $f_old; - close $f_out if $f_out; - return length($patch) > 0 ? $patch : undef; + # Only return if we have more than just the size header + return length($patch) > 8 ? $patch : undef; +} + +sub apply_bin_patch { + my ($base_file, $patch_data) = @_; + + open my $fh, '+<:raw', $base_file or die $!; + + # Read the total new size (first 8 bytes) + my $new_total_size = unpack("Q", substr($patch_data, 0, 8)); + my $pos = 8; + + # Apply block updates + while ($pos < length($patch_data)) { + my ($offset, $len) = unpack("QL", substr($patch_data, $pos, 12)); + $pos += 12; + + my $payload = substr($patch_data, $pos, $len); + $pos += $len; + + sysseek($fh, $offset, 0); + syswrite($fh, $payload, $len); + } + + # Clip file to the new size + # This removes any leftover bytes from the old version + truncate($fh, $new_total_size) or die "Could not truncate: $!"; + + close $fh; } sub save_patches { @@ -445,26 +492,6 @@ sub save_patches { $tar->write(TMP_DIFF, 1); # gzip } -sub apply_bin_patch { - my ($obj_file, $patch_file) = @_; - - open my $obj_fh, '+<:raw', $obj_file or die "Cannot open object: $!"; - open my $ptch_fh, '<:raw', $patch_file or die "Cannot open patch: $!"; - - # Header is 12 bytes (Q + L) - while (sysread($ptch_fh, my $header, 12)) { - my ($offset, $len) = unpack("QL", $header); - - # sysread/syswrite to avoid read()'s internal buffers. - sysread($ptch_fh, my $payload, $len); - sysseek($obj_fh, $offset, 0); - syswrite($obj_fh, $payload, $len); - } - - close $obj_fh; - close $ptch_fh; -} - # Convert decimal to a padded 7-char hex string sub to_hex_id { sprintf("%07x", $_[0]) } @@ -523,3 +550,55 @@ sub init_stage { no_chdir => 1 }, $latest_tree_dir); } + +sub touch_file { + my ($path) = @_; + my $dir = dirname($path); + make_path($dir) unless -d $dir; + open my $fh, '>', $path or die "Could not touch $path: $!"; + close $fh; +} + +sub load_registry { + my $reg_path = REG_FILE; + my %reg_data; + + return \%reg_data unless -e $reg_path; + + open my $fh, '<', $reg_path or die "Could not open registry: $!"; + while (my $line = <$fh>) { + chomp $line; + # Split the line: source:target + # We use a limit of 2 to ensure it only splits at the first dot + if ($line =~ /^([a-f0-9]{40}):([a-f0-9]{40})$/i) { + $reg_data{$1} = $2; + } + } + close $fh; + return \%reg_data; +} + +sub write_registry { + my ($reg) = @_; + my $tmp_path = TMP_REG; + + open(my $fh, '>', $tmp_path) or die "Could not open $tmp_path for writing: $!"; + + foreach my $src (sort keys %$reg) { + my $target = $reg->{$src}; + print $fh "$src:$target\n"; + } + + close($fh) or die "Could not close $tmp_path: $!"; +} + +sub hash_file_content { + my ($filename) = @_; + + open(my $fh, '<:raw', $filename) or die "Could not open '$filename': $!"; + + my $sha = Digest::SHA->new(1); + $sha->addfile($fh); + close($fh); + return $sha->hexdigest; +} @@ -0,0 +1,153 @@ +use strict; +use warnings; +use Test::More; +use File::Path qw(remove_tree make_path); +use File::Spec; +use Cwd; +use File::Glob qw(:bsd_glob); + +use constant ROOT => '.vcx'; +use constant HEAD => ROOT . '/head'; +use constant OBJ_DIR => ROOT . '/obj'; +use constant REV_DIR => ROOT . '/rev'; +use constant TMP_DIR => ROOT . '/index'; +use constant TMP_TREE => TMP_DIR . '/tree'; + +# Setup sandbox +my $sandbox = "sandbox"; +remove_tree($sandbox) if -d $sandbox; +make_path($sandbox); + +my $orig_dir = getcwd(); +chdir($sandbox) or die "Cant enter sandbox: $!"; +my $cmd = File::Spec->catfile($orig_dir, "vcx"); + +# Helper functions +sub write_file { + my ($path, $content) = @_; + open my $fh, '>', $path or die $!; + print $fh $content; + close $fh; +} + +sub read_file { + my $path = shift; + open my $fh, '<', $path or return ""; + my $content = <$fh>; + chomp $content if $content; + close $fh; + return $content; +} + +# Tests + +subtest 'Repository Initialization' => sub { + ok(system("perl $cmd init > /dev/null") == 0, "Init exit code 0"); + ok(-d ROOT, "ROOT directory created"); + ok(-e HEAD, "Head file created"); + ok(-d OBJ_DIR, "OBJ_DIR directory created"); + ok(-d REV_DIR, "REV_DIR directory created"); +}; + +subtest 'Adding and Committing Files' => sub { + write_file("test.txt", "Hello, world!"); + + ok(system("perl $cmd add test.txt > /dev/null") == 0, "Add file successful"); + ok(-d TMP_TREE, "Staging tree created"); + + ok(system("perl $cmd commit -m 'Initial commit' > /dev/null") == 0, "Commit successful"); + + my $rev1 = File::Spec->catdir(REV_DIR, "0000001"); + ok(-d $rev1, "Revision 0000001 directory exists"); + + my $msg_file = File::Spec->catfile($rev1, "message"); + is(read_file($msg_file), "Initial commit", "Commit message stored correctly"); +}; + +subtest 'Auto-staging with commit -am' => sub { + # Append content + open my $fh, '>>', "test.txt" or die $!; + print $fh "\nMore content"; + close $fh; + + ok(system("perl $cmd commit -am 'Second commit' > /dev/null") == 0, "Commit -am successful"); + + opendir(my $dh, OBJ_DIR) or die $!; + my @objs = grep { /[a-f0-9]{40}/ } readdir($dh); + closedir($dh); + ok(scalar @objs >= 1, "Content blobs found in object store"); +}; + +subtest 'File Moves and Deletions (Tree Integrity)' => sub { + # Create nested structure + make_path("dirA/dirB"); + write_file("dirA/dirB/shuffle.txt", "Same Content"); + system("perl $cmd add dirA/dirB/shuffle.txt > /dev/null"); + system("perl $cmd commit -m 'Shuffle part 1' > /dev/null"); + + # Move file and delete old dir + make_path("dirC"); + rename("dirA/dirB/shuffle.txt", "dirC/shuffle.txt"); + remove_tree("dirA"); + + ok(system("perl $cmd commit -am 'Shuffle part 2' > /dev/null") == 0, "Commit move successful"); + + my $head = read_file(HEAD); + my ($tree_ptr) = bsd_glob(File::Spec->catfile(REV_DIR, $head, "tree-*")); + my $tree_hash = $tree_ptr =~ s/.*tree-//r; + my $actual_tree_path = File::Spec->catdir(OBJ_DIR, $tree_hash); + + ok(-l File::Spec->catfile($actual_tree_path, "dirC/shuffle.txt"), "New path exists in tree"); + ok(!-d File::Spec->catdir($actual_tree_path, "dirA"), "Deleted path removed from tree"); + + my $link_target = readlink(File::Spec->catfile($actual_tree_path, "dirC/shuffle.txt")); + like($link_target, qr/obj\/[a-f0-9]{40}/, "Tree link points to object store"); +}; + +subtest 'Symlink Handling' => sub { + write_file("target.txt", "Final Destination"); + symlink("target.txt", "link_a"); + symlink("link_a", "link_b"); + + system("perl $cmd add link_b > /dev/null"); + system("perl $cmd commit -m 'Double link' > /dev/null"); + + my $head = read_file(HEAD); + my ($tree_ptr) = bsd_glob(File::Spec->catfile(REV_DIR, $head, "tree-*")); + my $staged_link = File::Spec->catfile(OBJ_DIR, $tree_ptr =~ s/.*tree-//r, "link_b"); + + is(readlink($staged_link), "link_a", "Symlink-to-symlink targets preserved literally"); +}; + +subtest 'Edge Cases: Content Reversion' => sub { + # Clear the staging area to ensure a "Pure" tree + remove_tree(TMP_DIR); + make_path(TMP_TREE); + + make_path("revert_test"); + write_file("revert_test/data.txt", "Version A"); + + # Commit State A + system("perl $cmd add revert_test/data.txt > /dev/null"); + system("perl $cmd commit -m 'State A' > /dev/null"); + my $tree_v1 = (bsd_glob(File::Spec->catfile(REV_DIR, read_file(HEAD), "tree-*")))[0]; + + # Commit State B + write_file("revert_test/data.txt", "Version B"); + system("perl $cmd commit -am 'State B' > /dev/null"); + + # Revert to State A + write_file("revert_test/data.txt", "Version A"); + system("perl $cmd commit -am 'Back to State A' > /dev/null"); + my $tree_v3 = (bsd_glob(File::Spec->catfile(REV_DIR, read_file(HEAD), "tree-*")))[0]; + + # Extract hashes and compare + my $hash1 = $tree_v1 =~ s/.*tree-//r; + my $hash3 = $tree_v3 =~ s/.*tree-//r; + + is($hash1, $hash3, "Tree hashes match after index reset and content restoration"); +}; + +# Cleanup +chdir($orig_dir); +done_testing(); diff --git a/vcx_patch.t b/vcx_patch.t new file mode 100644 index 0000000..d2b813f --- /dev/null +++ b/vcx_patch.t @@ -0,0 +1,104 @@ +#!/usr/bin/perl +use strict; +use warnings; +use Test::More; +use File::Temp qw(tempfile); +use File::Spec; + +# Overrides exit and silences the 'Usage' print during the 'do' call. +BEGIN { + *CORE::GLOBAL::exit = sub { }; +} + +{ + local @ARGV = (); + open my $oldout, ">&STDOUT"; + open STDOUT, ">", File::Spec->devnull(); + eval { do './vcx' }; + open STDOUT, ">&", $oldout; +} + +subtest 'Binary Patching: Shrink & Truncate' => sub { + my ($fh_old, $old_path) = tempfile(); + my ($fh_new, $new_path) = tempfile(); + + # 8KB of 'A' shrinking to 6 bytes + print $fh_old "A" x 8192; close $fh_old; + print $fh_new "SHRINK"; close $fh_new; + + my $patch = main::make_bin_patch($new_path, $old_path); + ok(defined($patch), "Patch generated for shrinking file"); + + main::apply_bin_patch($old_path, $patch); + + is(-s $old_path, 6, "File size correctly truncated to 6 bytes"); + + open my $check, '<:raw', $old_path; + my $content = <$check>; + is($content, "SHRINK", "Content matches perfectly (no stale trailing data)"); + close $check; +}; + +subtest 'Binary Patching: Growth & Extension' => sub { + my ($fh_old, $old_path) = tempfile(); + my ($fh_new, $new_path) = tempfile(); + + print $fh_old "Tiny"; + close $fh_old; + + # Create a 5KB string to cross a block boundary (4096) + my $big_data = "EXTENDED" . ("." x 5000); + print $fh_new $big_data; + close $fh_new; + + my $patch = main::make_bin_patch($new_path, $old_path); + main::apply_bin_patch($old_path, $patch); + + is(-s $old_path, 5008, "File size correctly extended"); + + open my $check, '<:raw', $old_path; + my $result = do { local $/; <$check> }; + is($result, $big_data, "Extended content matches perfectly"); + close $check; +}; + +subtest 'Binary Patching: Sparse Block Edits' => sub { + my ($fh_old, $old_path) = tempfile(); + my ($fh_new, $new_path) = tempfile(); + + # Create three 4KB blocks + my $data = ("X" x 4096) . ("Y" x 4096) . ("Z" x 4096); + print $fh_old $data; close $fh_old; + + # Modify only the middle block ('Y' block) + substr($data, 5000, 10) = "MODIFIED!!"; + print $fh_new $data; close $fh_new; + + my $patch = main::make_bin_patch($new_path, $old_path); + + # Header (8) + Block Header (12) + Block (4096) = ~4116 bytes + ok(length($patch) < 4200, "Patch is efficient (only captured the changed block)"); + + main::apply_bin_patch($old_path, $patch); + + open my $check, '<:raw', $old_path; + my $final = do { local $/; <$check> }; + is(substr($final, 5000, 10), "MODIFIED!!", "Middle block update applied"); + is(substr($final, 0, 10), "XXXXXXXXXX", "First block preserved"); + is(substr($final, -10), "ZZZZZZZZZZ", "Last block preserved"); + close $check; +}; + +subtest 'Binary Patching: No Change Identity' => sub { + my ($fh_old, $old_path) = tempfile(); + my ($fh_new, $new_path) = tempfile(); + + my $data = "Same data" x 50; + print $fh_old $data; close $fh_old; + print $fh_new $data; close $fh_new; + + my $patch = main::make_bin_patch($new_path, $old_path); + is($patch, undef, "No patch generated for identical files"); +}; + +done_testing(); |