cs-adjust-flight: bugfixes and improvements

diff --git a/cs-adjust-flight b/cs-adjust-flight
index 725470efb0882e569660538b6954bd189ad0ec90..332bd5a3d936daaf1090491dff72d8019c5c71ac 100755 (executable)
--- a/cs-adjust-flight
+++ b/cs-adjust-flight
@@ -45,10 +45,15 @@ csreadconfig();
 
 our $debug = 0;
 
+open VERBOSE, ">/dev/null" or die $!;
+our $verbose_buffer;
+
 while (@ARGV && $ARGV[0] =~ m/^\-/) {
     $_ = shift @ARGV;
     last if m/^\-\-?$/;
-    if (m/^-D$/) {
+    if (m/^-v$/) {
+       open VERBOSE, ">&STDERR" or die $!;
+    } elsif (m/^-D$/) {
         $debug = 1;
     } else {
         die "$_ ?";
@@ -70,6 +75,13 @@ sub spec_re ($) {
 
 sub debug { print STDERR @_ if $debug; }
 
+sub verbose (@) { $verbose_buffer .= $_ foreach @_; }
+sub verbose_discard () { $verbose_buffer = ''; }
+sub verbose_flush () {
+    print VERBOSE $verbose_buffer or die $!;
+    verbose_discard();
+}
+
 sub for_things ($$$$$$$) {
     my ($spec, $fn, $ifnone,
         $table, $keycol, $basecond, $basecondvals) = @_;
@@ -111,7 +123,7 @@ sub for_jobs ($$$;$) {
     # calls $fn->($jobname, $jobrow);
     for_things($jobspec, $fn,
                ($noneok ? undef : sub {
-                   die "thing $flight.$jobspec does not exist\n";
+                   die "job $flight.$jobspec does not exist\n";
                 }),
                'jobs', 'job',
                'flight = ?', [$flight]);
@@ -133,13 +145,16 @@ sub copy_jobs ($$) {
          "      WHERE flight = ? AND job = ? AND NOT synth");
     my $rm_job = sub {
         my ($job) = @_;
-        $_->execute($dstflight, $job) foreach @job_rm_qs;
+       my $count = 0;
+        $count += $_->execute($dstflight, $job) foreach @job_rm_qs;
+       verbose "$dstflight.$job job deleted\n" if $count;
     };
     for_jobs($dstflight, $jobs, $rm_job);
     for_jobs($srcflight, $jobs, $rm_job);
     for_jobs($srcflight, $jobs, sub {
         my ($job) = @_;
         $_->execute($dstflight, $srcflight, $job) foreach @job_copy_qs;
+       verbose "$dstflight.$job job created from $srcflight.$job\n";
     });
 }
 
@@ -161,10 +176,13 @@ our $runvar_rm_q = $dbh_tests->prepare
 our $runvar_insert_q = $dbh_tests->prepare
     ("INSERT INTO runvars VALUES (?, ?, ?, ?, 'f')");
 
-sub runvar_set ($$$) {
-    my ($job, $name, $val) = @_;
+sub runvar_set ($$$;$) {
+    my ($job, $name, $val, $xwhat) = @_;
     $runvar_rm_q->execute($dstflight, $job, $name);
     $runvar_insert_q->execute($dstflight, $job, $name, $val);
+    verbose "$dstflight.$job $name := \`$val'";
+    verbose $xwhat if defined $xwhat;
+    verbose "\n";
 }
 
 sub for_runvars ($$$$) {
@@ -211,6 +229,7 @@ sub change__runvar_del {
     for_runvars($jobs, $vars, sub {
         my ($job, $name) = @_;
         runvar_rm_q->execute($dstflight, $job, $name);
+       verbose "$dstflight.$job $name runvar deleted\n";
     }, 'IGNORE');
 }
 
@@ -223,17 +242,19 @@ sub change__runvar_change {
 
     for_runvars($jobs, $vars, sub {
         my ($job, $name, $varrow) = @_;
-        runvar_set($job, $name, $newval) if $varrow->{val} eq $oldval;
+        runvar_set($job, $name, $newval, " (exactly matches \`$oldval')")
+           if $varrow->{val} eq $oldval;
     }, 'IGNORE');
 }
 
-sub perlop_value ($$$) {
+sub perlop_value ($$$$) {
     my $job = shift @_;
     my $name = shift @_;
+    my $op = shift @_;
     local $_ = shift @_;
     $@ = '';
-    eval $_[1];
-    die "$@ executing perlop $_[1]\n" if $@;
+    eval $op;
+    die "$@ executing perlop \`$op'\n" if $@;
     return $_;
 }
 
@@ -245,7 +266,9 @@ sub change__runvar_perlop {
 
     for_runvars($jobs, $vars, sub {
         my ($job, $name, $varrow) = @_;
-        runvar_set($job, $name, perlop_value($job, $name, $varrow->{Val}));
+       my $oldval = $varrow->{val};
+       my $newval = perlop_value($job, $name, $op, $oldval);
+        runvar_set($job, $name, $newval, " (modified from \`$oldval')");
     }, 'IGNORE');
 }
 
@@ -257,6 +280,7 @@ sub change__intended_blessing {
                    "   SET intended = ?".
                    " WHERE flight = ?",
                    {}, $blessing, $dstflight);
+    verbose "$dstflight blessing set to $blessing\n";
 }
 
 sub change__branch {
@@ -267,6 +291,7 @@ sub change__branch {
                    "   SET branch = ?".
                    " WHERE flight = ?",
                    {}, $branch, $dstflight);
+    verbose "$dstflight branch set to $branch\n";
 }
 
 sub changes () {
@@ -288,18 +313,25 @@ sub main () {
     if ($dstflightspec =~ m/^\d+$/) {
         $dstflight = $dstflightspec;
         db_retry($dstflight,'constructing',
-                 $dbh_tests, [qw(flights)], \&changes);
+                 $dbh_tests, [qw(flights)], sub {
+            verbose_discard();
+            changes();
+        });
     } elsif ($dstflightspec =~ m/^new:/) {
         my $intended = $'; #';
         db_retry($dbh_tests, [qw(flights)], sub {
+            verbose_discard();
             $dstflight = $mjobdb->flight_create($intended, $c{DefaultBranch});
             $mjobdb->dbfl_check($dstflight, 'constructing');
+           verbose "$dstflight flight created, intended blessing $intended\n";
             changes();
         });
+       verbose_flush();
         print "$dstflight\n" or die $!;
     } else {
         die "$dstflightspec ?";
     }
+    verbose_flush();
 }
 
 main();