Megatest

Check-in [37d1161e33]
Login
Overview
Comment:More conversion done for move to divided db
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | refactor-db
Files: files | file ages | folders
SHA1: 37d1161e3304b56bbebec434f33cbf87bff0b466
User & Date: matt on 2013-10-17 00:19:47
Other Links: branch diff | manifest | tags
Context
2013-10-17
23:46
Raw porting to dbstruct system done check-in: fef516eecc user: matt tags: refactor-db
00:19
More conversion done for move to divided db check-in: 37d1161e33 user: matt tags: refactor-db
2013-10-16
01:02
About 1/3 of db: routines converted (first pass, no debug or testing) to use hierarchial db check-in: 1f4e261000 user: matt tags: refactor-db
Changes

Modified db.scm from [b652df5659] to [d81032bdb1].

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) ... )
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
790
791
792
793
794
795
796







797
798
799
800
801
802
803







-
-
-
-
-
-
-







     (lambda (a . b) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment)
       (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:get-db dbstruct run-id)
     qry)
    res))





;; FIRST PASS CONVERSION DONE TO HERE



;; Convert calling routines to get list of run-ids and loop, do not use the get-tests-for-runs
;;

;; ;; ;; 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 dbstruct run-ids testpatt states status not-in)
;; ;;   (db:get-tests-for-runs dbstruct run-ids testpatt states status not-in: not-in qryvals: "id,run_id,testname,state,status,event_time,item_path"))
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))

1454
1455
1456
1457
1458
1459
1460
1461

1462
1463
1464
1465



1466
1467
1468
1469
1470
1471
1472
1406
1407
1408
1409
1410
1411
1412

1413
1414



1415
1416
1417
1418
1419
1420
1421
1422
1423
1424







-
+

-
-
-
+
+
+







                                      (SELECT status FROM tests WHERE id=?) NOT IN ('WARN','FAIL')
                                    THEN 'PASS'
                                    ELSE status
                                    END WHERE id=?;")
	'(test-set-log            "UPDATE tests SET final_logf=? WHERE id=?;")
	'(test-set-rundir-by-test-id "UPDATE tests SET rundir=? WHERE id=?")
	'(test-set-rundir         "UPDATE tests SET rundir=? WHERE run_id=? AND testname=? AND item_path=?;")
	'(delete-tests-in-state   "DELETE FROM tests WHERE state=? AND run_id=?;")
	'(delete-tests-in-state   "DELETE FROM tests WHERE state=?;")                  ;; DONE
	'(tests:test-set-toplog   "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path='';")
	'(update-cpuload-diskfree "UPDATE tests SET cpuload=?,diskfree=? WHERE id=?;")
	'(update-run-duration     "UPDATE tests SET run_duration=? WHERE id=?;")
	'(update-uname-host       "UPDATE tests SET uname=?,host=? WHERE id=?;")
	'(update-cpuload-diskfree "UPDATE tests SET cpuload=?,diskfree=? WHERE id=?;") ;; DONE
	'(update-run-duration     "UPDATE tests SET run_duration=? WHERE id=?;")       ;; DONE
	'(update-uname-host       "UPDATE tests SET uname=?,host=? WHERE id=?;")       ;; DONE
	'(update-test-state       "UPDATE tests SET state=? WHERE state=? AND run_id=? AND testname=? AND NOT (item_path='' AND testname IN (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));")
	'(update-test-status      "UPDATE tests SET status=? WHERE status like ? AND run_id=? AND testname=? AND NOT (item_path='' AND testname IN (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));")
	;; stuff for roll-up-pass-fail-counts
	'(update-fail-pass-counts "UPDATE tests 
             SET fail_count=(SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND status IN ('FAIL','CHECK')),
                 pass_count=(SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND status IN ('PASS','WARN','WAIVED'))
             WHERE run_id=? AND testname=? AND item_path='';")
1484
1485
1486
1487
1488
1489
1490




1491
1492
1493
1494
1495
1496
1497
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453







+
+
+
+







                                  WHEN (SELECT count(id) FROM tests
                                         WHERE run_id=? AND testname=?
                                              AND item_path != ''
                                              AND status = 'SKIP') > 0 THEN 'SKIP'
                                  ELSE 'UNKNOWN' END
                       WHERE run_id=? AND testname=? AND item_path='';")
	))

(define (db:lookup-query qry-name)
  (let ((q (alist-ref qry-name db:queries)))
    (if q (car q) #f)))

;; do not run these as part of the transaction
(define db:special-queries   '(rollup-tests-pass-fail
			       ;; db:roll-up-pass-fail-counts  ;; WHY NOT!?
			       login
			       immediate
			       flush