From c91c3069c0d2885ffa9abd0dd129a9c1101abbb9 Mon Sep 17 00:00:00 2001
From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Sun, 3 May 2020 22:06:25 +0100
Subject: [PATCH] nailing-cargo: Remainder converted to Perl..., wip

Signed-off-by: Ian Jackson <ijackson@chiark.greenend.org.uk>
---
 nailing-cargo | 100 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 100 insertions(+)

diff --git a/nailing-cargo b/nailing-cargo
index 9bcdfed..4d3d0f7 100755
--- a/nailing-cargo
+++ b/nailing-cargo
@@ -42,6 +42,7 @@ use strict;
 use TOML;
 use POSIX;
 use Fcntl qw(LOCK_EX);
+use File::Compare;
 
 my $self = $0;  $self =~ s{^.*/(?=.)}{};
 
@@ -185,6 +186,93 @@ sub readorigs () {
     }
 }
 
+sub calculate () {
+    foreach my $mf (keys %manifests) {
+	my $toml = $manifest{$mf};
+	foreach my $k (qw(dependencies build-dependencies dev-dependencies)) {
+	    my $deps = $toml->{$k};
+	    next unless $deps;
+	    foreach my $p (keys %packagemap) {
+		my $info = $deps->{$p};
+		next unless $info;
+		$info = { } unless ref $info;
+		delete $info->{version};
+		$info->{path} = $packagemap{$p};
+	    }
+	}
+	my $nailing = "$mf.nailing~";
+	unlink $nailing or $!==ENOENT or die "$0: remove old $nailing: $!\n";
+	open N, '>', $nailing or die "$0: create new $nailing: $!\n";
+	print N, to_toml($toml) or die "$0: write new $nailing: $!\n";
+	close N or die "$0: close new $nailing: $!\n";
+    }
+}
+
+END {
+    if ($want_uninstall) {
+	local ($?);
+	foreach my $mf (keys %manifests) {
+	    eval { uninstall1($mf, 0); 1; }
+		or warn "$0: failed to revert $mf: $@\n";
+	}
+    }
+}
+
+sub makebackups () {
+    foreach my $mf (keys %manifests) {
+	link "$mf", "$mf.unnailed" or $!==EEXIST
+	    or die "$self: make backup link $mf.unnailed: $!\n";
+    }
+}
+
+sub install () {
+    foreach my $mf (keys %manifests) {
+	my $nailing = "$mf.nailing~";
+	my $nailed  = "$mf.nailed~";
+	my ($use, $rm);
+	my $diff = compare($nailing, $nailed);
+	die "$0: compare $nailing and $nailed: $!" if $diff<0;
+	if ($diff) {
+	    $use = $nailing;
+	    $rm  = $nailed;
+	} else {
+	    $use = $nailed;
+	    $rm  = $nailing;
+	}
+	rename $use, $mf or die "$0: install nailed $use: $!\n";
+	unlink $rm or $!==ENOENT or die "$0: remove old $rm: $!\n";
+    }
+}
+
+sub invoke () {
+    my $r = system @ARGV;
+    if (!$r) {
+	return 0;
+    } elsif ($r<0) {
+	print STDERR "$0: could not execute $ARGV[0]: $!\n";
+	return 127;
+    } elsif ($r & 0xff00) {
+	print STDERR "$0: $ARGV[0] failed (exit status $r)\n";
+	return $r >> 8;
+    } else {
+	print STDERR "$0: $ARGV[0] died due to signal! (wait status $r)\n";
+	return 125;
+    }
+}
+
+sub uninstall1 ($$) {
+    my ($mf, $enoentok) = @_;
+    my $unnailed = "$mf.unnailed";
+    rename $unnailed, $mf or ($enoentok && $!==ENOENT)
+	die "$0: rename $unnailed back to $mf: $!\n";
+}
+
+sub uninstall () {
+    foreach my $mf (keys %manifests) {
+	uninstall1($mf,0);
+    }
+}
+
 while (@ARGV && $ARGV[0] =~ m/^-/) {
     $_ = shift @ARGV;
     last if m/^--$/;
@@ -193,6 +281,18 @@ while (@ARGV && $ARGV[0] =~ m/^-/) {
 takelock();
 readnail();
 readorigs();
+calculate();
+$want_uninstall = 1;
+makebackups();
+install();
+
+my $estatus = invoke();
+
+uninstall();
+$want_uninstall = 1;
+
+exit $estatus;
+
 
 use Data::Dumper;
 print STDERR Dumper(\%packagemap, \%manifests);
-- 
2.30.2