nailing-cargo: Remainder converted to Perl..., wip

Signed-off-by: Ian Jackson <ijackson@chiark.greenend.org.uk>

diff --git a/nailing-cargo b/nailing-cargo
index 9bcdfeda51e06675de36d16ec1d3a33a6c2d740d..4d3d0f7d4e6590a758f7bb7964cf095cfb1862a8 100755 (executable)
--- 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);