#!/usr/bin/perl use strict; use warnings; use File::Path qw(make_path); use File::Copy qw(copy); use File::Find; use File::Basename; use File::Glob qw(:bsd_glob); use File::Spec; use Digest::SHA qw(sha1_hex); use POSIX qw(strftime); use constant VCX_DIR => '.vcx'; use constant OBJ_DIR => VCX_DIR . '/objs'; # Latest version of a file use constant REV_DIR => VCX_DIR . '/revs'; # Commits use constant TREE_DIR => VCX_DIR . '/trees'; # Trees use constant HEAD_FILE => VCX_DIR . '/head'; # Current commit ID # Staging area use constant TMP_DIR => VCX_DIR . '/index'; use constant TMP_TREE => TMP_DIR . '/tree'; use constant TMP_DIFF => TMP_DIR . '/deltas'; use constant TMP_META_FILE => VCX_DIR . '/meta'; use constant TMP_TREE_FILE => VCX_DIR . '/tree'; my $cmd = shift @ARGV // ''; my @args = @ARGV; if ($cmd eq 'init') { run_init(); } elsif ($cmd eq 'status') { run_status(); } elsif ($cmd eq 'add') { die "Usage: $0 add [path1] [path2] ...\n" unless @args; run_add(@args); } elsif ($cmd eq 'commit') { # If the user typed: vcx commit "My message" # $args[0] will contain the message. If not, it's empty. my $message = join(' ', @args); run_commit($message); } elsif ($cmd eq 'log') { run_log(); } else { print "Usage: $0 [init|status|add|commit|log]\n"; exit 1; } sub run_init { make_path(OBJ_DIR, REV_DIR, TREE_DIR); my $initial_hex = to_hex_id(0); my $rev0_dir = File::Spec->catfile(REV_DIR, $initial_hex); make_path($rev0_dir); write_file(HEAD_FILE, "$initial_hex\n"); # Baseline tree (empty) my $empty_tree_hash = sha1_hex(""); write_file(File::Spec->catfile($rev0_dir, "tree"), "$empty_tree_hash\n"); make_path(File::Spec->catdir(TREE_DIR, $empty_tree_hash)); open my $mfh, '>', File::Spec->catfile($rev0_dir, "message"); close $mfh; print "Initialized repository.\n"; } sub run_status { open my $fh, '<', HEAD_FILE or die "VCX not initialized.\n"; my $head = <$fh>; chomp $head; close $fh; print "On revision [$head]\n"; my $tree_hash_path = File::Spec->catfile(REV_DIR, $head, "tree"); open my $tp_fh, '<', $tree_hash_path or die $!; my $tree_hash = <$tp_fh>; chomp $tree_hash; close $tp_fh; my $latest_tree_dir = File::Spec->catdir(TREE_DIR, $tree_hash); # Pass 1: Workspace -> History (Detects New and Modified) find({ wanted => sub { return if $File::Find::name =~ /^\.\/\Q${\VCX_DIR}\E/; return if -d $File::Find::name; my $rel = File::Spec->abs2rel($File::Find::name, '.'); $rel =~ s|^\./||; my $base_in_tree = File::Spec->catfile($latest_tree_dir, $rel); if (-e $base_in_tree || -l $base_in_tree) { my $obj_in_store = readlink($base_in_tree); if (!compare_files($File::Find::name, $obj_in_store)) { my $staged = check_staged_status($rel, 'M') ? " (staged)" : ""; print "[M] $rel$staged\n"; } } else { my $staged = check_staged_status($rel, 'N') ? " (staged)" : ""; print "[N] $rel$staged\n"; } }, no_chdir => 1 }, '.'); # Pass 2: History -> Workspace (Detects Deletions) if (-d $latest_tree_dir) { find({ wanted => sub { return if -d $_; my $rel = File::Spec->abs2rel($_, $latest_tree_dir); # If it's in the commit tree but GONE from the workspace if (!-e $rel && !-l $rel) { my $staged = check_staged_status($rel, 'D') ? " (staged)" : ""; print "[D] $rel$staged\n"; } }, no_chdir => 1 }, $latest_tree_dir); } } sub check_staged_status { my ($path, $type) = @_; my $path_hash = sha1_hex($path); my $tmp_link = File::Spec->catfile(TMP_TREE, $path); # If the file is in history but the symlink not in TMP_DIR, it's staged for deletion. if ($type eq 'D') { return !-e $tmp_link && !-l $tmp_link; } # If it's a new file, it's staged if the symlink exists in TMP_DIR if ($type eq 'N') { return (-e $tmp_link || -l $tmp_link); } if ($type eq 'M') { # Check if a patch exists in the temporary diff directory. # We look for any file starting with the path_hash in TMP_DIFF. my $patch_pattern = File::Spec->catfile(TMP_DIFF, "$path_hash.*.patch"); my @patches = bsd_glob($patch_pattern); return scalar @patches > 0; } return 0; } sub run_add { my @targets = @_; make_path(TMP_TREE, TMP_DIFF); open my $fh_h, '<', HEAD_FILE or die $!; my $head = <$fh_h>; chomp $head; close $fh_h; my $latest_tree_hash_path = File::Spec->catfile(REV_DIR, $head, "tree"); open my $tp_fh, '<', $latest_tree_hash_path or die $!; my $latest_tree_hash = <$tp_fh>; chomp $latest_tree_hash; close $tp_fh; my $latest_tree_dir = File::Spec->catdir(TREE_DIR, $latest_tree_hash); my $next_id_hex = to_hex_id(from_hex_id($head) + 1); my @entries; open my $afh, '>>', TMP_META_FILE or die $!; init_stage($latest_tree_dir, \@entries); foreach my $input (@targets) { my @expanded = bsd_glob($input); foreach my $t (@expanded) { find({ wanted => sub { if ($File::Find::name =~ /\/\Q${\VCX_DIR}\E$/ || $_ eq VCX_DIR) { $File::Find::prune = 1; return; } return if -d $_; my $rel = $File::Find::name =~ s|^\./||r; push @entries, $rel; my $staged_path = File::Spec->catfile(TMP_TREE, $rel); my $prev_link = File::Spec->catfile($latest_tree_dir, $rel); # CASE 1: Regular File if (-f $File::Find::name && !-l $File::Find::name) { return if -e $staged_path; # Already staged if (-l $prev_link) { my $obj_in_head = readlink($prev_link); return if compare_files($File::Find::name, $obj_in_head); } # Generate deltas if modified my $obj_name = sha1_hex($rel); my $obj_path = File::Spec->catfile(OBJ_DIR, $obj_name); if (-e $obj_path) { my $p_path = File::Spec->catfile(TMP_DIFF, "$obj_name.$next_id_hex.patch"); if (-T $_) { system("diff -u '$obj_path' '$_' > '$p_path'") if system("diff -q '$obj_path' '$_' > /dev/null") != 0; } else { make_bin_patch($_, $obj_path, $p_path); } } stage_file($File::Find::name, $obj_path, $staged_path); print $afh "$rel\n"; # Record in meta file for the commit command } # CASE 2: Symlink elsif (-l $File::Find::name) { my $target = readlink($File::Find::name); if (-l $prev_link) { return if readlink($prev_link) eq $target; } if (-l $staged_path) { return if readlink($staged_path) eq $target; } stage_link($File::Find::name, $staged_path); } }, no_chdir => 1, }, $t); } } close $afh; my $tree_data = join("\n", sort @entries); my $tree_hash = sha1_hex($tree_data); write_file(TMP_TREE_FILE, $tree_hash); } sub run_commit { my ($message) = @_; my $content_changed = -s TMP_META_FILE; open my $th_fh, '<', TMP_TREE_FILE or die $!; my $staged_hash = <$th_fh>; chomp $staged_hash; close $th_fh; my $tree_path = File::Spec->catdir(TREE_DIR, $staged_hash); my $tree_exists = -d $tree_path; if ($tree_exists && !$content_changed) { print "Nothing to commit."; File::Path::remove_tree(TMP_DIR) if -d TMP_DIR; return; } if (!$message || $message eq "") { $message = launch_editor(); die "Commit aborted: empty message.\n" unless $message =~ /\S/; } # Prepare IDs open my $fh_h, '<', HEAD_FILE or die "Not a repository.\n"; my $old_head = <$fh_h>; chomp $old_head; close $fh_h; my $next_id_hex = to_hex_id(from_hex_id($old_head) + 1); my $rev_dir = File::Spec->catfile(REV_DIR, $next_id_hex); make_path($rev_dir); # Save file to store if (-e TMP_META_FILE) { open my $mfh, '<', TMP_META_FILE or die $!; while (my $rel = <$mfh>) { chomp $rel; my $obj_name = sha1_hex($rel); my $obj_path = File::Spec->catfile(OBJ_DIR, $obj_name); copy($rel, $obj_path) or die "Failed to update store for $rel: $!"; } close $mfh; } # Save tree (snapshots the structure) if (!$tree_exists) { make_path($tree_path); rename(TMP_TREE, $tree_path) or die "Failed to save directories: $!"; } rename(TMP_TREE_FILE, File::Spec->catfile($rev_dir, "tree")) or die "Failed to save tree pointer to revision: $!"; # Move deltas if (-d TMP_DIFF) { my $dest_diff_dir = File::Spec->catfile($rev_dir, "deltas"); rename(TMP_DIFF, $dest_diff_dir) or die "Failed to move deltas to $dest_diff_dir: $!"; } write_file(File::Spec->catfile($rev_dir, "message"), "$message\n"); write_file(HEAD_FILE, "$next_id_hex\n"); # Update head File::Path::remove_tree(TMP_DIR) if -d TMP_DIR; my ($subject) = split(/\n/, $message); print "Committed revision [$next_id_hex]: $subject\n"; } sub run_log { open my $fh_h, '<', HEAD_FILE or die "Not a repository.\n"; my $head = <$fh_h>; chomp $head; close $fh_h; # Setup pager my $pager = $ENV{PAGER} || 'less -R'; open(my $pipe, "| $pager") or die "Can't pipe to $pager: $!"; my $old_fh = select($pipe); print "Revision History (HEAD: $head)\n\n"; my $rev_num = from_hex_id($head); while ($rev_num > 0) { my $hex_id = to_hex_id($rev_num); my $rev_dir = File::Spec->catfile(REV_DIR, $hex_id); # Stop if we hit a gap in history or the beginning last unless -d $rev_dir; # Stat index 9 is the last modification time my $mtime = (stat($rev_dir))[9]; my $date_str = strftime("%a %b %e %H:%M:%S %Y", localtime($mtime)); my $msg_file = File::Spec->catfile($rev_dir, "message"); my $message = "[No message]"; if (-e $msg_file) { open my $mfh, '<', $msg_file; $message = do { local $/; <$mfh> } // "[Empty message]"; $message =~ s/^\s+|\s+$//g; # Trim whitespace close $mfh; } print "commit $hex_id\n"; print "Date: $date_str\n"; print "\n $message\n\n"; $rev_num--; } close $pipe; select($old_fh); } sub stage_file { my ($src, $obj, $tmp) = @_; make_path(dirname($tmp)); # We want the link inside tmp/ to point to "obj/HASH" # relative to project root. my $rel_target = $obj; unlink($tmp) if -e $tmp || -l $tmp; symlink($rel_target, $tmp) or die "Failed to symlink $tmp: $!"; print "[Staged File] $src\n"; } sub stage_link { my ($src, $tmp) = @_; my $target = readlink($src); make_path(dirname($tmp)); unlink($tmp) if -e $tmp || -l $tmp; # For workspace symlinks, we clone the target symlink($target, $tmp) or die "Failed to symlink $tmp: $!"; print "[Staged link] $src -> $target\n"; } sub stage_deletions { my ($target) = @_; open my $fh, '<', HEAD_FILE or die "Not a repository.\n"; my $head = <$fh>; chomp $head; close $fh; my $latest_tree = File::Spec->catfile(REV_DIR, $head, "tree"); my $search = ($target eq '.') ? $latest_tree : File::Spec->catfile($latest_tree, $target); return unless -d $search || -e $search; find({ wanted => sub { return if -d $_; # Skip directories # '$_' is the file inside the commit tree # '$rel' is its path relative to the commit root my $rel = File::Spec->abs2rel($_, $latest_tree); # File exists in history but is gone from the workspace if (!-e $rel) { # If we have a staged link/file, remove it. my $tmp_link = File::Spec->catfile(TMP_DIR, $rel); if (-l $tmp_link || -e $tmp_link) { unlink($tmp_link); print "Staged deletion: $rel\n"; } } }, no_chdir => 1 }, $search); } sub make_bin_patch { my ($new_file, $old_file, $patch_out) = @_; 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 $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); # Stop when we've processed the entire new file last if $read_new == 0 && $read_old == 0; # Handle file size differences (padding 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) { if (!$f_out) { make_path(dirname($patch_out)); open $f_out, '>:raw', $patch_out or die "Cannot create patch: $!"; } # Header: [64-bit offset][32-bit length][data] my $header = pack("QL", $offset, length($buf_old)); syswrite($f_out, $header . $buf_old); } $offset += $blk_size; } close $f_new; close $f_old; close $f_out if $f_out; } 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; } sub compare_files { my ($file1, $file2) = @_; return 0 unless -s $file1 == -s $file2; open my $fh1, '<:raw', $file1 or return 0; open my $fh2, '<:raw', $file2 or return 0; my $blk_size = 4096; while (1) { my $read1 = sysread($fh1, my $buf1, $blk_size); my $read2 = sysread($fh2, my $buf2, $blk_size); return 0 if $buf1 ne $buf2; last if $read1 == 0; } return 1; } # Convert decimal to a padded 7-char hex string sub to_hex_id { sprintf("%07x", $_[0]) } # Convert hex back to decimal sub from_hex_id { hex($_[0]) } sub launch_editor { my $editor = $ENV{EDITOR} || $ENV{VISUAL} || 'vi'; my $temp_msg_file = File::Spec->catfile(VCX_DIR, "COMMIT_EDITMSG"); open my $fh, '>', $temp_msg_file or die "Cannot create temp message file: $!"; print $fh "\n# Enter the commit message for your changes.\n"; print $fh "# Lines starting with '#' will be ignored.\n"; close $fh; system("$editor \"$temp_msg_file\""); my $final_msg = ""; if (-e $temp_msg_file) { open my $rfh, '<', $temp_msg_file or die $!; while (my $line = <$rfh>) { next if $line =~ /^#/; # Strip out the helper comments $final_msg .= $line; } close $rfh; unlink($temp_msg_file); # Clean up } $final_msg =~ s/^\s+|\s+$//g; # Trim whitespace return $final_msg; } 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 init_stage { my ($latest_tree_dir, $entries_ref) = @_; find({ wanted => sub { return if -d _; my $rel = File::Spec->abs2rel($_, $latest_tree_dir); my $staged_path = File::Spec->catfile(TMP_TREE, $rel); make_path(dirname($staged_path)); my $target = readlink($_); symlink($target, $staged_path) or die "Failed to link $rel: $!"; push @$entries_ref, $rel; }, no_chdir => 1 }, $latest_tree_dir); }