906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
|
run-id
)
(debug:print-info 11 "db:get-tests-for-run START run-id=" run-id ", testpatt=" testpatt ", states=" states ", statuses=" statuses ", not-in=" not-in ", sort-by=" sort-by)
res))
;; get a useful subset of the tests data (used in dashboard
;; use db:mintests-get-{id ,run_id,testname ...}
(define (db:get-tests-for-runs-mindata db run-ids testpatt states status)
(db:get-tests-for-runs db run-ids testpatt states status qryvals: "id,run_id,testname,state,status,event_time,item_path"))
;; NB // This is get tests for "runs" (note the plural!!)
;;
;; states and statuses are lists, turn them into ("PASS","FAIL"...) and use NOT IN
;; i.e. these lists define what to NOT show.
;; states and statuses are required to be lists, empty is ok
;; not-in #t = above behaviour, #f = must match
;; run-ids is a list of run-ids or a single number
(define (db:get-tests-for-runs db run-ids testpatt states statuses
#!key (not-in #t)
(sort-by #f)
(qryvals "id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment")) ;; 'rundir 'event_time
(debug:print-info 11 "db:get-tests-for-run START run-ids=" run-ids ", testpatt=" testpatt ", states=" states ", statuses=" statuses ", not-in=" not-in ", sort-by=" sort-by)
(let* ((res '())
;; if states or statuses are null then assume match all when not-in is false
|
|
|
|
|
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
|
run-id
)
(debug:print-info 11 "db:get-tests-for-run START run-id=" run-id ", testpatt=" testpatt ", states=" states ", statuses=" statuses ", not-in=" not-in ", sort-by=" sort-by)
res))
;; get a useful subset of the tests data (used in dashboard
;; use db:mintests-get-{id ,run_id,testname ...}
(define (db:get-tests-for-runs-mindata db run-ids testpatt states status not-in)
(db:get-tests-for-runs db run-ids testpatt states status not-in: not-in qryvals: "id,run_id,testname,state,status,event_time,item_path"))
;; NB // This is get tests for "runs" (note the plural!!)
;;
;; states and statuses are lists, turn them into ("PASS","FAIL"...) and use NOT IN
;; i.e. these lists define what to NOT show.
;; states and statuses are required to be lists, empty is ok
;; not-in #t = above behaviour, #f = must match
;; run-ids is a list of run-ids or a single number or #f for all runs
(define (db:get-tests-for-runs db run-ids testpatt states statuses
#!key (not-in #t)
(sort-by #f)
(qryvals "id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment")) ;; 'rundir 'event_time
(debug:print-info 11 "db:get-tests-for-run START run-ids=" run-ids ", testpatt=" testpatt ", states=" states ", statuses=" statuses ", not-in=" not-in ", sort-by=" sort-by)
(let* ((res '())
;; if states or statuses are null then assume match all when not-in is false
|
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
|
(conc " status "
(if not-in "NOT" "")
" IN ('"
(string-intersperse statuses "','")
"')")))
(tests-match-qry (tests:match->sqlqry testpatt))
(qry (conc "SELECT " qryvals
" FROM tests WHERE state != 'DELETED' AND "
(if run-ids
(if (list? run-ids)
(conc " run_id in (" (string-intersperse (map conc run-ids) ",") ") ")
(conc "run_id=" run-ids " "))
" ") ;; #f => run-ids don't filter on run-ids
(if states-qry (conc " AND " states-qry) "")
(if statuses-qry (conc " AND " statuses-qry) "")
(if tests-match-qry (conc " AND (" tests-match-qry ") ") "")
(case sort-by
((rundir) " ORDER BY length(rundir) DESC;")
((event_time) " ORDER BY event_time ASC;")
|
|
|
|
|
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
|
(conc " status "
(if not-in "NOT" "")
" IN ('"
(string-intersperse statuses "','")
"')")))
(tests-match-qry (tests:match->sqlqry testpatt))
(qry (conc "SELECT " qryvals
" FROM tests WHERE state != 'DELETED' "
(if run-ids
(if (list? run-ids)
(conc "AND run_id IN (" (string-intersperse (map conc run-ids) ",") ") ")
(conc "AND run_id=" run-ids " "))
" ") ;; #f => run-ids don't filter on run-ids
(if states-qry (conc " AND " states-qry) "")
(if statuses-qry (conc " AND " statuses-qry) "")
(if tests-match-qry (conc " AND (" tests-match-qry ") ") "")
(case sort-by
((rundir) " ORDER BY length(rundir) DESC;")
((event_time) " ORDER BY event_time ASC;")
|
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
|
(define (cdb:tests-update-uname-host serverdat test-id uname hostname)
(cdb:client-call serverdat 'update-uname-host #t *default-numtries* test-id uname hostname))
;; speed up for common cases with a little logic
(define (db:test-set-state-status-by-id db test-id newstate newstatus newcomment)
(cond
((and newstate newstatus newcomment)
(sqlite3:exectute db "UPDATE tests SET state=?,status=?,comment=? WHERE id=?;" newstate newstatus test-id))
((and newstate newstatus)
(sqlite3:execute db "UPDATE tests SET state=?,status=? WHERE id=?;" newstate newstatus test-id))
(else
(if newstate (sqlite3:execute db "UPDATE tests SET state=? WHERE id=?;" newstate test-id))
(if newstatus (sqlite3:execute db "UPDATE tests SET status=? WHERE id=?;" newstatus test-id))
(if newcomment (sqlite3:execute db "UPDATE tests SET comment=? WHERE id=?;" newcomment test-id)))))
|
|
|
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
|
(define (cdb:tests-update-uname-host serverdat test-id uname hostname)
(cdb:client-call serverdat 'update-uname-host #t *default-numtries* test-id uname hostname))
;; speed up for common cases with a little logic
(define (db:test-set-state-status-by-id db test-id newstate newstatus newcomment)
(cond
((and newstate newstatus newcomment)
(sqlite3:execute db "UPDATE tests SET state=?,status=?,comment=? WHERE id=?;" newstate newstatus newcomment test-id))
((and newstate newstatus)
(sqlite3:execute db "UPDATE tests SET state=?,status=? WHERE id=?;" newstate newstatus test-id))
(else
(if newstate (sqlite3:execute db "UPDATE tests SET state=? WHERE id=?;" newstate test-id))
(if newstatus (sqlite3:execute db "UPDATE tests SET status=? WHERE id=?;" newstatus test-id))
(if newcomment (sqlite3:execute db "UPDATE tests SET comment=? WHERE id=?;" newcomment test-id)))))
|