anointments: Provide ./mg-anoint list-prepared

Deployment note: Requires Text::Glob, which on Debian is in
libtext-glob-perl (which I have installed in the Xen Project and
Citrix Cambridge primary VMs).

CC: Roger Pau Monne <roger.pau@citrix.com>
Signed-off-by: Ian Jackson <Ian.Jackson@eu.citrix.com>

diff --git a/mg-anoint b/mg-anoint
index 4bb8ab0ed4baf6e710ef9632c79b00f7428e0c8b..837e60892a8eb6d3276cc51cd3142b2c0cde25b7 100755 (executable)
--- a/mg-anoint
+++ b/mg-anoint
@@ -20,6 +20,9 @@
 #         if nothing anointed yet, prints nothing and exits 0
 #         if anointment not prepared, fails
 #
+#  ./mg-anoint list-prepared REFKEY-GLOB
+#      => possibly empty list of REFKEYs
+#
 #  ./mg-anoint list
 #      => human-readable output
 
@@ -65,6 +68,7 @@ use Osstest;
 use Osstest::TestSupport;
 use Osstest::Executive;
 use IO::Handle;
+use Text::Glob qw(glob_to_regex);
 
 csreadconfig();
 
@@ -337,6 +341,31 @@ END
     pr_o();
 }
 
+sub cmd_list_prepared {
+    die unless @ARGV==1;
+    die if $ARGV[0] =~ m/^-/;
+    my ($pat) = @ARGV;
+    my $re = glob_to_regex $pat;
+
+    my $tq = $dbh_tests->prepare(<<END);
+        SELECT *
+          FROM tasks
+         WHERE type = 'anoint'
+      ORDER BY refkey
+END
+
+    db_retry($dbh_tests, [], sub {
+        @o = ();
+        db_readonly_report();
+       $tq->execute();
+       while (my $t = $tq->fetchrow_hashref()) {
+           next unless $t->{refkey} =~ m{$re}o;
+           push @o, $t->{refkey};
+       }
+    });
+    pr_o();
+}
+
 die 'need operation' unless @ARGV;
 die 'no global options understood' if $ARGV[0] =~ m/^-/;