From 1a56cad485595edad9fba0340c72b1126b2258f4 Mon Sep 17 00:00:00 2001
From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Sun, 10 May 2020 12:36:02 +0100
Subject: [PATCH] nailing-cargo: wip Cargo.lock manipulation, config rework

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

diff --git a/nailing-cargo b/nailing-cargo
index eecf01c..e25b3c6 100755
--- a/nailing-cargo
+++ b/nailing-cargo
@@ -66,10 +66,13 @@ use Fcntl qw(LOCK_EX);
 use File::Compare;
 use TOML::Tiny::Faithful;
 
-our $worksphere = getcwd() // die "$self: getcwd failed: $!\n";
+our $src_absdir = getcwd() // die "$self: getcwd failed: $!\n";
+
+our $worksphere = $src_absdir;
 $worksphere =~ s{/([^/]+)$}{}
   or die "$self: cwd \`$worksphere' unsupported!\n";
-our $subdir = $1;
+our $subdir = $1; # leafname
+
 our $lockfile = "../.nailing-cargo.lock";
 our $oot_cargo_lock_faff;
 
@@ -140,6 +143,47 @@ sub unlock () {
 
 our $nail;
 
+sub badcfg {
+  my $m = pop @_;
+  $" = '.';
+  die "$self: config key \`@_': $m\n";
+}
+
+sub cfg_uc {
+  my $v = $nail;
+  foreach my $k (@_) {
+    last unless defined $v;
+    ref($v) eq 'HASH' or badcfg @, "parent key \`$k' is not a hash";
+    $v = $v->{$k};
+  }
+  return $v;
+}
+
+sub cfg {
+  my $exp = shift @_;
+  my $v = cfg_uc @_;
+  my $got = ref($v) || 'scalar';
+  return $v if !defined($v) || $got eq $exp;
+  badcfg @_, "found \L$got\E, expected \L$exp\E";
+  # ^ toml doesn't make refs to scalars, so this is unambiguous
+}
+
+sub cfgn {
+  my $exp = shift @_;
+  cfg $exp, @_ // badcfg @_, "missing";
+}
+
+sub cfgs  { cfg  'scalar', @_ }
+sub cfgsn { cfgn 'scalar', @_ }
+
+sub cfgn_list {
+  my $l = cfg 'ARRAY', @_;
+  foreach my $x (@l) {
+    !ref $x or badcfg @_, "list contains non-scalar element";
+  }
+  @$l
+}
+
 sub readnail () {
   my $nailfile = "../Cargo.nail";
   open N, '<', $nailfile or die "$self: open $nailfile: $!\n";
@@ -252,23 +296,34 @@ sub calculate () {
     close N or die "$self: close new $nailing: $!\n";
   }
 }
-s
-our $oot_dir;
+
 our @out_command;
 
+our $oot_dir;      # oot.dir or "Build"
+our $oot_absdir;
+
+our $build_absdir; # .../Build/<subdir>
+
 sub calculate_oot () {
-  my $oot = $nail->{oot};
-  return unless $oot && (defined $oot->{dir} or defined $oot->{use});
+  $oot_dir = cfgs qw(oot dir);
+  my $use = cfgs qw(oot use);
+  return unless defined($oot_dir) || defined($use);
+  $oot_dir //= 'Build';
+
   if (@ARGV && $ARGV[0] =~ m/generate-lockfile|update/) {
     $oot_cargo_lock_faff = 1;
   }
+
+  $oot_absdir = ($oot_dir !~ m{^/} ? "$worksphere/"). $oot_dir;
+  $build_absdir = "$oot_absdir/$subdir";
+
   my ($pre,$post);
   my @xargs;
   if (!$oot_cargo_lock_faff) {
-    @xargs = $xxx_subdir;
+    @xargs = $build_absdir;
     ($pre, $post) = ('cd "$1"; shift', '');
   } else {
-    @xargs = $xxx_builddir, $xxx_subdir, $xxx_src_abs_dir;
+    @xargs = $build_absdir, $subdir, $src_absdir;
     ($pre, $post) = (<<'END', <<'END');
         cd "$1"; shift;
         mkdir -p -- "$1"; cd "$1"; shift;
@@ -280,10 +335,7 @@ END
     $pre  =~ s/^\s+//mg; $pre  =~ s/^\s+\n/ /g;
     $post =~ s/^\s+//mg; $post =~ s/^\s+\n/ /g;
   }
-  my $use = $oot->{use} // die "$self: [oot] specified, need oot.use\n";
-  my $getuser = sub {
-    scalar($oot->{user} // die "$self: oot.use $use requires oot.user\n")
-  };
+  my $getuser = sub { cfgsn qw(oot user) };
   my @command;
   my $sh_ec = sub {
     if (!length $post) {
@@ -310,9 +362,9 @@ END
     $user .= '@localhost' unless $user =~ m/\@/;
     $command_sh->('ssh',$user);
   } elsif ($use eq 'command_sh') {
-    $command_sh->(@{ $oot->{command} // die "$self: need oot.command\n" });
+    $command_sh->(cfgn_list qw(oot command));
   } elsif ($use eq 'command_args') {
-    $sh_ec->(@{ $oot->{command} // die "$self: need oot.command\n" });
+    $sh_ec->(cfgn_list qw(oot command))
   } else {
     die "$self: oot.use mode $use not recognised\n";
   }
-- 
2.30.2