cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add options to the query-build-servers script

Browse source 
So you can select to query specific build servers.
This commit is contained in:
Christopher Baines 2019-12-10 08:28:38 +00:00
parent f13077d087
commit c90f411e5e
2 changed files with 42 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

6
guix-data-service/builds.scm
View file

@ -17,15 +17,17 @@
#:use-module (guix-data-service model nar) #:use-module (guix-data-service model nar)
#:export (query-build-servers)) #:export (query-build-servers))
(define (query-build-servers conn revision-commits) (define (query-build-servers conn build-server-ids revision-commits)
(while #t (while #t
(let ((build-servers (select-build-servers conn))) (let ((build-servers (select-build-servers conn)))
(for-each (for-each
(match-lambda (match-lambda
((id url lookup-all-derivations?) ((id url lookup-all-derivations?)
(when (or (not build-servers)
(member id build-server-ids))
(when lookup-all-derivations? (when lookup-all-derivations?
(simple-format #t "\nQuerying ~A\n" url) (simple-format #t "\nQuerying ~A\n" url)
(query-build-server conn id url revision-commits)))) (query-build-server conn id url revision-commits)))))
build-servers)))) build-servers))))
(define (query-build-server conn id url revision-commits) (define (query-build-server conn id url revision-commits)

34
scripts/guix-data-service-query-build-servers.in
View file

@ -26,7 +26,39 @@
(guix-data-service database) (guix-data-service database)
(guix-data-service builds)) (guix-data-service builds))
(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 (with-postgresql-connection
"query-build-servers" "query-build-servers"
(lambda (conn) (lambda (conn)
(query-build-servers conn (cdr (command-line))))) (query-build-servers conn
(assq-ref opts 'build-server-ids)
(assq-ref opts 'revision-commits)))))