646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
|
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
|
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(define (db:set-comment-for-run dbstruct run-id comment)
(sqlite3:execute (db:get-db dbstruct #f) "UPDATE runs SET comment=? WHERE id=?;" comment run-id))
;; does not (obviously!) removed dependent data. But why not!!?
(define (db:delete-run dbstruct run-id)
;; (common:clear-caches) ;; don't trust caches after doing any deletion
;; First set any related tests to DELETED
(let ((db (db:get-db dbstruct run-id)))
(sqlite3:execute (db:get-db dbstruct run-id) "UPDATE tests SET state='DELETED',comment='';")
(sqlite3:execute (db:get-db dbstruct #f) "UPDATE runs SET state='deleted',comment='' WHERE id=?;" run-id))
(sqlite3:execute db "UPDATE tests SET state='DELETED',comment='';")
(sqlite3:execute db "DELETE FROM test_steps;")
(sqlite3:execute db "DELETE FROM test_data;")
(sqlite3:execute (db:get-db dbstruct #f) "UPDATE runs SET state='deleted',comment='' WHERE id=?;" run-id)))
(define (db:update-run-event_time dbstruct run-id)
(sqlite3:execute (db:get-db dbstruct #f) "UPDATE runs SET event_time=strftime('%s','now') WHERE id=?;" run-id))
(define (db:lock/unlock-run dbstruct run-id lock unlock user)
(let ((newlockval (if lock "locked"
(if unlock
"unlocked"
"locked")))) ;; semi-failsafe
(sqlite3:execute (db:get-db dbstruct #f) "UPDATE runs SET state=? WHERE id=?;" newlockval run-id)
(sqlite3:execute (db:get-db dbstruct #f) "INSERT INTO access_log (user,accessed,args) VALUES(?,strftime('%s','now'),?);"
user (conc newlockval " " run-id))
(debug:print-info 1 "" newlockval " run number " run-id)))
(define (db:get-all-run-ids dbstruct)
(let ((res '()))
(sqlite3:for-each-row
(lambda (run-id)
(set! res (cons run-id res)))
(db:get-db dbstruct #f)
"SELECT id FROM runs;")
(reverse res)))
;;======================================================================
;; K E Y S
;;======================================================================
;; get key val pairs for a given run-id
;; ( (FIELDNAME1 keyval1) (FIELDNAME2 keyval2) ... )
|
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
|
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
|
-
+
-
-
+
-
-
-
-
-
+
+
-
-
+
-
-
-
-
-
-
-
+
-
-
-
+
+
-
-
-
+
+
-
+
-
-
+
+
-
+
-
-
-
+
+
+
+
+
+
-
+
-
+
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
-
-
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
-
+
+
+
-
+
-
+
-
+
-
+
-
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
+
+
+
-
+
-
-
-
-
+
+
-
-
-
-
-
-
+
+
+
-
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
-
-
-
+
+
-
-
-
-
-
-
-
+
-
-
-
+
+
-
-
-
+
+
-
-
-
-
-
-
+
-
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
+
+
+
+
+
-
-
-
-
+
-
-
-
-
-
-
+
-
-
-
-
-
+
-
-
-
+
+
-
-
+
+
-
-
-
-
+
+
+
+
+
-
|
;; ;; (set! res (cons (apply vector a b) res))) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment) res)))
;; ;; db
;; ;; qry
;; ;; )
;; ;; res))
;; this one is a bit broken BUG FIXME
(define (db:delete-test-step-records db test-id #!key (work-area #f))
(define (db:delete-test-step-records dbstruct run-id test-id)
;; Breaking it into two queries for better file access interleaving
(let* ((tdb (db:open-test-db-by-test-id db test-id work-area: work-area)))
(let ((db (db:get-db dbstruct run-id)))
;; test db's can go away - must check every time
(if tdb
(begin
(sqlite3:execute tdb "DELETE FROM test_steps;")
(sqlite3:execute tdb "DELETE FROM test_data;")
(sqlite3:execute db "DELETE FROM test_steps WHERE test_id=?;" test-id)
(sqlite3:execute db "DELETE FROM test_data WHERE test_id=?;" test-id)))
(sqlite3:finalize! tdb)))))
;;
(define (db:delete-test-records db tdb test-id #!key (force #f))
(define (db:delete-test-records dbstruct run-id test-id)
(common:clear-caches)
(if tdb
(begin
(sqlite3:execute tdb "DELETE FROM test_steps;")
(sqlite3:execute tdb "DELETE FROM test_data;")))
;; (sqlite3:execute db "DELETE FROM tests WHERE id=?;" test-id))
(if db
(let ((db (db:get-db dbstruct run-id)))
(begin
(sqlite3:execute db "DELETE FROM test_steps WHERE test_id=?;" test-id)
(sqlite3:execute db "DELETE FROM test_data WHERE test_id=?;" test-id)
(sqlite3:execute db "DELETE FROM test_steps WHERE test_id=?;" test-id)
(sqlite3:execute db "DELETE FROM test_data WHERE test_id=?;" test-id)
(if force
(sqlite3:execute db "DELETE FROM tests WHERE id=?;" test-id)
(sqlite3:execute db "UPDATE tests SET state='DELETED',status='n/a',comment='' WHERE id=?;" test-id)))))
;; (sqlite3:execute db "DELETE FROM tests WHERE id=?;" test-id)
(sqlite3:execute db "UPDATE tests SET state='DELETED',status='n/a',comment='' WHERE id=?;" test-id)))
(define (db:delete-tests-for-run db run-id)
(define (db:delete-tests-for-run dbstruct run-id)
(common:clear-caches)
(sqlite3:execute db "DELETE FROM tests WHERE run_id=?;" run-id))
(let ((db (db:get-db dbstruct run-id)))
(sqlite3:execute db "DELETE FROM tests;")))
(define (db:delete-old-deleted-test-records db)
(define (db:delete-old-deleted-test-records dbstruct)
(common:clear-caches)
(let ((targtime (- (current-seconds)(* 30 24 60 60)))) ;; one month in the past
(sqlite3:execute db "DELETE FROM tests WHERE state='DELETED' AND event_time<?;" targtime)))
(let ((run-ids (db:get-all-run-ids dbstruct))
(targtime (- (current-seconds)(* 30 24 60 60)))) ;; one month in the past
(for-each
(lambda (run-id)
(sqlite3:execute (db:get-db dbstruct run-id) "DELETE FROM tests WHERE state='DELETED' AND event_time<?;" targtime))
run-ids)))
;; set tests with state currstate and status currstatus to newstate and newstatus
;; use currstate = #f and or currstatus = #f to apply to any state or status respectively
;; WARNING: SQL injection risk. NB// See new but not yet used "faster" version below
;;
(define (db:set-tests-state-status db run-id testnames currstate currstatus newstate newstatus)
(define (db:set-tests-state-status dbstruct run-id testnames currstate currstatus newstate newstatus)
(for-each (lambda (testname)
(let ((qry (conc "UPDATE tests SET state=?,status=? WHERE "
(if currstate (conc "state='" currstate "' AND ") "")
(if currstatus (conc "status='" currstatus "' AND ") "")
" run_id=? AND testname=? AND NOT (item_path='' AND testname in (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));")))
" testname=? AND NOT (item_path='' AND testname in (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));")))
;;(debug:print 0 "QRY: " qry)
(sqlite3:execute db qry run-id newstate newstatus testname testname)))
(sqlite3:execute (db:get-db dbstruct run-id) qry run-id newstate newstatus testname testname)))
testnames))
(define (cdb:set-tests-state-status-faster serverdat run-id testnames currstate currstatus newstate newstatus)
;; Convert #f to wildcard %
(if (null? testnames)
#t
(let ((currstate (if currstate currstate "%"))
(currstatus (if currstatus currstatus "%")))
(let loop ((hed (car testnames))
(tal (cdr testnames))
(thr '()))
(let ((th1 (if newstate (create-thread (cbd:client-call serverdat 'update-test-state #t *default-numtries* newstate currstate run-id testname testname)) #f))
(th2 (if newstatus (create-thread (cbd:client-call serverdat 'update-test-status #t *default-numtries* newstatus currstatus run-id testname testname)) #f)))
(thread-start! th1)
(thread-start! th2)
(if (null? tal)
(loop (car tal)(cdr tal)(cons th1 (cons th2 thr)))
(for-each
(lambda (th)
(if th (thread-join! th)))
thr)))))))
;; (define (cdb:set-tests-state-status-faster serverdat run-id testnames currstate currstatus newstate newstatus)
;; ;; Convert #f to wildcard %
;; (if (null? testnames)
;; #t
;; (let ((currstate (if currstate currstate "%"))
;; (currstatus (if currstatus currstatus "%")))
;; (let loop ((hed (car testnames))
;; (tal (cdr testnames))
;; (thr '()))
;; (let ((th1 (if newstate (create-thread (cbd:client-call serverdat 'update-test-state #t *default-numtries* newstate currstate run-id testname testname)) #f))
;; (th2 (if newstatus (create-thread (cbd:client-call serverdat 'update-test-status #t *default-numtries* newstatus currstatus run-id testname testname)) #f)))
;; (thread-start! th1)
;; (thread-start! th2)
;; (if (null? tal)
;; (loop (car tal)(cdr tal)(cons th1 (cons th2 thr)))
;; (for-each
;; (lambda (th)
;; (if th (thread-join! th)))
;; thr)))))))
(define (cdb:delete-tests-in-state serverdat run-id state)
(define (db:delete-tests-in-state dbstruct run-id state)
(common:clear-caches)
(cdb:client-call serverdat 'delete-tests-in-state #t *default-numtries* run-id state))
(sqlite3:execute (db:get-db dbstruct run-id)(db:lookup-query 'delete-tests-in-state) state))
(define (cdb:tests-update-cpuload-diskfree serverdat test-id cpuload diskfree)
(cdb:client-call serverdat 'update-cpuload-diskfree #t *default-numtries* cpuload diskfree test-id))
(define (db:tests-update-cpuload-diskfree dbstruct run-id test-id cpuload diskfree)
(sqlite3:execute (db:get-db dbstruct run-id)(db:lookup-query 'update-cpuload-diskfree) cpuload diskfree test-id))
(define (cdb:tests-update-run-duration serverdat test-id minutes)
(cdb:client-call serverdat 'update-run-duration #t *default-numtries* minutes test-id))
(define (db:tests-update-run-duration dbstruct run-id test-id minutes)
(sqlite3:execute (db:get-db dbstruct run-id)(db:lookup-query 'update-run-duration) minutes test-id))
(define (cdb:tests-update-uname-host serverdat test-id uname hostname)
(cdb:client-call serverdat 'update-uname-host #t *default-numtries* uname hostname test-id))
(define (db:tests-update-uname-host dbstruct run-id test-id uname hostname)
(sqlite3:execute (db:get-db dbstruct run-id)(db:lookup-query 'update-uname-host) uname hostname test-id))
;; speed up for common cases with a little logic
;; NB// Ultimately this will be deprecated in deference to mt:test-set-state-status-by-id
;;
(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))))
(mt:process-triggers test-id newstate newstatus))
(define (db:test-set-state-status-by-id dbstruct run-id test-id newstate newstatus newcomment)
(let ((db (db:get-db dbstruct run-id)))
(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))))
(mt:process-triggers run-id test-id newstate newstatus)))
;; Never used
;; (define (db:test-set-state-status-by-run-id-testname db run-id test-name item-path status state)
;; (sqlite3:execute db "UPDATE tests SET state=?,status=?,event_time=strftime('%s','now') WHERE run_id=? AND testname=? AND item_path=?;"
;; state status run-id test-name item-path))
;; NEW BEHAVIOR: Count tests running in only one run!
;;
(define (db:get-count-tests-running db)
(define (db:get-count-tests-running dbstruct run-id)
(let ((res 0))
(sqlite3:for-each-row
(lambda (count)
(set! res count))
db
(db:get-db dbstruct run-id)
"SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART');")
res))
;; NEW BEHAVIOR: Look only at single run with run-id
;;
(define (db:get-running-stats db)
(define (db:get-running-stats dbstruct run-id)
(let ((res '()))
(sqlite3:for-each-row
(lambda (state count)
(set! res (cons (list state count) res)))
db
(db:get-db dbstruct run-id)
"SELECT state,count(id) FROM tests GROUP BY state ORDER BY id DESC;")
res))
(define (db:get-count-tests-running-in-jobgroup db jobgroup)
(define (db:get-count-tests-running-in-jobgroup dbstruct run-id jobgroup)
(if (not jobgroup)
0 ;;
(let ((res 0))
(sqlite3:for-each-row
(lambda (count)
(set! res count))
db
(db:get-db dbstruct run-id)
"SELECT count(id) FROM tests WHERE state = 'RUNNING' OR state = 'LAUNCHED' OR state = 'REMOTEHOSTSTART'
AND testname in (SELECT testname FROM test_meta WHERE jobgroup=?);"
jobgroup)
res)))
;; done with run when:
;; 0 tests in LAUNCHED, NOT_STARTED, REMOTEHOSTSTART, RUNNING
(define (db:estimated-tests-remaining db run-id)
(define (db:estimated-tests-remaining dbstruct run-id)
(let ((res 0))
(sqlite3:for-each-row
(lambda (count)
(set! res count))
db ;; NB// KILLREQ means the jobs is still probably running
"SELECT count(id) FROM tests WHERE state in ('LAUNCHED','NOT_STARTED','REMOTEHOSTSTART','RUNNING','KILLREQ') AND run_id=?;" run-id)
(db:get-db dbstruct run-id) ;; NB// KILLREQ means the jobs is still probably running
"SELECT count(id) FROM tests WHERE state in ('LAUNCHED','NOT_STARTED','REMOTEHOSTSTART','RUNNING','KILLREQ');")
res))
;; map run-id, testname item-path to test-id
(define (db:get-test-id-cached db run-id testname item-path)
(let* ((test-key (conc run-id "-" testname "-" item-path))
(res (hash-table-ref/default *test-ids* test-key #f)))
(if res
res
(begin
(sqlite3:for-each-row
(lambda (id) ;; run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment )
(set! res id)) ;; (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment )))
db
"SELECT id FROM tests WHERE run_id=? AND testname=? AND item_path=?;"
run-id testname item-path)
(define (db:get-test-id-not dbstruct run-id testname item-path)
(hash-table-set! *test-ids* test-key res)
res))))
;; map run-id, testname item-path to test-id
(define (db:get-test-id-not-cached db run-id testname item-path)
(let* ((res #f))
(sqlite3:for-each-row
(lambda (id) ;; run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment )
(set! res id)) ;; (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment )))
db
"SELECT id FROM tests WHERE run_id=? AND testname=? AND item_path=?;"
run-id testname item-path)
(db:get-db dbstruct run-id)
"SELECT id FROM tests WHERE testname=? AND item_path=?;"
testname item-path)
res))
(define db:get-test-id db:get-test-id-not-cached)
(define db:test-record-qry-selector "id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir_id,item_path,run_duration,final_logf,comment,realdir_id")
;; given a test-info record, patch in the latest data from the testdat.db file
;; found in the test run directory
;;
;; NOT USED
;;
;; NOTE: Use db:test-get* to access records
;;
(define (db:patch-tdb-data-into-test-info db test-id res #!key (work-area #f))
(let ((tdb (db:open-test-db-by-test-id db test-id work-area: work-area)))
;; get state and status from megatest.db in real time
;; other fields that perhaps should be updated:
;; fail_count
;; pass_count
;; NOTE: This needs rundir_id decoding? Decide, decode here or where used? For the moment decode where used.
;;
;; Get test data using test_id
;; final_logf
(define (db:get-test-info-by-id dbstruct run-id test-id)
(let ((res #f))
(sqlite3:for-each-row
(lambda (state status final_logf)
(db:test-set-state! res state)
(db:test-set-status! res status)
(db:test-set-final_logf! res final_logf))
db
"SELECT state,status,final_logf FROM tests WHERE id=?;"
test-id)
(lambda (id run-id testname state status event-time host cpuload diskfree uname rundir-id item-path run_duration final_logf comment realdir-id)
;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14
(set! res (vector id run-id testname state status event-time host cpuload diskfree uname rundir-id item-path run_duration final_logf comment realdir-id)))
(db:get-db dbstruct run-id)
(conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id=?;")
test-id)
res))
;; Use db:test-get* to access
;;
;; Get test data using test_ids. NB// Only works within a single run!!
;;
(define (db:get-test-info-by-ids dbstruct run-id test-ids)
(if tdb
(begin
(sqlite3:for-each-row
(lambda (update_time cpuload disk_free run_duration)
(let ((res '()))
(sqlite3:for-each-row
(lambda (id run-id testname state status event-time host cpuload diskfree uname rundir-id item-path run_duration final_logf comment realdir-id)
(db:test-set-cpuload! res cpuload)
(db:test-set-diskfree! res disk_free)
(db:test-set-run_duration! res run_duration))
;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14
(set! res (cons (vector id run-id testname state status event-time host cpuload diskfree uname rundir-id item-path run_duration final_logf comment realdir-id)
tdb
"SELECT update_time,cpuload,diskfree,run_duration FROM test_rundat ORDER BY id DESC LIMIT 1;")
(sqlite3:finalize! tdb))
;; if the test db is not found what to do?
;; 1. set state to DELETED
;; 2. set status to n/a
(begin
res)))
(db:test-set-state! res "NOT_STARTED")
(db:test-set-status! res "n/a")))))
(db:get-db dbstruct run-id)
(conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id in ("
(define *last-test-cache-delete* (current-seconds))
(define (db:clean-all-caches)
(string-intersperse (map conc test-ids) ",") ");"))
res))
(set! *test-info* (make-hash-table))
(set! *test-id-cache* (make-hash-table)))
;; Use db:test-get* to access
;;
;; Get test data using test_id
(define (db:get-test-info-by-id db test-id)
(define (db:get-test-info dbstruct run-id testname item-path)
(if (not test-id)
(begin
(debug:print-info 4 "db:get-test-info-by-id called with test-id=" test-id)
#f)
(let ((res #f))
(sqlite3:for-each-row
(lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment)
(let ((res #f))
(sqlite3:for-each-row
(lambda (a . b)
;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14
(set! res (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment)))
db
"SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment FROM tests WHERE id=?;"
test-id)
res)))
(set! res (apply vector a b)))
(db:get-db dbstruct run-id)
(conc "SELECT " db:test-record-qry-selector " FROM tests WHERE testname=? AND item_path=?;")
test-name item-path)
res))
;; Use db:test-get* to access
;;
;; Get test data using test_ids
(define (db:get-test-info-by-ids db test-ids)
(define (db:test-set-comment dbstruct run-id test-id comment)
(if (null? test-ids)
(begin
(debug:print-info 4 "db:get-test-info-by-ids called with test-ids=" test-ids)
'())
(let ((res '()))
(sqlite3:for-each-row
(sqlite3:execute
(lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment)
;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14
(set! res (cons (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment)
res)))
db
(db:get-db dbstruct run-id)
(conc "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment FROM tests WHERE id in ("
(string-intersperse (map conc test-ids) ",") ");"))
res)))
"UPDATE tests SET comment=? WHERE id=?;"
comment test-id))
(define (db:get-test-info db run-id testname item-path)
(db:get-test-info-by-id db (db:get-test-id db run-id testname item-path)))
(define (db:test-set-comment db test-id comment)
(sqlite3:execute
db
"UPDATE tests SET comment=? WHERE id=?;"
GOT HERE!!!
comment test-id))
(define (cdb:test-set-rundir! serverdat run-id test-name item-path rundir)
(cdb:client-call serverdat 'test-set-rundir #t *default-numtries* rundir run-id test-name item-path))
(define (cdb:test-set-rundir-by-test-id serverdat test-id rundir)
(cdb:client-call serverdat 'test-set-rundir-by-test-id #t *default-numtries* rundir test-id))
|