nailing-cargo: Partially converted to Perl...

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

diff --git a/nailing-cargo b/nailing-cargo
index 0d274dd1bc87fb5186a6fda004b7e330fc220274..3b673d83807ea4a71f356571d2664596abcf249a 100755 (executable)
--- a/nailing-cargo
+++ b/nailing-cargo
@@ -1,8 +1,8 @@
-#!/bin/bash
+#!/usr/bin/perl -w
 
 #    nailing-cargo: wrapper to use unpublished local crates
 #
-#    Copyright (C) 2019 Ian Jackson
+#    Copyright (C) 2019-2020 Ian Jackson
 #
 #    This program is free software: you can redistribute it and/or modify
 #    it under the terms of the GNU Affero General Public License as
@@ -17,14 +17,11 @@
 #    You should have received a copy of the GNU Affero General Public License
 #    along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
-set -e
-
 # example usages:
-#   ../nailing-cargo/nailing-cargo make
+#   ../nailing-cargo/nailing-caretwgo make
 #   ../nailing-cargo/nailing-cargo cargo build
 #   CARGO='../nailing-cargo/nailing-cargo cargo' make
 
-
 # Why do we need this ?
 #
 #  https://github.com/rust-lang/cargo/issues/6713
@@ -32,6 +29,173 @@ set -e
 #  https://github.com/rust-lang/cargo/issues/1481
 
 
+#: Cargo.nail:
+#
+#    [packages]
+#    package = subdir
+#    package = { subdir = ... }
+#
+#    [subdirs]
+#    subdir
+
+use strict;
+use TOML;
+use POSIX;
+use Fcntl qw(LOCK_EX);
+use Cwd;
+
+my $self = $0;  $self =~ s{^.*/(?=.)}{};
+
+my $worksphere = fastcwd // die "$self: Cwd::fastcwd failed: $!\n";
+$worksphere =~ s{/[^/]+}{} or die "$self: cwd \`$worksphere' unsupported!\n";
+our $lockfile = "../.nailing-cargo-sphere.lock";
+
+our @configs;
+
+sub read_or_enoent ($) {
+    my ($fn) = @_;
+    if (!open R, '<', $fn) {
+       return undef if $!==ENOENT;
+       die "$self: open $fn: $!\n";
+    }
+    local ($/) = undef;
+    my ($r) = <R> // die "$self: read $fn: $!\n";
+    $r;
+}
+
+sub toml_or_enoent ($$) {
+    my ($f,$what) = @_;
+    my $toml = read_or_enoent($f) // return;
+    my ($toml,$e) = from_toml($toml);
+    die "$self: parse TOML: $what: $f: $e\n" if defined $e;
+    $toml;
+}
+
+sub load1config ($) {
+    my ($f) = @_;
+    my $toml = toml_or_enoent($f, "config file");
+    push @configs, $toml if defined $toml;
+}
+
+sub loadconfigs () {
+    my $cfgleaf = ".nailing-cargo-cfg.toml";
+    load1config("/etc/nailing-cargo/cfg.toml");
+    load1config("$worksphere/$cfgleaf");
+    load1config("$HOME/$cfgleaf") if defined $HOME;
+}
+
+sub getcfg ($$) {
+    my ($k, $def) = @_;
+    foreach my $cfg (@configs) {
+       my $v = $cfg{$k};
+       return $v if defined $v;
+    }
+    return $df;
+}
+
+sub lock () {
+    for (;;) {
+       open LOCK, ">", $lockfile or die "$0: open/create $lockfile: $!\n";
+       flock LOCK, LOCK_EX or die "$0: lock $lockfile: $!\n";
+       my @fstat = stat LOCK or die "$0: fstat: $!\n";
+       my @stat  = stat $lockfile;
+       if (!@stat) {
+           next if $! == ENOENT;
+           die "$0: stat $lockfile: $!\n";
+       }
+       last if "@fstat[0..5]" == "@stat[0..5]";
+    }
+}
+sub unlock () {
+    unlink $lockfile or die "$0: removing lockfile: $!\n";
+}
+
+our $nail;
+
+sub readnail () {
+    my $nailfile = "../Cargo.nail";
+    open N, '<', $nailfile or die "$0: open $nailfile: $!\n";
+    local ($/) = undef;
+    my $toml = <N> // die "$0: read $nailfile: $!";
+    my $transformed;
+    if ($toml !~ m{^\s*\[/}m &&
+       $toml !~ m{^[^\n\#]*\=}m &&
+       # old non-toml syntax
+       $toml =~ s{^[ \t]*([-_0-9a-z]+)[ \t]+(\S+)[ \t]*$}{$1 = $2}mig) {
+       $toml =~ s{^}{[packages\]\n};
+       $transformed = 1;
+    }
+    my $e;
+    ($nail,$e) = from_toml($toml);
+    if (defined $e) {
+       if ($transformed) {
+           $toml =~ s/^/    /mg;
+           print STDERR "$self: $nailfile transformed into TOML:\n$toml\n";
+       }
+       die "$0: parse $nailfile: $e\n";
+    }
+    die unless defined $nail;
+}
+
+our %manifests;
+our %packagemap;
+
+sub read_manifest ($) {
+    my ($subdir) = @_;
+    my $manifest = "../$subdir/Cargo.toml";
+    if (defined $manifests{$manifesst}) {
+       print STDERR
+"$self: warning: $subdir: specified more than once!\n";
+       return undef;
+    }
+    foreach my $try ("$manifest.unnailed", "$manifest") {
+       my $toml = toml_or_enoent($try, "package manifest") // next;
+       my $p = $toml->{package}{name};
+       if (!defined $p) {
+           print STDERR
+"$self: warning: $subdir: missing package.name in $try, ignoring\n";
+           next;
+       }
+       $manifests{$manifest} = $toml;
+       return $p;
+    }
+    return undef;
+}
+
+sub readorigs () {
+    foreach my $p (keys %{ $nail->{packages} }) {
+       my $v = $nail->{packages}{$p};
+       my $subdir = ref($v) ? $v->{subdir} : $v;
+       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";
+       }
+       die if defined $packagemap{$p};
+       $packagemap{$p} = $subdir;
+    }
+    foreach my $subdir (@{ $nail->{subdirs} }) {
+       my $gotpackage = read_manifest($subdir);
+       if (!defined $gotpackage) {
+           print STDERR
+ "$self: warning: ignoring subdir $subdir which has no Cargo.toml\n";
+           next;
+       }
+       $packagemap{$gotpackage} //= $subdir;
+    }
+}
+
+while (@ARGV && $ARGV[0] =~ m/^-/) {
+    $_ = shift @ARGV;
+    last if m/^--$/;
+}
+
+lock();
+readnail();
+readorigs();
+
+__DATA__
+
 lock=${PWD%/*}/.nail.lock
 if [ "x$NAILING_CARGO" != "x$lock" ]; then
        NAILING_CARGO=$lock \
@@ -42,7 +206,7 @@ exec 203<../Cargo.nail
 f=Cargo.toml
 
 sed='
-/^ *\[dependencies\]/,/^ \[/{
+/^ *\[\(build-\)\?dependencies\]/,/^ \[/{
 '
 
 if test -e ../Cargo.nail-env; then