diff options
| -rw-r--r-- | guix-data-service/builds.scm | 10 | ||||
| -rw-r--r-- | scripts/guix-data-service-query-build-servers.in | 40 |
2 files changed, 42 insertions, 8 deletions
diff --git a/guix-data-service/builds.scm b/guix-data-service/builds.scm index be9f421..1a1c7bb 100644 --- a/guix-data-service/builds.scm +++ b/guix-data-service/builds.scm @@ -17,15 +17,17 @@ #:use-module (guix-data-service model nar) #:export (query-build-servers)) -(define (query-build-servers conn revision-commits) +(define (query-build-servers conn build-server-ids revision-commits) (while #t (let ((build-servers (select-build-servers conn))) (for-each (match-lambda ((id url lookup-all-derivations?) - (when lookup-all-derivations? - (simple-format #t "\nQuerying ~A\n" url) - (query-build-server conn id url revision-commits)))) + (when (or (not build-servers) + (member id build-server-ids)) + (when lookup-all-derivations? + (simple-format #t "\nQuerying ~A\n" url) + (query-build-server conn id url revision-commits))))) build-servers)))) (define (query-build-server conn id url revision-commits) diff --git a/scripts/guix-data-service-query-build-servers.in b/scripts/guix-data-service-query-build-servers.in index aa66a9f..9ef8347 100644 --- a/scripts/guix-data-service-query-build-servers.in +++ b/scripts/guix-data-service-query-build-servers.in @@ -26,7 +26,39 @@ (guix-data-service database) (guix-data-service builds)) -(with-postgresql-connection - "query-build-servers" - (lambda (conn) - (query-build-servers conn (cdr (command-line))))) +(define %options + ;; Specifications of the command-line options + (list (option '("build-server-id") #t #f + (lambda (opt name arg result) + (alist-cons + 'build-server-ids + (cons (string->number arg) + (or (assoc-ref result 'build-server-ids) + '())) + (alist-delete 'build-server-ids result)))))) + +(define %default-options + ;; Alist of default option values + '()) + +(define (parse-options args) + (args-fold + args %options + (lambda (opt name arg result) + (error "unrecognized option" name)) + (lambda (arg result) + (alist-cons + 'revision-commits + (cons arg + (or (assoc-ref result 'revision-commits) + '())) + (alist-delete 'revision-commits result))) + %default-options)) + +(let ((opts (parse-options (cdr (program-arguments))))) + (with-postgresql-connection + "query-build-servers" + (lambda (conn) + (query-build-servers conn + (assq-ref opts 'build-server-ids) + (assq-ref opts 'revision-commits))))) |