diff options
| author | Christopher Baines <mail@cbaines.net> | 2023-02-14 19:19:29 +0000 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2023-02-14 19:19:29 +0000 |
| commit | 7d64b120dcfc935819428ed5dee67b94bca0d89e (patch) | |
| tree | 218f363b7b57edd32caec6a691f26c06acb9321b /guix-qa-frontpage | |
| parent | f53cbd9c4acad7b08b498fbe1d9014352cdf0b6d (diff) | |
| download | qa-frontpage-7d64b120dcfc935819428ed5dee67b94bca0d89e.tar qa-frontpage-7d64b120dcfc935819428ed5dee67b94bca0d89e.tar.gz | |
Further tweak managing patch branches
Diffstat (limited to 'guix-qa-frontpage')
| -rw-r--r-- | guix-qa-frontpage/manage-patch-branches.scm | 204 |
1 files changed, 103 insertions, 101 deletions
diff --git a/guix-qa-frontpage/manage-patch-branches.scm b/guix-qa-frontpage/manage-patch-branches.scm index 3b02824..0813dfa 100644 --- a/guix-qa-frontpage/manage-patch-branches.scm +++ b/guix-qa-frontpage/manage-patch-branches.scm @@ -222,7 +222,6 @@ (let ((issue-numbers (map string->number (issue-numbers-for-branches)))) - (with-bare-git-repository (lambda () (simple-format #t "checking for branches to delete\n") @@ -247,8 +246,9 @@ (begin (simple-format (current-error-port) - "Removing ~A, base revision gone\n" - issue-number) + "Removing ~A, base revision (~A) gone\n" + issue-number + base-commit) #t) #f)) (lambda () @@ -261,103 +261,104 @@ (simple-format #f "base-for-issue-~A" issue-number)) (run "git" "push" "patches" "--delete" (simple-format #f "issue-~A" issue-number)))) - issue-numbers))) - - (simple-format #t "finished checking for branches to delete\n") - - (let* ((all-patchwork-series - (latest-patchwork-series-by-issue)) - (series-to-create-branches-for - (let ((recent-series - (take all-patchwork-series - 150))) - (append - recent-series - (filter-map - (lambda (issue-number) - (if (assq-ref recent-series issue-number) - #f - (cons issue-number - (assq-ref all-patchwork-series - issue-number)))) - issue-numbers))))) - (for-each - (match-lambda - ((issue-number . patchwork-series) - (when (or (not - (member issue-number - issue-numbers - =)) - - ;; Does the branch need re-creating with a new series? - (let ((branch-committer-date - (get-git-branch-head-committer-date - (simple-format #f "patches/issue-~A" issue-number))) - (patchwork-series-date - (assoc-ref patchwork-series "date"))) - (if (and branch-committer-date - patchwork-series-date) - (let* ((branch-committer-time - (date->time-utc branch-committer-date)) - (patchwork-series-time - (date->time-utc - (string->date - patchwork-series-date - "~Y-~m-~dT~H:~M:~S"))) - (recreate-branch? - (time<? branch-committer-time - patchwork-series-time))) - (simple-format - #t - "considering recreating branch for issue ~A (~A, ~A, ~A)\n" - issue-number - branch-committer-time - patchwork-series-time - recreate-branch?) - (time<? branch-committer-time - patchwork-series-time)) - #f))) - (simple-format #t "creating branch for issue ~A\n" issue-number) - (with-exception-handler - (lambda (exn) - (simple-format - (current-error-port) - "exception when creating branch for ~A: ~A\n" - issue-number - exn) - - (simple-format - (current-error-port) - "deleting tag and branch for issue\n") - (system* "git" "push" "--delete" "patches" - (simple-format #f "base-for-issue-~A" issue-number)) - (system* "git" "push" "--progress" "patches" "--delete" - (simple-format #f "issue-~A" issue-number))) - (lambda () - (with-throw-handler #t - (lambda () - (create-branch-for-issue issue-number - (number->string - (assoc-ref patchwork-series - "id"))) - (clear-sqlite-cache-entry - database - 'issue-branch-base-and-target-refs - #:args (list issue-number)) - - (clear-sqlite-cache-entry - database - 'issue-patches-overall-status - #:args (list issue-number))) - (lambda args - (display (backtrace) (current-error-port)) - (newline (current-error-port))))))))) - series-to-create-branches-for) - - (simple-format (current-error-port) - "finished processing patch branches (last issue: ~A)\n" - (car (last series-to-create-branches-for))))) - (sleep 3600)) + issue-numbers)))) + (simple-format #t "finished checking for branches to delete\n") + + (let* ((all-patchwork-series + (latest-patchwork-series-by-issue)) + (issue-numbers + (map string->number + (issue-numbers-for-branches))) + (series-to-create-branches-for + (let ((recent-series + (take all-patchwork-series + 150))) + (append + recent-series + (filter-map + (lambda (issue-number) + (if (assq-ref recent-series issue-number) + #f + (cons issue-number + (assq-ref all-patchwork-series + issue-number)))) + issue-numbers))))) + (for-each + (match-lambda + ((issue-number . patchwork-series) + (when (or (not + (member issue-number + issue-numbers + =)) + + ;; Does the branch need re-creating with a new series? + (let ((branch-committer-date + (get-git-branch-head-committer-date + (simple-format #f "patches/issue-~A" issue-number))) + (patchwork-series-date + (assoc-ref patchwork-series "date"))) + (if (and branch-committer-date + patchwork-series-date) + (let* ((branch-committer-time + (date->time-utc branch-committer-date)) + (patchwork-series-time + (date->time-utc + (string->date + patchwork-series-date + "~Y-~m-~dT~H:~M:~S"))) + (recreate-branch? + (time<? branch-committer-time + patchwork-series-time))) + (simple-format + #t + "considering recreating branch for issue ~A (~A, ~A, ~A)\n" + issue-number + branch-committer-time + patchwork-series-time + recreate-branch?) + (time<? branch-committer-time + patchwork-series-time)) + #f))) + (simple-format #t "creating branch for issue ~A\n" issue-number) + (with-exception-handler + (lambda (exn) + (simple-format + (current-error-port) + "exception when creating branch for ~A: ~A\n" + issue-number + exn) + + (simple-format + (current-error-port) + "deleting tag and branch for issue\n") + (system* "git" "push" "--delete" "patches" + (simple-format #f "base-for-issue-~A" issue-number)) + (system* "git" "push" "--progress" "patches" "--delete" + (simple-format #f "issue-~A" issue-number))) + (lambda () + (with-throw-handler #t + (lambda () + (create-branch-for-issue issue-number + (number->string + (assoc-ref patchwork-series + "id"))) + (clear-sqlite-cache-entry + database + 'issue-branch-base-and-target-refs + #:args (list issue-number)) + + (clear-sqlite-cache-entry + database + 'issue-patches-overall-status + #:args (list issue-number))) + (lambda args + (display (backtrace) (current-error-port)) + (newline (current-error-port))))))))) + series-to-create-branches-for) + + (simple-format (current-error-port) + "finished processing patch branches (last issue: ~A)\n" + (car (last series-to-create-branches-for))))) (setenv "GIT_SSH_COMMAND" "ssh -o StrictHostKeyChecking=no") @@ -377,5 +378,6 @@ (lambda args (display (backtrace) (current-error-port)) (newline (current-error-port))))) - #:unwind? #t))))) + #:unwind? #t) + (sleep 3600))))) |