chiark / gitweb /
nailing-cargo: wip Cargo.lock manipulation, config rework
authorIan Jackson <ijackson@chiark.greenend.org.uk>
Sun, 10 May 2020 11:36:02 +0000 (12:36 +0100)
committerIan Jackson <ijackson@chiark.greenend.org.uk>
Sun, 10 May 2020 11:36:02 +0000 (12:36 +0100)
Signed-off-by: Ian Jackson <ijackson@chiark.greenend.org.uk>
nailing-cargo

index eecf01c828a0bd443ce5511bb12dd3bed5756da6..e25b3c671d50c85f009aedb4bd43a6e09db5bba3 100755 (executable)
@@ -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";
   }