Add a command to apply patches

Mostly for testing the code.

1 files changed, 31 insertions, 0 deletions

diff --git a/scripts/guix-qa-frontpage.in b/scripts/guix-qa-frontpage.in
index 3368860..2e82c7a 100644
--- a/scripts/guix-qa-frontpage.in
+++ b/scripts/guix-qa-frontpage.in
@@ -35,6 +35,7 @@
              (guix-qa-frontpage database)
              (guix-qa-frontpage issue)
              (guix-qa-frontpage branch)
+             (guix-qa-frontpage patchwork)
              (guix-qa-frontpage manage-builds)
              (guix-qa-frontpage git-repository)
              (guix-qa-frontpage manage-patch-branches)
@@ -209,6 +210,36 @@
         (or (assq-ref opts 'systems)
             %systems-to-submit-builds-for)))))
 
+  (("create-issue-branch" issue rest ...)
+   (parameterize
+       ((%git-repository-location (string-append (getcwd) "/guix.git")))
+     (let* ((opts (parse-options
+                   %submit-build-options
+                   %submit-build-default-options
+                   rest))
+            (metrics-registry (make-metrics-registry
+                               #:namespace
+                               "guixqafrontpage"))
+            (database
+             (setup-database (assq-ref opts 'database)
+                             metrics-registry))
+            (issue-number
+             (string->number issue))
+            (all-patchwork-series
+             (with-sqlite-cache
+              database
+              'latest-patchwork-series-by-issue
+              latest-patchwork-series-by-issue
+              #:ttl 600)))
+
+       (create-branch-for-issue
+        database
+        issue-number
+        (number->string
+         (assoc-ref (assq-ref all-patchwork-series
+                              issue-number)
+                    "id"))))))
+
   ((args ...)
    (let ((opts (parse-options
                 %options