guix/guix-cuirass
2
0
Fork 0
mirror of git://git.savannah.gnu.org/guix/guix-cuirass.git synced 2023-12-14 06:03:04 +01:00
Code Issues Releases Wiki Activity

database: Fix using sqlite-reset in a few queries.

Browse source 
Rather than calling sqlite-reset before reading the rows, call sqlite-reset
after. I think this is important to stop SQLite getting stuck because the
statement is still live even though it's not being read from after these
procedures return.

Assuming I've got the ordering right, I think using sqlite-fold-right directly
is simpler code as well.

* src/cuirass/database.scm (db-get-builds-by-search, format-build-products,
db-get-events): Rewrite fetching result rows.
This commit is contained in:
Christopher Baines 2020-12-06 10:58:21 +00:00
parent 23d75284bf
commit b2c77dd626
1 changed files with 70 additions and 65 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

135
src/cuirass/database.scm
View file

@ -899,26 +899,28 @@ LIMIT :nr;"))
(#f -1)
(x x)))
(query->bind-arguments (assq-ref filters 'query))))
(sqlite-reset stmt)
(let loop ((rows (sqlite-fold-right cons '() stmt))
(builds '()))
(match rows
(() (reverse builds))
((#(id timestamp starttime stoptime log status job-name
system nix-name specification) . rest)
(loop rest
(cons `((#:id . ,id)
(#:timestamp . ,timestamp)
(#:starttime . ,starttime)
(#:stoptime . ,stoptime)
(#:log . ,log)
(#:status . ,status)
(#:job-name . ,job-name)
(#:system . ,system)
(#:nix-name . ,nix-name)
(#:specification . ,specification)
(#:buildproducts . ,(db-get-build-products id)))
builds))))))))
(let ((builds
(sqlite-fold-right
(lambda (row result)
(match row
(#(id timestamp starttime stoptime log status job-name
system nix-name specification)
(cons `((#:id . ,id)
(#:timestamp . ,timestamp)
(#:starttime . ,starttime)
(#:stoptime . ,stoptime)
(#:log . ,log)
(#:status . ,status)
(#:job-name . ,job-name)
(#:system . ,system)
(#:nix-name . ,nix-name)
(#:specification . ,specification)
(#:buildproducts . ,(db-get-build-products id)))
result))))
'()
stmt)))
(sqlite-reset stmt)
builds))))
(define (db-get-builds filters)
"Retrieve all builds in the database which are matched by given FILTERS.
@ -1053,39 +1055,40 @@ ORDER BY ~a;"
name)
value))))
filters)
(sqlite-reset stmt)
(let loop ((rows (sqlite-fold-right cons '() stmt))
(builds '()))
(match rows
(() (reverse builds))
((#(derivation id timestamp starttime stoptime log status job-name
system nix-name eval-id specification
outputs-name outputs-path
products-id products-type products-file-size
products-checksum products-path) . rest)
(loop rest
(cons `((#:derivation . ,derivation)
(#:id . ,id)
(#:timestamp . ,timestamp)
(#:starttime . ,starttime)
(#:stoptime . ,stoptime)
(#:log . ,log)
(#:status . ,status)
(#:job-name . ,job-name)
(#:system . ,system)
(#:nix-name . ,nix-name)
(#:eval-id . ,eval-id)
(#:specification . ,specification)
(#:outputs . ,(format-outputs outputs-name
outputs-path))
(#:buildproducts .
,(format-build-products products-id
products-type
products-file-size
products-checksum
products-path)))
builds))))))))
(let ((builds
(sqlite-fold-right
(lambda (row result)
(match row
(#(derivation id timestamp starttime stoptime log status job-name
system nix-name eval-id specification
outputs-name outputs-path
products-id products-type products-file-size
products-checksum products-path)
(cons `((#:derivation . ,derivation)
(#:id . ,id)
(#:timestamp . ,timestamp)
(#:starttime . ,starttime)
(#:stoptime . ,stoptime)
(#:log . ,log)
(#:status . ,status)
(#:job-name . ,job-name)
(#:system . ,system)
(#:nix-name . ,nix-name)
(#:eval-id . ,eval-id)
(#:specification . ,specification)
(#:outputs . ,(format-outputs outputs-name
outputs-path))
(#:buildproducts .
,(format-build-products products-id
products-type
products-file-size
products-checksum
products-path)))
result))))
'()
stmt)))
(sqlite-reset stmt)
builds))))
(define (db-get-build derivation-or-id)
"Retrieve a build in the database which corresponds to DERIVATION-OR-ID."
@ -1142,18 +1145,20 @@ LIMIT :nr;")
#:nr (match (assq-ref filters 'nr)
(#f -1)
(x x)))
(sqlite-reset stmt)
(let loop ((rows (sqlite-fold-right cons '() stmt))
(events '()))
(match rows
(() (reverse events))
((#(id type timestamp event_json) . rest)
(loop rest
(cons `((#:id . ,id)
(#:type . ,type)
(#:timestamp . ,timestamp)
(#:event_json . ,event_json))
events))))))))
(let ((events
(sqlite-fold-right
(lambda (row result)
(match row
(#(id type timestamp event_json)
(cons `((#:id . ,id)
(#:type . ,type)
(#:timestamp . ,timestamp)
(#:event_json . ,event_json))
result))))
'()
stmt)))
(sqlite-reset stmt)
events))))
(define (db-delete-events-with-ids-<=-to id)
(with-db-writer-worker-thread db