From: Ian Jackson <ian.jackson@eu.citrix.com>
Date: Mon, 24 Jul 2017 16:48:36 +0000 (+0100)
Subject: anointments: Provide ./mg-anoint list-prepared
X-Git-Url: http://xenbits.xensource.com/gitweb?a=commitdiff_plain;h=refs%2Fheads%2Fwip.anoint;p=people%2Fiwj%2Fosstest.git

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 4bb8ab0e..837e6089 100755
--- 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/^-/;