nailing-cargo: Bugfixes etc.

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

diff --git a/nailing-cargo b/nailing-cargo
index db7b72a5419213e77f80efc8856da9ed50b7d316..92bd8ce8ba120946351c5448115948d4e55da41a 100755 (executable)
--- a/nailing-cargo
+++ b/nailing-cargo
@@ -52,6 +52,7 @@ $worksphere =~ s{/[^/]+}{} or die "$self: cwd \`$worksphere' unsupported!\n";
 our $lockfile = "../.nailing-cargo-sphere.lock";
 
 our @configs;
+our ($verbose,$noact,$dump);
 
 sub read_or_enoent ($) {
     my ($fn) = @_;
@@ -125,6 +126,11 @@ sub readnail () {
        # old non-toml syntax
        $toml =~ s{^[ \t]*([-_0-9a-z]+)[ \t]+(\S+)[ \t]*$}{$1 = \"$2\"}mig) {
        $toml =~ s{^}{[packages\]\n};
+       my @sd;
+       $toml =~ s{^[ \t]*\-[ \t]*\=[ \t]*(\"[-_0-9a-z]+\"\n?)$}{
+               push @sd, $1; '';
+           }mige;
+       $toml = "subdirs = [\n".(join '', map { "$_\n" } @sd)."]\n".$toml;
        $transformed = 1;
     }
     my $e;
@@ -145,6 +151,7 @@ our %packagemap;
 sub read_manifest ($) {
     my ($subdir) = @_;
     my $manifest = "../$subdir/Cargo.toml";
+    print STDERR "$self: reading $manifest...\n" if $verbose>=3;
     if (defined $manifests{$manifest}) {
        print STDERR
 "$self: warning: $subdir: specified more than once!\n";
@@ -171,7 +178,7 @@ sub readorigs () {
        my $gotpackage = read_manifest($subdir) // '<nothing!>';
        if ($gotpackage ne $p) {
            print STDERR
- "$self: warning: honouring Cargo.nail [packages.$subdir]=$p even though $subdir contains package $gotpackage!\n";
+ "$self: warning: honouring Cargo.nail packages.$subdir=$p even though $subdir contains package $gotpackage!\n";
        }
        die if defined $packagemap{$p};
        $packagemap{$p} = $subdir;
@@ -230,7 +237,7 @@ sub makebackups () {
 sub install () {
     foreach my $mf (keys %manifests) {
        my $nailing = "$mf.nailing~";
-       my $nailed  = "$mf.nailed~";
+       my $nailed  = "$mf.nailed~"; $nailed =~ s{/([^/]+)$}{/.$1} or die;
        my ($use, $rm);
        my $diff;
        if (open NN, '<', $nailed) {
@@ -249,6 +256,7 @@ sub install () {
        }
        rename $use, $mf or die "$self: install nailed $use: $!\n";
        unlink $rm or $!==ENOENT or die "$self: remove old $rm: $!\n";
+       print STDERR "Nailed $mf\n" if $verbose>=2;
     }
 }
 
@@ -283,13 +291,38 @@ sub uninstall () {
 
 while (@ARGV && $ARGV[0] =~ m/^-/) {
     $_ = shift @ARGV;
-    last if m/^--$/;
+    last if m{^--$};
+    if (m{^-[^-]}) {
+       while (m{^-.}) {
+           if (s{^-v}{-}) {
+               $verbose++;
+           } elsif (s{^-n}{-}) {
+               $noact++;
+           } elsif (s{^-D}{-}) {
+               $dump++;
+           } else {
+               die "$self: unknown short option(s) $_\n";
+           }
+       }
+    } else {
+       die "$self: unknown long option $_\n";
+    }
 }
 
 takelock();
 readnail();
 readorigs();
 calculate();
+
+if ($dump) {
+    eval '
+        use Data::Dumper;
+        print STDERR Dumper(\%manifests, \%packagemap);
+    ' or die $@;
+}
+
+exit 0 if $noact;
+
 $want_uninstall = 1;
 makebackups();
 install();