Megatest

Diff
Login

Differences From Artifact [dd4d66d695]:

To Artifact [7efe9252ff]:


26
27
28
29
30
31
32

33
34
35
36
37
38
39

40
41
42
43
44
45
46
47
































48







49





50


51

52
53
54
55
56
57
58




59
60
61




62
63
64
65
66
67




















68


69
70
71







72
73
74
75
76
77
78
79






80
81
82
83



84
85
86
87
88
89
90





































91



92
93
94
95
96
97
98
99
100
101
102
103
104
105






























106
107
108
109














110


111
112
113
114
115
116
117
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41








42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90

91







92
93
94
95



96
97
98
99






100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122



123
124
125
126
127
128
129








130
131
132
133
134
135




136
137
138







139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179














180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209




210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233







+







+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+

+
+
+
+
+

+
+
-
+
-
-
-
-
-
-
-
+
+
+
+
-
-
-
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+







(declare (unit db))
(declare (uses common))
(declare (uses keys))
(declare (uses ods))
(declare (uses fs-transport))
(declare (uses client))
(declare (uses mt))
(declare (uses sdb))
(declare (uses filedb))

(include "common_records.scm")
(include "db_records.scm")
(include "key_records.scm")
(include "run_records.scm")

(define *rundb-mutex* (make-mutex)) ;; prevent problems opening/closing rundb's
;; timestamp type (val1 val2 ...)
;; type: meta-info, step
(define *incoming-writes*      '())
(define *completed-writes*   (make-hash-table))
(define *incoming-last-time* (current-seconds))
(define *incoming-mutex*     (make-mutex))
(define *completed-mutex*    (make-mutex))
(define *cache-on* #f)

;; Get/open a database
;;    if run-id => get run specific db
;;    if #f     => get main db
;;    if db already open - return inmem
;;    if db not open, open inmem, rundb and sync then return inmem
;;    inuse gets set automatically for rundb's
;;
(define (db:get-db dbstruct run-id)
  (mutex-lock! *rundb-mutex*)
  (let ((db (if run-id
		(db:open-rundb dbstruct run-id)
		(db:open-main dbstruct))))
    ;; db prunning would go here
    (mutex-unlock! *rundb-mutex*)
    db))

;; mod-read:
;;     'mod   modified data
;;     'read  read data
;;
(define (db:done-with dbstruct run-id mod-read)
  (mutex-lock! *rundb-mutex*)
  (if (eq? mod-read 'mod)
      (dbr:dbstruct-set-runvec! dbstruct run-id 'mtime (current-milliseconds))
      (dbr:dbstruct-set-runvec! dbstruct run-id 'rtime (current-milliseconds)))
  (dbr:dbstruct-set-runvec! dbstruct run-id 'inuse #f)
  (mutex-unlock! *rundb-mutex*))

;;======================================================================
;; K E E P   F I L E D B   I N   dbstruct
;;======================================================================

(define (db:get-filedb dbstruct)
  (let ((db (vector-ref dbstruct 2)))
    (if db
	db
	(let ((fdb (filedb:open-db (conc *toplevel* "/db/files.db"))))
	  (vector-set! dbstruct 2 fdb)
	  fdb))))

;; Can also be used to save arbitrary strings
;;
(define (db:save-path dbstruct path)
  (let ((fdb (db:get-filedb dbstruct)))
    (filedb:register-path fdb path)))

;; Use to get a path. To get an arbitrary string see next define
;;
(define (db:set-sync db)
(define (db:get-path dbstruct id)
  (let* ((syncval  (config-lookup *configdat* "setup"     "synchronous"))
	 (val      (cond   ;; 0 | OFF | 1 | NORMAL | 2 | FULL;
		    ((not syncval) #f)
		    ((string->number syncval)
		     (let ((val (string->number syncval)))
		       (if (member val '(0 1 2)) val #f)))
		    ((string-match (regexp "yes" #t) syncval) 1)
  (let ((fdb (db:get-filedb dbstruct)))
    (filedb:get-path db id)))

;; This routine creates the db. It is only called if the db is not already opened
		    ((string-match (regexp "no"  #t) syncval) 0)
		    ((string-match (regexp "(off|normal|full)" #t) syncval) syncval)
		    (else 
;; 
(define (db:open-rundb dbstruct run-id) ;;  (conc *toppath* "/megatest.db") (car *configinfo*)))
  (let ((rdb (dbr:dbstruct-get-runrec dbstruct run-id 'inmem)))
    (if rdb
		     (debug:print 0 "ERROR: synchronous must be 0,1,2,OFF,NORMAL or FULL, you provided: " syncval)
		     #f))))
    (if val
	(begin
	  (debug:print-info 9 "db:set-sync, setting pragma synchronous to " val)
	  (sqlite3:execute db (conc "PRAGMA synchronous = '" val "';"))))))
	rdb
	(let* ((toppath      (dbr:dbstruct-get-path dbstruct))
	       (dbpath       (conc toppath "/db/" run-id ".db"))
	       (dbexists     (file-exists? dbpath))
	       (inmem        (open-inmem-db))
	       (db           (sqlite3:open-database dbpath))
	       (write-access (file-write-access? dbpath))
	       (handler      (make-busy-timeout 136000)))
	  (if (and dbexists (not write-access))
	      (set! *db-write-access* #f)) ;; only unset so other db's also can use this control
	  (if write-access
	      (begin
		(sqlite3:set-busy-handler! db handler)
		(sqlite3:execute db "PRAGMA synchronous = 0;")))
	  (if (not dbexists)(db:initialize-run-id-db db run-id))
	  (dbr:dbstruct-set-runvec! dbstruct run-id 'rundb db)
	  (dbr:dbstruct-set-runvec! dbstruct run-id 'inmem inmem)
	  (dbr:dbstruct-set-runvec! dbstruct run-id 'inuse #t)
	  (db:sync-tables db:sync-tests-only db inmem)
	  inmem))))

;; This routine creates the db. It is only called if the db is not already opened
;;
(define (open-db) ;;  (conc *toppath* "/megatest.db") (car *configinfo*)))
  (if (not *toppath*)
      (if (not (setup-for-run))
(define (db:open-main dbstruct) ;;  (conc *toppath* "/megatest.db") (car *configinfo*)))
  (let ((mdb (dbr:dbstruct-get-main dbstruct)))
    (if mdb
	mdb
	(let* ((toppath      (dbr:dbstruct-get-path dbstruct))
	       (dbpath       (let ((dbdir (conc *toppath* "/db"))) ;; use this opportunity to create our db dir
			       (if (not (directory-exists? dbdir))
	  (begin
	    (debug:print 0 "ERROR: Attempted to open db when not in megatest area. Exiting.")
	    (exit))))
  (let* ((dbpath    (conc *toppath* "/megatest.db")) ;; fname)
	 (dbexists  (file-exists? dbpath))
	 (db        (sqlite3:open-database dbpath)) ;; (never-give-up-open-db dbpath))
	 (write-access (file-write-access? dbpath))
	 (handler   (make-busy-timeout (if (args:get-arg "-override-timeout")
				   (create-direcory dbdir))
			       (conc *toppath* "/db/main.db")))
	       (dbexists     (file-exists? dbpath))
	       (db           (sqlite3:open-database dbpath)) ;; (never-give-up-open-db dbpath))
	       (write-access (file-write-access? dbpath))
	       (handler      (make-busy-timeout 136000)))
					   (string->number (args:get-arg "-override-timeout"))
					   136000)))) ;; 136000))) ;; 136000 = 2.2 minutes
    (if (and dbexists
	     (not write-access))
	  (if (and dbexists (not write-access))
	      (set! *db-write-access* #f))
	  (if write-access 
	(set! *db-write-access* write-access)) ;; only unset so other db's also can use this control
    (debug:print-info 11 "open-db, dbpath=" dbpath " argv=" (argv))
    (if write-access (sqlite3:set-busy-handler! db handler))
    (if (not dbexists)
	(db:initialize db))
    ;; Moving db:set-sync to a call in run.scm - it is a persistent value and only needs to be set once
    ;; (db:set-sync db)
	      (begin
		(sqlite3:set-busy-handler! db handler)
		(sqlite3:execute db "PRAGMA synchronous = 0;")))
	  (if (not dbexists)
	      (db:initialize-megatest-db db))
	  (dbr:dbstruct-set-main! dbstruct db)
	  db))))

;; sync all touched runs to disk
(define (db:sync-touched dbstruct)
  (for-each
   (lambda (runvec)
     (let ((mtime (vector-ref runvec (dbr:dbstruct-field-name->num 'mtime)))
	   (stime (vector-ref runvec (dbr:dbstruct-field-name->num 'stime)))
	   (rundb (vector-ref runvec (dbr:dbstruct-field-name->num 'rundb)))
	   (inmem (vector-ref runvec (dbr:dbstruct-field-name->num 'inmem))))
       (if (> mtime stime)
	   (begin
	     (db:sync-tables db:sync-tests-only inmem rundb)
	     (vector-set! runvec (dbr:dbstruct-field-name->run 'stime (current-milliseconds)))))))
   (hash-table-values (vector-ref dbstruct 1))))

;; close all opened run-id dbs
(define (db:close-all-db)
  (for-each
   (lambda (db)
     (finalize! db))
   (hash-table-values (vector-ref *open-dbs* 1)))
  (finalize! (vector-ref *open-dbs* 0)))

(define (open-inmem-db)
  (let* ((db      (sqlite3:open-database ":memory:"))
	 (handler   (make-busy-timeout 3600)))
    (db:initialize db)
    (sqlite3:set-busy-handler! db handler)
    (set! sdb:qry (make-sdb:qry)) ;; we open the normalization helpers here
    (set! *fdb*   (filedb:open-db (conc *toppath* "/db/paths.db")))
    db))

;; just tests, test_steps and test_data tables
(define db:sync-tests-only

(define (open-in-mem-db)
  (let* ((path   (configf:lookup *configdat* "setup" "tmpdb"))
	 (fname  (if path (conc path "/temp-megatest.db") #f))
	 (exists (and path (file-exists? fname)))
	 (db     (if path
		     (begin
		       (create-directory path #t)
		       (sqlite3:open-database fname))
		     (sqlite3:open-database ":memory:")))
	 (handler   (make-busy-timeout 3600)))
    (if (or (not path)
	    (not exists))
	(db:initialize db))
  (list
   (list "tests" 
	 '("id"             #f)
	 '("run_id"         #f)
	 '("testname"       #f)
	 '("host"           #f)
	 '("cpuload"        #f)
	 '("diskfree"       #f)
	 '("uname"          #f)
	 '("rundir"         #f)
	 '("shortdir"       #f)
	 '("item_path"      #f)
	 '("state"          #f)
	 '("status"         #f)
	 '("attemptnum"     #f)
	 '("final_logf"     #f)
	 '("logdat"         #f)
	 '("run_duration"   #f)
	 '("comment"        #f)
	 '("event_time"     #f)
	 '("fail_count"     #f)
	 '("pass_count"     #f)
	 '("archived"       #f))
   (list "test_steps"
	 '("id"             #f)
	 '("test_id"        #f)
	 '("stepname"       #f)
	 '("state"          #f)
	 '("status"         #f)
	 '("event_time"     #f)
    (sqlite3:set-busy-handler! db handler)
    db))

;; (define (db:sync-table tblname fields fromdb todb)
	 '("comment"        #f)
	 '("logfile"        #f))
   (list "test_data"
	 '("id"             #f)
	 '("test_id"        #f)
	 '("category"       #f)
	 '("variable"       #f)
	 '("value"          #f)
	 '("expected"       #f)
	 '("tol"            #f)
	 '("units"          #f)
	 '("comment"        #f)
	 '("status"         #f)
	 '("type"           #f))))

;; needs db to get keys, this is for syncing all tables
;;
(define (db:tbls db)
  (let ((keys  (db:get-keys db)))
    (list
     (list "keys"
	   '("id"        #f)
	   '("fieldname" #f)
	   '("fieldtype" #f))
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
352
353
354
355
356
357
358


















































































































359
360
361
362
363
364
365







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







       (lambda (dat)
	 (let ((tblname (car dat))
	       (count   (cdr dat)))
	   (if (> count 0)
	       (debug:print 0 (format #f "    ~10a ~5a" tblname count)))))
       (sort (hash-table->alist numrecs)(lambda (a b)(> (cdr a)(cdr b))))))))

;; (define (db:sync-to fromdb todb)
;;   ;; strategy
;;   ;;  1. Get all run-ids
;;   ;;  2. For each run-id 
;;   ;;     a. Sync that run in a transaction
;;   (let ((trecchgd    0)
;; 	(rrecchgd    0)
;; 	(tmrecchgd   0))
;; 
;;     ;; First sync test_meta data
;;     (let ((tmgetstmt (sqlite3:prepare todb "SELECT id,testname,author,owner,description,reviewed,iterated,avg_runtime,avg_disk,tags,jobgroup FROM test_meta WHERE id=?;"))
;; 	  (tmputstmt (sqlite3:prepare todb "INSERT OR REPLACE INTO test_meta (id,testname,author,owner,description,reviewed,iterated,avg_runtime,avg_disk,tags,jobgroup) 
;;                                                                       VALUES (?, ?,       ?,     ?,    ?,          ?,       ?,       ?,          ?,       ?,   ?);"))
;; 	  (tmdats    (db:testmeta-get-all fromdb)))
;;       ;; (debug:print 7 "Updating as many as " (length tdats) " records for run " run-id)
;;       (for-each
;;        (lambda (tmdat) ;; iterate over tests
;; 	 (let ((testm-id (vector-ref tmdat 0)))
;; 	   (sqlite3:with-transaction
;; 	    todb
;; 	    (lambda ()
;; 	      (let ((curr-tmdat #f))
;; 		(sqlite3:for-each-row
;; 		 (lambda (a . b)
;; 		   (set! curr-tmdat (apply vector a b)))
;; 		 tmgetstmt testm-id)
;; 		(if (not (equal? curr-tmdat tmdat)) ;; something changed
;; 		    (begin
;; 		      (debug:print 0 "  test-id: " testm-id
;; 				   "\ncurr-tdat: " curr-tmdat
;; 				   "\n     tdat: " tmdat)
;; 		      (apply sqlite3:execute tmputstmt (vector->list tmdat))
;; 		      (set! tmrecchgd (+ tmrecchgd 1)))))))))
;;        tmdats)
;;       (sqlite3:finalize! tmgetstmt)
;;       (sqlite3:finalize! tmputstmt))
;; 
;;     ;; First sync tests data
;;     (let ((run-ids     (db:get-all-run-ids fromdb))
;; 	  (tgetstmt    (sqlite3:prepare todb "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=?;"))
;; 	  (tputstmt    (sqlite3:prepare todb "INSERT OR REPLACE INTO tests  (id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment)
;;                                                                     VALUES (?, ?,     ?,       ?,    ?,     ?,         ?,   ?,      ?,       ?,    ?,     ?,        ?,           ?,         ?     );")))
;;       (for-each
;;        (lambda (run-id)
;; 	 (let ((tdats     (db:get-all-tests-info-by-run-id fromdb run-id)))
;; 	   ;; (debug:print 7 "Updating as many as " (length tdats) " records for run " run-id)
;; 	   (for-each
;; 	    (lambda (tdat) ;; iterate over tests
;; 	      (let ((test-id (vector-ref tdat 0)))
;; 		(sqlite3:with-transaction
;; 		 todb
;; 		 (lambda ()
;; 		   (let ((curr-tdat #f))
;; 		     (sqlite3:for-each-row
;; 		      (lambda (a . b)
;; 			(set! curr-tdat (apply vector a b)))
;; 		      tgetstmt
;; 		      test-id)
;; 		     (if (not (equal? curr-tdat tdat)) ;; something changed
;; 			 (begin
;; 			   (debug:print 0 "  test-id: " test-id
;; 					"\ncurr-tdat: " curr-tdat
;; 					"\n     tdat: " tdat)
;; 			   (apply sqlite3:execute tputstmt (vector->list tdat))
;; 			   (set! trecchgd (+ trecchgd 1)))))))))
;; 	    tdats)))
;;        run-ids)
;;       (sqlite3:finalize! tgetstmt)
;;       (sqlite3:finalize! tputstmt))
;; 
;;     ;; Next sync runs table
;;     (let* ((rdats       '())
;; 	   (keys        (db:get-keys fromdb))
;; 	   (rstdfields  (conc "id," (string-intersperse keys ",") ",runname,state,status,owner,event_time,comment,fail_count,pass_count"))
;; 	   (rnumfields  (length (string-split rstdfields ",")))
;; 	   (runslots    (string-intersperse (make-list rnumfields "?") ","))
;; 	   (rgetstmt    (sqlite3:prepare todb (conc "SELECT " rstdfields " FROM runs WHERE id=?;")))
;; 	   (rputstmt    (sqlite3:prepare todb (conc "INSERT OR REPLACE INTO runs (" rstdfields ") VALUES ( " runslots " );"))))
;;       ;; first collect all the source run data
;;       (sqlite3:for-each-row
;;        (lambda (a . b)
;; 	 (set! rdats (cons (apply vector a b) rdats)))
;;        fromdb
;;        (conc "SELECT " rstdfields " FROM runs;"))
;;       (sqlite3:with-transaction
;;        todb
;;        (lambda ()
;; 	 (for-each 
;; 	  (lambda (rdat)
;; 	    (let ((run-id    (vector-ref rdat 0))
;; 		  (curr-rdat #f))
;; 	      ;; first get the current value of the equivalent row from the target
;; 	      ;; read, then insert/overwrite if different
;; 	      (sqlite3:for-each-row 
;; 	       (lambda (a . b)
;; 		 (set! curr-rdat (apply vector a b)))
;; 	       rgetstmt
;; 	       run-id)
;; 	      (if (not (equal? curr-rdat rdat))
;; 		  (begin
;; 		    (debug:print 0 "   run-id: " run-id
;; 				 "\ncurr-rdat: " curr-rdat
;; 				 "\n     rdat: " rdat)
;; 		    (set! rrecchgd (+ rrecchgd 1))
;; 		    (apply sqlite3:execute rputstmt (vector->list rdat))))))
;; 	  rdats)))
;;       (sqlite3:finalize! rgetstmt)
;;       (sqlite3:finalize! rputstmt))
;; 
;;     (if (> rrecchgd 0)  (debug:print 0 "synced " rrecchgd " changed records in runs  table"))
;;     (if (> trecchgd 0)  (debug:print 0 "synced " trecchgd " changed records in tests table"))
;;     (if (> tmrecchgd 0) (debug:print 0 "sync'd " tmrecchgd " changed records in test_meta table"))
;;     (+ rrecchgd trecchgd tmrecchgd)))

(define (db:sync-back)
  (db:sync-tables (db:tbls *inmemdb*) *inmemdb* *db*)) ;; (db:sync-to *inmemdb* *db*))

;; keeping it around for debugging purposes only
(define (open-run-close-no-exception-handling  proc idb . params)
  (debug:print-info 11 "open-run-close-no-exception-handling START given a db=" (if idb "yes " "no ") ", params=" params)
  (if (or *db-write-access*
382
383
384
385
386
387
388
389
390


391
392
393
394
395

396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411

412
413
414

415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448













449


450
451













452
453
454
455
456
457
458
384
385
386
387
388
389
390


391
392





393
















394

395

396

397
398
399
400
401
402
403
404
405
406
407
408
409
410
411


412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443


444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463







-
-
+
+
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-

-
+
-















-
-
















+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+







     (debug:print 0 "  " ((condition-property-accessor 'exn 'message) exn))
     (print-call-chain)
     (thread-sleep! (random 120))
     (debug:print-info 0 "trying db call one more time....")
     (apply open-run-close-no-exception-handling proc idb params))
   (apply open-run-close-no-exception-handling proc idb params)))

;; (define open-run-close open-run-close-exception-handling)
(define open-run-close open-run-close-no-exception-handling)
;; (define open-run-close 
(define open-run-close (if (debug:debug-mode 2)

(define *global-delta* 0)
(define *last-global-delta-printed* 0)

(define (open-run-close-measure  proc idb . params)
			   open-run-close-no-exception-handling
  (debug:print-info 11 "open-run-close-measure START, idb=" idb ", params=" params)
  (let* ((start-ms (current-milliseconds))
	 (db       (if idb idb (open-db)))
         (throttle (string->number (config-lookup *configdat* "setup" "throttle"))))
    ;; (db:set-sync db)
    (set! res      (apply proc db params))
    (if (not idb)(sqlite3:finalize! db))
    ;; scale by 10, average with current value.
    (set! *global-delta* (/ (+ *global-delta* (* (- (current-milliseconds) start-ms)
						 (if throttle throttle 0.01)))
			    2))
    (if (> (abs (- *last-global-delta-printed* *global-delta*)) 0.08) ;; don't print all the time, only if it changes a bit
	(begin
	  (debug:print-info 1 "launch throttle factor=" *global-delta*)
	  (set! *last-global-delta-printed* *global-delta*)))
    (debug:print-info 11 "open-run-close-measure END" )
			   open-run-close-exception-handling))
    res))

(define (db:initialize db)
(define (db:initialize-megatest-db db)
  (debug:print-info 11 "db:initialize START")
  (let* ((configdat (car *configinfo*))  ;; tut tut, global warning...
	 (keys     (keys:config-get-fields configdat))
	 (havekeys (> (length keys) 0))
	 (keystr   (keys->keystr keys))
	 (fieldstr (keys->key/field keys)))
    (for-each (lambda (key)
		(let ((keyn key))
		  (if (member (string-downcase keyn)
			      (list "runname" "state" "status" "owner" "event_time" "comment" "fail_count"
				    "pass_count"))
		      (begin
			(print "ERROR: your key cannot be named " keyn " as this conflicts with the same named field in the runs table")
			(system (conc "rm -f " dbpath))
			(exit 1)))))
	      keys)
    ;; (sqlite3:execute db "PRAGMA synchronous = OFF;")
    (db:set-sync db)
    (sqlite3:execute db "CREATE TABLE IF NOT EXISTS keys (id INTEGER PRIMARY KEY, fieldname TEXT, fieldtype TEXT, CONSTRAINT keyconstraint UNIQUE (fieldname));")
    (for-each (lambda (key)
		(sqlite3:execute db "INSERT INTO keys (fieldname,fieldtype) VALUES (?,?);" key "TEXT"))
	      keys)
    (sqlite3:execute db (conc 
			 "CREATE TABLE IF NOT EXISTS runs (id INTEGER PRIMARY KEY, " 
			 fieldstr (if havekeys "," "")
			 "runname    TEXT DEFAULT 'norun',"
			 "state      TEXT DEFAULT '',"
			 "status     TEXT DEFAULT '',"
			 "owner      TEXT DEFAULT '',"
			 "event_time TIMESTAMP DEFAULT (strftime('%s','now')),"
			 "comment    TEXT DEFAULT '',"
			 "fail_count INTEGER DEFAULT 0,"
			 "pass_count INTEGER DEFAULT 0,"
			 "CONSTRAINT runsconstraint UNIQUE (runname" (if havekeys "," "") keystr "));"))
    (sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_meta (
                                     id          INTEGER PRIMARY KEY,
                                     testname    TEXT DEFAULT '',
                                     author      TEXT DEFAULT '',
                                     owner       TEXT DEFAULT '',
                                     description TEXT DEFAULT '',
                                     reviewed    TIMESTAMP,
                                     iterated    TEXT DEFAULT '',
                                     avg_runtime REAL,
                                     avg_disk    REAL,
                                     tags        TEXT DEFAULT '',
                                     jobgroup    TEXT DEFAULT 'default',
                                CONSTRAINT test_meta_constraint UNIQUE (testname));")
    (sqlite3:execute db (conc "CREATE INDEX runs_index ON runs (runname" (if havekeys "," "") keystr ");"))
    ;; (sqlite3:execute db "CREATE VIEW runs_tests AS SELECT * FROM runs INNER JOIN tests ON runs.id=tests.run_id;")
    (sqlite3:execute db "CREATE TABLE IF NOT EXISTS extradat (id INTEGER PRIMARY KEY, run_id INTEGER, key TEXT, val TEXT);")
    (sqlite3:execute db 
		     "CREATE TABLE IF NOT EXISTS tests 
    (sqlite3:execute db "CREATE TABLE IF NOT EXISTS metadat (id INTEGER PRIMARY KEY, var TEXT, val TEXT,
                                  CONSTRAINT metadat_constraint UNIQUE (var));")
    (sqlite3:execute db "CREATE TABLE IF NOT EXISTS access_log (id INTEGER PRIMARY KEY, user TEXT, accessed TIMESTAMP, args TEXT);")
    ;; Must do this *after* running patch db !! No more. 
    (db:set-var db "MEGATEST_VERSION" megatest-version)
    (debug:print-info 11 "db:initialize END")))

;;======================================================================
;; R U N   S P E C I F I C   D B 
;;======================================================================

(define (db:initialized-run-id-db db run-id)
  (sqlite3:execute db "CREATE TABLE IF NOT EXISTS tests 
                    (id INTEGER PRIMARY KEY,
                     run_id       INTEGER   DEFAULT -1,
                     testname     TEXT      DEFAULT 'noname',
                     host         TEXT      DEFAULT 'n/a',
                     cpuload      REAL      DEFAULT -1,
                     diskfree     INTEGER   DEFAULT -1,
                     uname        TEXT      DEFAULT 'n/a', 
466
467
468
469
470
471
472
473

474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491

492
493
494

495
496
497
498
499
500
501
502







503
504
505
506
507
508
509
510
511
512
513
514
515
516



517
518






519
520
521
522
523
524
525
471
472
473
474
475
476
477

478

479

480
481
482
483
484
485
486
487
488
489





490



491








492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510


511
512
513


514
515
516
517
518
519
520
521
522
523
524
525
526







-
+
-

-










-
-
-
-
-
+
-
-
-
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+












-
-
+
+
+
-
-
+
+
+
+
+
+







                     logdat       TEXT      DEFAULT '', 
                     run_duration INTEGER   DEFAULT 0,
                     comment      TEXT      DEFAULT '',
                     event_time   TIMESTAMP DEFAULT (strftime('%s','now')),
                     fail_count   INTEGER   DEFAULT 0,
                     pass_count   INTEGER   DEFAULT 0,
                     archived     INTEGER   DEFAULT 0, -- 0=no, 1=in progress, 2=yes
                     CONSTRAINT testsconstraint UNIQUE (run_id, testname, item_path)
                        CONSTRAINT testsconstraint UNIQUE (run_id, testname, item_path));")
          );")
    (sqlite3:execute db "CREATE INDEX tests_index ON tests (run_id, testname, item_path);")
    (sqlite3:execute db "CREATE VIEW runs_tests AS SELECT * FROM runs INNER JOIN tests ON runs.id=tests.run_id;")
    (sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_steps 
                              (id INTEGER PRIMARY KEY,
                               test_id INTEGER, 
                               stepname TEXT, 
                               state TEXT DEFAULT 'NOT_STARTED', 
                               status TEXT DEFAULT 'n/a',
                               event_time TIMESTAMP,
                               comment TEXT DEFAULT '',
                               logfile TEXT DEFAULT '',
                               CONSTRAINT test_steps_constraint UNIQUE (test_id,stepname,state));")
    (sqlite3:execute db "CREATE TABLE IF NOT EXISTS extradat (id INTEGER PRIMARY KEY, run_id INTEGER, key TEXT, val TEXT);")
    (sqlite3:execute db "CREATE TABLE IF NOT EXISTS metadat (id INTEGER PRIMARY KEY, var TEXT, val TEXT,
                                  CONSTRAINT metadat_constraint UNIQUE (var));")
    (sqlite3:execute db "CREATE TABLE IF NOT EXISTS access_log (id INTEGER PRIMARY KEY, user TEXT, accessed TIMESTAMP, args TEXT);")
    (sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_meta (id INTEGER PRIMARY KEY,
;;   (sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_data 
                                     testname    TEXT DEFAULT '',
                                     author      TEXT DEFAULT '',
                                     owner       TEXT DEFAULT '',
;;                               (id          INTEGER PRIMARY KEY,
                                     description TEXT DEFAULT '',
                                     reviewed    TIMESTAMP DEFAULT (strftime('%s','now')),
                                     iterated    TEXT DEFAULT '',
                                     avg_runtime REAL DEFAULT -1,
                                     avg_disk    REAL DEFAULT -1,
                                     tags        TEXT DEFAULT '',
                                     jobgroup    TEXT DEFAULT 'default',
                                CONSTRAINT test_meta_constraint UNIQUE (testname));")
;;                                      reviewed    TIMESTAMP DEFAULT (strftime('%s','now')),
;;                                      iterated    TEXT DEFAULT '',
;;                                      avg_runtime REAL DEFAULT -1,
;;                                      avg_disk    REAL DEFAULT -1,
;;                                      tags        TEXT DEFAULT '',
;;                                      jobgroup    TEXT DEFAULT 'default',
;;                                 CONSTRAINT test_meta_constraint UNIQUE (testname));")
    (sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_data (id INTEGER PRIMARY KEY,
                                test_id INTEGER,
                                category TEXT DEFAULT '',
                                variable TEXT,
	                        value REAL,
	                        expected REAL,
	                        tol REAL,
                                units TEXT,
                                comment TEXT DEFAULT '',
                                status TEXT DEFAULT 'n/a',
                                type TEXT DEFAULT '',
                              CONSTRAINT test_data_constraint UNIQUE (test_id,category,variable));")
    ;; Must do this *after* running patch db !! No more. 
    (db:set-var db "MEGATEST_VERSION" megatest-version)
  (sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_rundat (
                              id           INTEGER PRIMARY KEY,
                              test_id      INTEGER,
    (debug:print-info 11 "db:initialize END")
    ))
                              update_time  TIMESTAMP,
                              cpuload      INTEGER DEFAULT -1,
                              diskfree     INTEGER DEFAULT -1,
                              diskusage    INTGER DEFAULT -1,
                              run_duration INTEGER DEFAULT 0);")
  db)

;;======================================================================
;; L O G G I N G    D B 
;;======================================================================

(define (open-logging-db) ;;  (conc *toppath* "/megatest.db") (car *configinfo*)))
  (let* ((dbpath    (conc (if *toppath* (conc *toppath* "/") "") "logging.db")) ;; fname)
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556

557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
534
535
536
537
538
539
540



541
542
543
544
545
546
547
548
549
550
551
552
553

554


555















































































556
557
558
559
560
561
562







-
-
-













-
+
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







	(begin
	  (sqlite3:execute db "CREATE TABLE IF NOT EXISTS log (id INTEGER PRIMARY KEY,event_time TIMESTAMP DEFAULT (strftime('%s','now')),logline TEXT,pwd TEXT,cmdline TEXT,pid INTEGER);")
	  (sqlite3:execute db (conc "PRAGMA synchronous = 0;"))))
    db))

(define (db:log-local-event . loglst)
  (let ((logline (apply conc loglst)))
    ;; (pwd     (current-directory))
    ;; (cmdline (string-intersperse (argv) " "))
    ;; (pid     (current-process-id)))
    (db:log-event logline)))

(define (db:log-event logline)
  (let ((db (open-logging-db)))
    (sqlite3:execute db "INSERT INTO log (logline,pwd,cmdline,pid) VALUES (?,?,?,?);"
		     logline
		     (current-directory)
		     (string-intersperse (argv) " ")
		     (current-process-id))
    (sqlite3:finalize! db)
    logline))

;;======================================================================
;; TODO:
;; D B   U T I L S
;;   put deltas into an assoc list with version numbers
;;   apply all from last to current
;;======================================================================
(define (patch-db db)
  (handle-exceptions
   exn
   (begin
     (print "Exception: " exn)
     (print "ERROR: Possible out of date schema, attempting to add table metadata...")
     (sqlite3:execute db "CREATE TABLE IF NOT EXISTS metadat (id INTEGER, var TEXT, val TEXT,
                                 CONSTRAINT metadat_constraint UNIQUE (var));")
     (if (not (db:get-var db "MEGATEST_VERSION"))
	 (db:set-var db "MEGATEST_VERSION" 1.17)))
   (let ((mver (db:get-var db "MEGATEST_VERSION"))
	 (test-meta-def "CREATE TABLE IF NOT EXISTS test_meta (id INTEGER PRIMARY KEY,
                                     testname    TEXT DEFAULT '',
                                     author      TEXT DEFAULT '',
                                     owner       TEXT DEFAULT '',
                                     description TEXT DEFAULT '',
                                     reviewed    TIMESTAMP,
                                     iterated    TEXT DEFAULT '',
                                     avg_runtime REAL,
                                     avg_disk    REAL,
                                     tags        TEXT DEFAULT '',
                                CONSTRAINT test_meta_constraint UNIQUE (testname));"))
     (print "Current schema version: " mver " current megatest version: " megatest-version)
     (cond
      ((not mver)
       (print "Adding megatest-version to metadata") ;; Need to recreate the table
       (sqlite3:execute db "DROP TABLE IF EXISTS metadat;")
       (sqlite3:execute db "CREATE TABLE IF NOT EXISTS metadat (id INTEGER, var TEXT, val TEXT,
                                  CONSTRAINT metadat_constraint UNIQUE (var));")
       (db:set-var db "MEGATEST_VERSION" 1.17)
       (patch-db))
      ((< mver 1.21)
       (sqlite3:execute db "DROP TABLE IF EXISTS metadat;")
       (sqlite3:execute db "CREATE TABLE IF NOT EXISTS metadat (id INTEGER, var TEXT, val TEXT,
                                  CONSTRAINT metadat_constraint UNIQUE (var));")
       (db:set-var db "MEGATEST_VERSION" 1.21) ;; set before, just in case the changes are already applied
       (sqlite3:execute db test-meta-def)
					;(for-each 
					; (lambda (stmt)
					;   (sqlite3:execute db stmt))
					; (list 
					;  "ALTER TABLE tests ADD COLUMN first_err TEXT;"
					;  "ALTER TABLE tests ADD COLUMN first_warn TEXT;"
					;  ))
       (patch-db))
      ((< mver 1.24)
       (db:set-var db "MEGATEST_VERSION" 1.24)
       (sqlite3:execute db "DROP TABLE IF EXISTS test_data;")
       (sqlite3:execute db "DROP TABLE IF EXISTS test_meta;")
       (sqlite3:execute db test-meta-def)
       (sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_data (id INTEGER PRIMARY KEY,
                                test_id INTEGER,
                                category TEXT DEFAULT '',
                                variable TEXT,
	                        value REAL,
	                        expected REAL,
	                        tol REAL,
                                units TEXT,
                                comment TEXT DEFAULT '',
                                status TEXT DEFAULT 'n/a',
                              CONSTRAINT test_data UNIQUE (test_id,category,variable));")
       (print "WARNING: Table test_data and test_meta were recreated. Please do megatest -update-meta")
       (patch-db))
      ((< mver 1.27)
       (db:set-var db "MEGATEST_VERSION" 1.27)
       (sqlite3:execute db "ALTER TABLE test_data ADD COLUMN type TEXT DEFAULT '';")
       (patch-db))
      ((< mver 1.29)
       (db:set-var db "MEGATEST_VERSION" 1.29)
       (sqlite3:execute db "ALTER TABLE test_steps ADD COLUMN logfile TEXT DEFAULT '';")
       (sqlite3:execute db "ALTER TABLE tests ADD COLUMN shortdir TEXT DEFAULT '';"))
      ((< mver 1.36)
       (db:set-var db "MEGATEST_VERSION" 1.36)
       (sqlite3:execute db "ALTER TABLE test_meta ADD COLUMN jobgroup TEXT DEFAULT 'default';"))
      ((< mver 1.37)
       (db:set-var db "MEGATEST_VERSION" 1.37)
       (sqlite3:execute db "ALTER TABLE tests ADD COLUMN archived INTEGER DEFAULT 0;")) 
      ((< mver megatest-version)
       (db:set-var db "MEGATEST_VERSION" megatest-version))))))

;;======================================================================
;; M A I N T E N A N C E
;;======================================================================

;;  select end_time-now from
;;      (select testname,item_path,event_time+run_duration as
703
704
705
706
707
708
709
710
711






712
713
714
715
716
717
718
620
621
622
623
624
625
626


627
628
629
630
631
632
633
634
635
636
637
638
639







-
-
+
+
+
+
+
+







;; 1. Look at test records either deleted or part of deleted run:
;;    a. If test dir exists, set the the test to state='UNKNOWN', Set the run to 'unknown'
;;    b. If test dir gone, delete the test record
;; 2. Look at run records
;;    a. If have tests that are not deleted, set state='unknown'
;;    b. ....
;;
(define (db:clean-up db)
  (let ((count-stmt (sqlite3:prepare db "SELECT (SELECT count(id) FROM tests)+(SELECT count(id) FROM runs);"))
(define (db:clean-up dbstruct)

  (debug:print 0 "ERROR: db clean up not ported yet")

  (let* ((db         (db:get-db dbstruct #f))
	 (count-stmt (sqlite3:prepare db "SELECT (SELECT count(id) FROM tests)+(SELECT count(id) FROM runs);"))
	(statements
	 (map (lambda (stmt)
		(sqlite3:prepare db stmt))
	      (list
	       ;; delete all tests that belong to runs that are 'deleted'
	       "DELETE FROM tests WHERE run_id in (SELECT id FROM runs WHERE state='deleted');"
	       ;; delete all tests that are 'DELETED'
736
737
738
739
740
741
742
743

744
745
746
747



748

749
750
751
752
753
754
755
756

757

758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773

774
775

776
777
778

779
780

781
782
783
784
785
786
787
788
789
790

791
792
793
794
795
796

797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816

817
818
819
820
821

822
823
824
825
826

827
828
829
830
831

832
833
834
835
836
837
838
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
687
688
689
690
691
692
693

694
695

696


697

698

699


700

701
702
703
704
705
706
707
708

709
710
711
712
713
714

715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734

735
736
737
738
739

740
741
742
743
744

745
746
747
748
749

750
751
752
753
754
755
756
757







-
+




+
+
+
-
+
-







+
-
+












-


-
+
-
-
+
-

-
+
-
-
+
-








-
+





-
+



















-
+




-
+




-
+




-
+







			     count-stmt)))
    (map sqlite3:finalize! statements)
    (sqlite3:finalize! count-stmt)
    (db:find-and-mark-incomplete db)
    (sqlite3:execute db "VACUUM;")))

;;======================================================================
;; meta get and set vars
;; M E T A   G E T   A N D   S E T   V A R S
;;======================================================================

;; returns number if string->number is successful, string otherwise
;; also updates *global-delta*
;;
;; Operates on megatestdb
;;
(define (db:get-var db var)
(define (db:get-var dbstruct var)
  (debug:print-info 11 "db:get-var START " var)
  (let* ((start-ms (current-milliseconds))
         (throttle (let ((t  (config-lookup *configdat* "setup" "throttle")))
		     (if t (string->number t) t)))
	 (res      #f))
    (sqlite3:for-each-row
     (lambda (val)
       (set! res val))
     (db:get-db dbstruct #f)
     db "SELECT val FROM metadat WHERE var=?;" var)
     "SELECT val FROM metadat WHERE var=?;" var)
    ;; convert to number if can
    (if (string? res)
	(let ((valnum (string->number res)))
	  (if valnum (set! res valnum))))
    ;; scale by 10, average with current value.
    (set! *global-delta* (/ (+ *global-delta* (* (- (current-milliseconds) start-ms)
						 (if throttle throttle 0.01)))
			    2))
    (if (> (abs (- *last-global-delta-printed* *global-delta*)) 0.08) ;; don't print all the time, only if it changes a bit
	(begin
	  (debug:print-info 4 "launch throttle factor=" *global-delta*)
	  (set! *last-global-delta-printed* *global-delta*)))
    (debug:print-info 11 "db:get-var END " var " val=" res)
    res))

(define (db:set-var db var val)
(define (db:set-var dbstruct var val)
  (debug:print-info 11 "db:set-var START " var " " val)
  (sqlite3:execute db "INSERT OR REPLACE INTO metadat (var,val) VALUES (?,?);" var val)
  (sqlite3:execute (db:get-db dbstruct #f) "INSERT OR REPLACE INTO metadat (var,val) VALUES (?,?);" var val))
  (debug:print-info 11 "db:set-var END " var " " val))

(define (db:del-var db var)
(define (db:del-var dbstruct var)
  (debug:print-info 11 "db:del-var START " var)
  (sqlite3:execute db "DELETE FROM metadat WHERE var=?;" var)
  (sqlite3:execute (db:get-db dbstruct #f) "DELETE FROM metadat WHERE var=?;" var))
  (debug:print-info 11 "db:del-var END " var))

;; use a global for some primitive caching, it is just silly to
;; re-read the db over and over again for the keys since they never
;; change

;; why get the keys from the db? why not get from the *configdat*
;; using keys:config-get-fields?

(define (db:get-keys db)
(define (db:get-keys dbstruct)
  (if *db-keys* *db-keys* 
      (let ((res '()))
	(sqlite3:for-each-row 
	 (lambda (key)
	   (set! res (cons key res)))
	 db
	 (db:get-db dbstruct #f)
	 "SELECT fieldname FROM keys ORDER BY id DESC;")
	(set! *db-keys* res)
	res)))

;; 
(define (db:get-value-by-header row header field)
  (debug:print-info 4 "db:get-value-by-header row: " row " header: " header " field: " field)
  (if (null? header) #f
      (let loop ((hed (car header))
		 (tal (cdr header))
		 (n   0))
	(if (equal? hed field)
	    (vector-ref row n)
	    (if (null? tal) #f (loop (car tal)(cdr tal)(+ n 1)))))))

;;======================================================================
;;  R U N S
;;======================================================================

(define (db:get-run-name-from-id db run-id)
(define (db:get-run-name-from-id dbstruct run-id)
  (let ((res #f))
    (sqlite3:for-each-row
     (lambda (runname)
       (set! res runname))
     db
     (db:get-db dbstruct #f)
     "SELECT runname FROM runs WHERE id=?;"
     run-id)
    res))

(define (db:get-run-key-val db run-id key)
(define (db:get-run-key-val dbstruct run-id key)
  (let ((res #f))
    (sqlite3:for-each-row
     (lambda (val)
       (set! res val))
     db 
     (db:get-db dbstruct #f) 
     (conc "SELECT " key " FROM runs WHERE id=?;")
     run-id)
    res))

;; keys list to key1,key2,key3 ...
(define (runs:get-std-run-fields keys remfields)
  (let* ((header    (append keys remfields))
851
852
853
854
855
856
857
858

859

860

861
862
863
864
865
866
867
770
771
772
773
774
775
776

777
778
779

780
781
782
783
784
785
786
787







-
+

+
-
+







			     (if (null? patts)
				 '("")
				 patts))
			comparator)))


;; register a test run with the db
(define (db:register-run db keyvals runname state status user)
(define (db:register-run dbstruct keyvals runname state status user)
  (debug:print 3 "runs:register-run runname: " runname " state: " state " status: " status " user: " user)
  (let* ((db        (db:get-db dbstruct #f))
  (let* ((keys      (map car keyvals))
	 (keys      (map car keyvals))
	 (keystr    (keys->keystr keys))	 
	 (comma     (if (> (length keys) 0) "," ""))
	 (andstr    (if (> (length keys) 0) " AND " ""))
	 (valslots  (keys->valslots keys)) ;; ?,?,? ...
	 (allvals   (append (list runname state status user) (map cadr keyvals)))
	 (qryvals   (append (list runname) (map cadr keyvals)))
	 (key=?str  (string-intersperse (map (lambda (k)(conc k "=?")) keys) " AND ")))
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
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







-
+

-
+











-
+





-
+





-
+








-
+

-
+
+
+

+
+
+
+
+
+
-
+
+
+
+
+




-
-
+
+



-
+
+









-
+







     qrystr
     )
    (debug:print-info 11 "db:get-runs END qrystr: " qrystr " keypatts: " keypatts " offset: " offset " limit: " count)
    (vector header res)))

;; Get all targets from the db
;;
(define (db:get-targets db)
(define (db:get-targets dbstruct)
  (let* ((res       '())
	 (keys       (db:get-keys db))
	 (keys       (db:get-keys dbstruct))
	 (header     keys) ;; (map key:get-fieldname keys))
	 (keystr     (keys->keystr keys))
	 (qrystr     (conc "SELECT " keystr " FROM runs;"))
	 (seen       (make-hash-table)))
    (sqlite3:for-each-row
     (lambda (a . x)
       (let ((targ (cons a x)))
	 (if (not (hash-table-ref/default seen targ #f))
	     (begin
	       (hash-table-set! seen targ #t)
	       (set! res (cons (apply vector targ) res))))))
     db
     (db:get-db dbstruct #f)
     qrystr)
    (debug:print-info 11 "db:get-targets END qrystr: " qrystr )
    (vector header res)))

;; just get count of runs
(define (db:get-num-runs db runpatt)
(define (db:get-num-runs dbstruct runpatt)
  (let ((numruns 0))
    (debug:print-info 11 "db:get-num-runs START " runpatt)
    (sqlite3:for-each-row 
     (lambda (count)
       (set! numruns count))
     db
     (db:get-db dbstruct #f)
     "SELECT COUNT(id) FROM runs WHERE runname LIKE ? AND state != 'deleted';" runpatt)
    (debug:print-info 11 "db:get-num-runs END " runpatt)
    numruns))

;; get some basic run stats
;;
;; ( (runname (( state  count ) ... ))
;;   (   ...  
(define (db:get-run-stats db)
(define (db:get-run-stats dbstruct)
  (let ((totals       (make-hash-table))
	(res          '()))
	(res          '())
	(runs-info    '()))
    ;; First get all the runname/run-ids
    (sqlite3:for-each-row
     (lambda (run-id runname)
       (set! runs-info (cons (list runname run-id) runs-info)))
     (db:get-db dbstruct #f)
     "SELECT id,runname FROM runs;")
    ;; for each run get stats data
    (for-each
     (lambda (runname state count)
     (lambda (run-info)
       (let ((run-name (cadr run-info))
	     (run-id   (car  run-info)))
	 (sqlite3:for-each-row
	  (lambda (state count)
       (let* ((stateparts (string-split state "|"))
	      (newstate   (conc (car stateparts) "\n" (cadr stateparts))))
	 (hash-table-set! totals newstate (+ (hash-table-ref/default totals newstate 0) count))
	 (set! res (cons (list runname newstate count) res))))
     db
     "SELECT runname,t.state||'|'||t.status AS s,count(t.id) FROM runs AS r INNER JOIN tests AS t ON r.id=t.run_id GROUP BY s,runname ORDER BY r.event_time,s DESC;" )
	  (db:get-db dbstruct run-id)
	  "SELECT state||'|'||status AS s,count(id) FROM tests AS t ON ORDER BY s DESC;" )
    ;; (set! res (reverse res))
    (for-each (lambda (state)
		(set! res (cons (list "Totals" state (hash-table-ref totals state)) res)))
	      (sort (hash-table-keys totals) string>=))
		   (sort (hash-table-keys totals) string>=))))
     runs-info)
    res))

;; db:get-runs-by-patt
;; get runs by list of criteria
;; register a test run with the db
;;
;; Use: (db-get-value-by-header (db:get-header runinfo)(db:get-row runinfo))
;;  to extract info from the structure returned
;;
(define (db:get-runs-by-patt db keys runnamepatt targpatt offset limit) ;; test-name)
(define (db:get-runs-by-patt dbstruct keys runnamepatt targpatt offset limit) ;; test-name)
  (let* ((tmp      (runs:get-std-run-fields keys '("id" "runname" "state" "status" "owner" "event_time")))
	 (keystr   (car tmp))
	 (header   (cadr tmp))
	 (res     '())
	 (key-patt "")
	 (runwildtype (if (substring-index "%" runnamepatt) "like" "glob"))
	 (qry-str  #f)
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
1122
1123
1124
1125
1126
1127

1128
1129
1130
1131
1132
1133
1134
1135

1136
1137
1138
1139

1140
1141
1142
1143
1144
1145
1146
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







-
+





-
+



-
+








-
+







-
-
+
+


-
+

+
-
+
-
-
-
-
-
-
+
+
+
-

-
-
+
+

-
+




-
-
+
+


+
+
+
+
+
+
+
+
+















-
-
+
+

-







-
+

-



-
+



-
+

-



-



-
+

-





-
+



-
+







			(if limit  (conc " LIMIT " limit)   "")
			(if offset (conc " OFFSET " offset) "")
			";"))
    (debug:print-info 4 "runs:get-runs-by-patt qry=" qry-str " " runnamepatt)
    (sqlite3:for-each-row 
     (lambda (a . r)
       (set! res (cons (list->vector (cons a r)) res)))
     db 
     (db:get-db dbstruct #f)
     qry-str
     runnamepatt)
    (vector header res)))

;; use (get-value-by-header (db:get-header runinfo)(db:get-row runinfo))
(define (db:get-run-info db run-id)
(define (db:get-run-info dbstruct run-id)
  ;;(if (hash-table-ref/default *run-info-cache* run-id #f)
  ;;    (hash-table-ref *run-info-cache* run-id)
  (let* ((res       (vector #f #f #f #f))
	 (keys      (db:get-keys db))
	 (keys      (db:get-keys dbstruct))
	 (remfields (list "id" "runname" "state" "status" "owner" "event_time"))
	 (header    (append keys remfields))
	 (keystr    (conc (keys->keystr keys) ","
			  (string-intersperse remfields ","))))
    (debug:print-info 11 "db:get-run-info run-id: " run-id " header: " header " keystr: " keystr)
    (sqlite3:for-each-row
     (lambda (a . x)
       (set! res (apply vector a x)))
     db
     (db:get-db dbstruct #f)
     (conc "SELECT " keystr " FROM runs WHERE id=? AND state != 'deleted';")
     run-id)
    (debug:print-info 11 "db:get-run-info run-id: " run-id " header: " header " keystr: " keystr)
    (let ((finalres (vector header res)))
      ;; (hash-table-set! *run-info-cache* run-id finalres)
      finalres)))

(define (db:set-comment-for-run db run-id comment)
  (sqlite3:execute db "UPDATE runs SET comment=? WHERE id=?;" comment run-id))
(define (db:set-comment-for-run dbstruct run-id comment)
  (sqlite3:execute (db:get-db dbstruct #f) "UPDATE runs SET comment=? WHERE id=?;" (sdb:qry 'getid comment) run-id))

;; does not (obviously!) removed dependent data. But why not!!?
(define (db:delete-run db run-id)
(define (db:delete-run dbstruct run-id)
  ;; First set any related tests to DELETED
  (let ((db (db:get-db dbstruct run-id)))
  (let ((stmt1 (sqlite3:prepare db "UPDATE tests SET state='DELETED',comment='' WHERE run_id=?;"))
    (sqlite3:execute db "UPDATE tests SET state='DELETED',comment='';")
	(stmt2 (sqlite3:prepare db "UPDATE runs SET state='deleted',comment='' WHERE id=?;")))
    (sqlite3:with-transaction
     db (lambda ()
	  (sqlite3:execute stmt1 run-id)
	  (sqlite3:execute stmt2 run-id)))
    (sqlite3:finalize! stmt1)
    (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)))
    (sqlite3:finalize! stmt2)))

(define (db:update-run-event_time db run-id)
  (sqlite3:execute db "UPDATE runs SET event_time=strftime('%s','now') 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 db run-id lock unlock user)
(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 "UPDATE runs SET state=? WHERE id=?;" newlockval run-id)
    (sqlite3:execute db "INSERT INTO access_log (user,accessed,args) VALUES(?,strftime('%s','now'),?);"
    (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)))

(define (db:get-run-ids db)
  (let ((res '()))
    (sqlite3:for-each-row
     (lambda (id)
       (set! res (cons id res)))
     db 
     "SELECT id FROM runs;")))

;;======================================================================
;; K E Y S
;;======================================================================

;; get key val pairs for a given run-id
;; ( (FIELDNAME1 keyval1) (FIELDNAME2 keyval2) ... )
(define (db:get-key-val-pairs db run-id)
  (let* ((keys (db:get-keys db))
(define (db:get-key-val-pairs dbstruct run-id)
  (let* ((keys (db:get-keys dbstruct))
	 (res  '()))
    (debug:print-info 11 "db:get-key-val-pairs START keys: " keys " run-id: " run-id)
    (for-each 
     (lambda (key)
       (let ((qry (conc "SELECT " key " FROM runs WHERE id=?;")))
	 ;; (debug:print 0 "qry: " qry)
	 (sqlite3:for-each-row 
	  (lambda (key-val)
	    (set! res (cons (list key key-val) res)))
	  db qry run-id)))
	  (db:get-db dbstruct #f) qry run-id)))
     keys)
    (debug:print-info 11 "db:get-key-val-pairs END keys: " keys " run-id: " run-id)
    (reverse res)))

;; get key vals for a given run-id
(define (db:get-key-vals db run-id)
(define (db:get-key-vals dbstruct run-id)
  (let ((mykeyvals (hash-table-ref/default *keyvals* run-id #f)))
    (if mykeyvals 
	mykeyvals
	(let* ((keys (db:get-keys db))
	(let* ((keys (db:get-keys dbstruct))
	       (res  '()))
	  (debug:print-info 11 "db:get-key-vals START keys: " keys " run-id: " run-id)
	  (for-each 
	   (lambda (key)
	     (let ((qry (conc "SELECT " key " FROM runs WHERE id=?;")))
	       ;; (debug:print 0 "qry: " qry)
	       (sqlite3:for-each-row 
		(lambda (key-val)
		  (set! res (cons key-val res)))
		db qry run-id)))
		(db:get-db dbstruct #f) qry run-id)))
	   keys)
	  (debug:print-info 11 "db:get-key-vals END keys: " keys " run-id: " run-id)
	  (let ((final-res (reverse res)))
	    (hash-table-set! *keyvals* run-id final-res)
	    final-res)))))

;; The target is keyval1/keyval2..., cached in *target* as it is used often
(define (db:get-target db run-id)
(define (db:get-target dbstruct run-id)
  (let ((mytarg (hash-table-ref/default *target* run-id #f)))
    (if mytarg
	mytarg
	(let* ((keyvals (db:get-key-vals db run-id))
	(let* ((keyvals (db:get-key-vals dbstruct run-id))
	       (thekey  (string-intersperse (map (lambda (x)(if x x "-na-")) keyvals) "/")))
	  (hash-table-set! *target* run-id thekey)
	  thekey))))

;;======================================================================
;;  T E S T S
;;======================================================================
1199
1200
1201
1202
1203
1204
1205
1206

1207
1208
1209
1210
1211
1212
1213
1133
1134
1135
1136
1137
1138
1139

1140
1141
1142
1143
1144
1145
1146
1147







-
+







				(if offset (conc " OFFSET " offset) " ")
				";"
				)))
    (debug:print-info 8 "db:get-tests-for-run qry=" qry)
    (sqlite3:for-each-row 
     (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 
     (db:get-db dbstruct run-id)
     qry
     run-id
     )
    (case qryvals
      ((shortlist)(map db:test-short-record->norm res))
      ((#f)       res)
      (else       res))))
1252
1253
1254
1255
1256
1257
1258
1259

1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309

1310
1311
1312
1313
1314
1315





1316
1317
1318



1319
1320
1321
1322







1323
1324
1325
1326
1327
1328

1329
1330
1331
1332
1333
1334
1335

1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351












1352
1353
1354
1355
1356
1357


1358

1359
1360
1361
1362
1363

1364
1365
1366



1367

1368
1369
1370
1371
1372
1373


1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385

1386
1387
1388
1389
1390
1391
1392

1393
1394
1395
1396
1397
1398
1399
1400

1401
1402
1403
1404
1405
1406


1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421

1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433



1434
1435
1436

1437


1438

1439
1440
1441
1442
1443
1444
1445
1446


1447
1448
1449
1450
1451
1452
1453
1454

1455
1456
1457
1458
1459
1460
1461

1462
1463

1464
1465
1466
1467
1468
1469


1470
1471
1472
1473
1474
1475







1476
1477
1478
1479

1480
1481

1482
1483
1484


1485
1486

1487
1488
1489









1490
1491
1492


1493
1494
1495
1496
1497
1498
1499

1500
1501
1502
1503

1504
1505
1506
1507
1508
1509
1510
1511
1512
1513



1514
1515
1516
1517
1518
1519
1520
1186
1187
1188
1189
1190
1191
1192

1193

1194
















































1195






1196
1197
1198
1199
1200
1201


1202
1203
1204
1205



1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217

1218
1219
1220
1221
1222
1223
1224

1225
1226
1227
1228
1229
1230











1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250

1251
1252
1253
1254
1255

1256
1257
1258
1259
1260
1261
1262

1263
1264
1265
1266
1267


1268
1269
1270
1271










1272
1273
1274
1275
1276
1277
1278

1279
1280
1281
1282
1283
1284
1285
1286

1287
1288
1289
1290
1291


1292
1293
1294
1295
1296












1297





1298
1299
1300
1301



1302
1303
1304
1305
1306

1307
1308
1309
1310

1311
1312
1313
1314
1315
1316
1317


1318
1319
1320
1321
1322
1323




1324




1325
1326

1327
1328

1329






1330
1331






1332
1333
1334
1335
1336
1337
1338

1339
1340

1341
1342

1343
1344


1345
1346
1347

1348
1349


1350
1351
1352
1353
1354
1355
1356
1357
1358
1359


1360
1361



1362
1363
1364

1365
1366
1367


1368
1369
1370
1371
1372
1373
1374
1375
1376
1377

1378
1379
1380
1381
1382
1383
1384
1385
1386
1387







-
+
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
+
+
+
+
+

-
-
+
+
+

-
-
-
+
+
+
+
+
+
+





-
+






-
+





-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+






+
+
-
+




-
+



+
+
+
-
+




-
-
+
+


-
-
-
-
-
-
-
-
-
-
+






-
+







-
+




-
-
+
+



-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-




-
-
-
+
+
+


-
+

+
+
-
+






-
-
+
+




-
-
-
-
+
-
-
-
-


-
+

-
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
-


-
+

-
+

-
-
+
+

-
+

-
-
+
+
+
+
+
+
+
+
+

-
-
+
+
-
-
-



-
+


-
-
+









-
+
+
+







    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"))


;; Convert calling routines to get list of run-ids and loop, do not use the get-tests-for-runs
;; 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
  (let* ((res '())
	 ;; if states or statuses are null then assume match all when not-in is false
	 (states-qry      (if (null? states) 
			      #f
			      (conc " state "  
				    (if not-in "NOT" "") 
				    " IN ('" 
				    (string-intersperse states   "','")
				    "')")))
	 (statuses-qry    (if (null? statuses)
			      #f
			      (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;")
				  (else         ";"))
				)))
    (debug:print-info 8 "db:get-tests-for-runs qry=" qry)
    (sqlite3:for-each-row 
     (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 
     qry
     )

    res))

(define (db:delete-test-records db test-id)
  (db:general-call db 'delete-test-step-records (list test-id))
  (db:general-call db 'delete-test-data-records (list test-id))
  (sqlite3:execute db "UPDATE tests SET state='DELETED',status='n/a',comment='' WHERE id=?;" test-id))
(define (db:delete-test-records dbstruct run-id test-id)
  (let ((db (db:get-db dbstruct run-id)))
    (db:general-call db 'delete-test-step-records (list test-id))
    (db:general-call db 'delete-test-data-records (list 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)
  (sqlite3:execute db "DELETE FROM tests WHERE run_id=?;" run-id))
(define (db:delete-tests-for-run dbdbstruct run-id)
  (let ((db (db:get-db dbstruct run-id)))
     (sqlite3:execute db "DELETE FROM tests WHERE run_id=?;" run-id)))

(define (db:delete-old-deleted-test-records db)
  (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)))
(define (db:delete-old-deleted-test-records dbstruct)
  (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 != ''));")))
		;;(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))

;; 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 (sdb:qry 'getid 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=?;" (sdb:qry 'getid newcomment) test-id))))
    (mt:process-triggers test-id newstate newstatus)))

;; Never used, but should be?
(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 dbstruct run-id)
(define (db:get-count-tests-running-for-run-id db run-id)
(define (db:get-count-tests-running-for-run-id dbstruct run-id)
  (let ((res 0))
    (sqlite3:for-each-row
     (lambda (count)
       (set! res count))
     db
     "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND id=?;" run-id)
     (db:get-db dbstruct run-id)
     "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND run_id=?;" run-id)
    res))

(define (db:get-running-stats db)
  (let ((res '()))
    (sqlite3:for-each-row
     (lambda (state count)
       (set! res (cons (list state count) res)))
     db
     "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 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")

;; NOTE: Use db:test-get* to access records
;; NOTE: This needs rundir_id decoding? Decide, decode here or where used? For the moment decode where used.
(define (db:get-all-tests-info-by-run-id db run-id)
(define (db:get-all-tests-info-by-run-id dbstruct run-id)
  (let ((res '()))
    (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)
       ;;                 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 
     "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment FROM tests WHERE run_id=?;"
     (db:get-db dbstruct run-id)
     (conc "SELECT " db:test-record-qry-selector " FROM tests WHERE run_id=?;")
     run-id)
    res))

;; Get test data using test_id
;; 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-by-id dbstruct run-id test-id)
  (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 pass_count fail_count)
     (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 item-path run_duration final_logf comment pass_count fail_count)))
       (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 
	 "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment,pass_count,fail_count FROM tests WHERE id=?;"
	 test-id)
	res)))

;; Use db:test-get* to access
     (db:get-db dbstruct run-id)
     (conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id=?;")
;;
;; Get test data using test_ids
(define (db:get-test-info-by-ids db test-ids)
  (if (null? test-ids)
      (begin
	(debug:print-info 4 "db:get-test-info-by-ids called with test-ids=" test-ids)
	 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)
	'())
      (let ((res '()))
	(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 pass_count fail_count)
     (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 (cons (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment pass_count fail_count)
       (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)
			   res)))
	 db 
	 (conc "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment,pass_count,fail_count FROM tests WHERE id in ("
     (db:get-db dbstruct run-id) 
     (conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id in ("
	       (string-intersperse (map conc test-ids) ",") ");"))
	res)))
    res))

(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:get-test-info dbstruct run-id testname item-path)
  (let ((res #f))
    (sqlite3:for-each-row
     (lambda (a . b)
       (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))

(define (db:test-get-rundir-from-test-id db test-id)
  (let ((res #f)) ;; (hash-table-ref/default *test-paths* test-id #f)))
(define (db:test-get-rundir-from-test-id dbstruct run-id test-id)
  (let ((res #f))
    ;; (if res
    ;;     res
    ;;     (begin
    (sqlite3:for-each-row
     (lambda (tpath)
       (set! res tpath))
     db 
     (db:get-db dbstruct run-id)
     "SELECT rundir FROM tests WHERE id=?;"
     test-id)
    ;; (hash-table-set! *test-paths* test-id res)
    res)) ;; ))
    res))

;;======================================================================
;; S T E P S
;;======================================================================

(define (db:teststep-set-status! db test-id teststep-name state-in status-in comment logfile)
   (sqlite3:execute 
    db
    "INSERT OR REPLACE into test_steps (test_id,stepname,state,status,event_time,comment,logfile) VALUES(?,?,?,?,?,?,?);"
    test-id teststep-name state-in status-in (current-seconds) (if comment comment "") (if logfile logfile "")))
    test-id teststep-name state-in status-in (current-seconds)
    (sdb:qry 'getid  (if comment comment ""))
    (sdb:qry 'getid  (if logfile logfile ""))))
   
;; db-get-test-steps-for-run
(define (db:get-steps-for-test db test-id)
  (let* ((res '()))
    (sqlite3:for-each-row 
     (lambda (id test-id stepname state status event-time logfile)
       (set! res (cons (vector id test-id stepname state status event-time (if (string? logfile) logfile "")) res)))
1616
1617
1618
1619
1620
1621
1622

1623

1624
1625
1626
1627
1628
1629
1630
1483
1484
1485
1486
1487
1488
1489
1490

1491
1492
1493
1494
1495
1496
1497
1498







+
-
+







     csvlist)))

;;======================================================================
;; Misc. test related queries
;;======================================================================

;; MUST BE CALLED local!
;;
(define (db:test-get-paths-matching db keynames target fnamepatt #!key (res '()))
(define (db:test-get-paths-matching dbstruct keynames target fnamepatt #!key (res '()))
  ;; BUG: Move the values derived from args to parameters and push to megatest.scm
  (let* ((testpatt   (if (args:get-arg "-testpatt")(args:get-arg "-testpatt") "%"))
	 (statepatt  (if (args:get-arg ":state")   (args:get-arg ":state")    "%"))
	 (statuspatt (if (args:get-arg ":status")  (args:get-arg ":status")   "%"))
	 (runname    (if (args:get-arg ":runname") (args:get-arg ":runname")  "%"))
	 (paths-from-db (rmt:test-get-paths-matching-keynames-target-new keynames target res
					testpatt
1660
1661
1662
1663
1664
1665
1666
1667

1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680

1681
1682

1683
1684

1685
1686
1687
1688
1689
1690
1691
1692
1693

1694

1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1528
1529
1530
1531
1532
1533
1534

1535




1536
1537
1538
1539
1540
1541
1542
1543

1544


1545


1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556

1557
1558

1559
1560




















1561
1562
1563
1564
1565
1566
1567







-
+
-
-
-
-








-
+
-
-
+
-
-
+









+
-
+

-


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    (sqlite3:for-each-row 
     (lambda (p)
       (set! res (cons p res)))
     db 
     qrystr)
    res))

(define (db:test-get-paths-matching-keynames-target-new db keynames target res 
(define (db:test-get-paths-matching-keynames-target-new dbstruct keynames target res testpatt statepatt statuspatt runname)
							testpatt  
							statepatt 
							statuspatt
							runname)
  (let* ((row-ids '())
	 (keystr (string-intersperse 
		  (map (lambda (key val)
			 (conc key " like '" val "'"))
		       keynames 
		       (string-split target "/"))
		  " AND "))
	 (testqry (tests:match->sqlqry testpatt))
	 (rqry    (conc "SELECT id FROM runs WHERE " keystr " AND runname LIKE '" runname "';"))
	 (runsqry (sqlite3:prepare (db:get-db dbstruct #f)(conc "SELECT id FROM runs WHERE " keystr " AND runname LIKE '" runname "';")))
	 (runsqry (sqlite3:prepare db rqry))
	 (tqry    (conc "SELECT rundir FROM tests WHERE run_id=? AND " testqry " AND state LIKE '" statepatt "' AND status LIKE '" statuspatt "' ORDER BY event_time ASC;"))
	 (tstsqry (conc "SELECT rundir_id FROM tests WHERE " testqry " AND state LIKE '" statepatt "' AND status LIKE '" statuspatt "' ORDER BY event_time ASC;")))
	 (tstsqry (sqlite3:prepare db tqry)))
    (debug:print 8 "db:test-get-paths-matching-keynames-target-new\n  rqry=" rqry "\n  tqry=" tqry)
    (debug:print 8 "db:test-get-paths-matching-keynames-target-new\n  runsqry=" runsqry "\n  tstqry=" tstqry)
    (sqlite3:for-each-row
     (lambda (rid)
       (set! row-ids (cons rid row-ids)))
     runsqry)
    (sqlite3:finalize! runsqry)
    (for-each (lambda (rid)
		(sqlite3:for-each-row 
		 (lambda (p)
		   (set! res (cons p res)))
		 (db:get-db dbstruct rid)
		 tstsqry rid))
		 tstsqry))
	      row-ids)
    (sqlite3:finalize! tstsqry)
    res))

;; look through tests from matching runs for a file
(define (db:test-get-first-path-matching db keynames target fname)
  ;; [refpaths] is the section where references to other megatest databases are stored
  (let ((mt-paths (configf:get-section "refpaths"))
	(res       (db:test-get-paths-matching db keynames target fname)))
    (let loop ((pathdat (if (null? paths) #f (car mt-paths)))
	       (tal     (if (null? paths) '()(cdr mt-paths))))
      (if (not (null? res))
	  (car res) ;; return first found
	  (if path
	      (let* ((db     (open-db path: (cadr pathdat)))
		     (newres (db:test-get-paths-matching db keynames target fname)))
		(debug:print-info 4 "Trying " (car pathdat) " at " (cadr pathdat))
		(sqlite3:finalize! db)
		(if (not (null? newres))
		    (car newres)
		    (if (null? tal)
			#f
			(loop (car tal)(cdr tal))))))))))

;;======================================================================
;; QUEUE UP META, TEST STATUS AND STEPS REMOTE ACCESS
;;======================================================================

;; NOTE: Can remove the regex and base64 encoding for zmq
(define (db:obj->string obj)
  (case *transport-type*
1742
1743
1744
1745
1746
1747
1748
1749


1750
1751
1752
1753
1754

1755
1756
1757
1758
1759

1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773



1774

1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785











1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801


1802
1803
1804


1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818





1819
1820
1821


1822
1823
1824
1825
1826
1827
1828
1829




1830
1831
1832
1833

1834
1835
1836
1837
1838
1839
1840
1841

1842
1843
1844
1845

1846
1847
1848
1849
1850




1851
1852
1853
1854
1855
1856
1857
1584
1585
1586
1587
1588
1589
1590

1591
1592
1593
1594
1595
1596

1597
1598
1599
1600
1601

1602







1603
1604
1605
1606
1607
1608
1609
1610
1611
1612

1613
1614
1615









1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640


1641
1642
1643


1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654





1655
1656
1657
1658
1659
1660


1661
1662
1663
1664
1665
1666




1667
1668
1669
1670
1671
1672
1673

1674
1675
1676
1677
1678
1679
1680
1681

1682
1683
1684
1685

1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702







-
+
+




-
+




-
+
-
-
-
-
-
-
-







+
+
+
-
+


-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+














-
-
+
+

-
-
+
+









-
-
-
-
-
+
+
+
+
+

-
-
+
+




-
-
-
-
+
+
+
+



-
+







-
+



-
+





+
+
+
+







	      (string-substitute 
	       (regexp "_") "=" msg #t))
	   (lambda ()(deserialize)))
	 (vector #f #f #f))) ;; crude reply for when things go awry
    ((zmq)(with-input-from-string msg (lambda ()(deserialize))))
    (else msg)))

(define (db:test-set-status-state db test-id status state msg)
(define (db:test-set-status-state dbstruct run-id test-id status state msg)
  (let ((db  (db:get-db dbstruct rid)))
  (if (member state '("LAUNCHED" "REMOTEHOSTSTART"))
      (db:general-call db 'set-test-start-time (list test-id)))
  (if msg
      (db:general-call db 'state-status-msg (list state status msg test-id))
      (db:general-call db 'state-status     (list state status test-id))))
	(db:general-call db 'state-status     (list state status test-id)))))

(define (db:roll-up-pass-fail-counts db run-id test-name item-path status)
  (if (and (not (equal? item-path ""))
	   (member status '("PASS" "WARN" "FAIL" "WAIVED" "RUNNING" "CHECK" "SKIP")))
      (handle-exceptions
      (let ((db (db:get-db dbstruct rid)))
       exn
       (begin 
	 (debug:print 0 "Problem with call to cdb:remote-run, database may be locked and read-only, waiting and trying again ...")
	 (thread-sleep! 10)
	 (apply cdb:remote-run proc db params))
       (apply cdb:client-call *runremote* 'immediate #f *default-numtries* open-run-close proc #f params))
      (begin
	(db:general-call db 'update-pass-fail-counts (list run-id test-name run-id test-name run-id test-name))
	(if (equal? status "RUNNING")
	    (db:general-call db 'top-test-set-running (list run-id test-name))
	    (db:general-call db 'top-test-set-per-pf-counts (list run-id test-name run-id test-name run-id test-name)))
	#f)
      #f))

(define (db:tests-register-test dbstruct run-id test-name item-path)
  (sqlite3:execute (db:get-db dbstruct run-id) 'register-test run-id test-name item-path))

(define (db:test-get-logfile-info db run-id test-name)
(define (db:test-get-logfile-info dbstruct run-id test-name)
  (let ((res #f))
    (sqlite3:for-each-row 
     (lambda (path final_logf)
       (set! logf final_logf)
       (set! res (list path final_logf))
       (if (directory? path)
	   (debug:print 2 "Found path: " path)
	   (debug:print 2 "No such path: " path)))
     db
     "SELECT rundir,final_logf FROM tests WHERE run_id=? AND testname=? AND item_path='';"
     run-id test-name)
     (lambda (path-id final_logf-id)
       (let ((path       (sdb:qry 'getstr path-id))
	     (final_logf (sdb:qry 'getstr final_logf-id)))
	 (set! logf final_logf)
	 (set! res (list path final_logf))
	 (if (directory? path)
	     (debug:print 2 "Found path: " path)
	     (debug:print 2 "No such path: " path))))
     (db:get-db dbstruct run-id)
     "SELECT rundir_id,final_logf_id FROM tests WHERE testname=? AND item_path='';"
     test-name)
    res))

;;======================================================================
;; A G R E G A T E D   T R A N S A C T I O N   D B   W R I T E S 
;;======================================================================

(define db:queries 
  (list '(update-run-duration     "UPDATE tests SET run_duration=? WHERE id=?;")

	;; TESTS
	'(register-test          "INSERT OR IGNORE INTO tests (run_id,testname,event_time,item_path,state,status) VALUES (?,?,strftime('%s','now'),?,'NOT_STARTED','n/a');")
	;; Test state and status
	'(set-test-state         "UPDATE tests SET state=?   WHERE id=?;")
	'(set-test-status        "UPDATE tests SET state=?   WHERE id=?;")
	'(state-status           "UPDATE tests SET state=?,status=? WHERE id=?;")
	'(state-status-msg       "UPDATE tests SET state=?,status=?,comment=? WHERE id=?;")
	'(state-status           "UPDATE tests SET state=?,status=? WHERE id=?;") ;; DONE
	'(state-status-msg       "UPDATE tests SET state=?,status=?,comment_id=? WHERE id=?;") ;; DONE
	;; Test comment
	'(set-test-comment       "UPDATE tests SET comment=? WHERE id=?;")
	'(set-test-start-time    "UPDATE tests SET event_time=strftime('%s','now') WHERE id=?;")
	'(set-test-comment       "UPDATE tests SET comment_id=? WHERE id=?;")
	'(set-test-start-time    "UPDATE tests SET event_time=strftime('%s','now') WHERE id=?;") ;; DONE
	'(pass-fail-counts       "UPDATE tests SET pass_count=?,fail_count=? WHERE id=?;")
	;; test_data-pf-rollup is used to set a tests PASS/FAIL based on the pass/fail info from the steps
	'(test_data-pf-rollup    "UPDATE tests
                                    SET status=CASE WHEN (SELECT fail_count FROM tests WHERE id=?) > 0 
                                      THEN 'FAIL'
                                    WHEN (SELECT pass_count FROM tests WHERE id=?) > 0 AND 
                                      (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=?;")
                                    END WHERE id=?;") ;; DONE
	'(test-set-log            "UPDATE tests SET final_logf_id=? WHERE id=?;")      ;; DONE
	'(test-set-rundir-by-test-id "UPDATE tests SET rundir_id=? WHERE id=?")        ;; DONE
	'(test-set-rundir         "UPDATE tests SET rundir_id=? AND testname=? AND item_path=?;") ;; DONE
	'(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-uname-host       "UPDATE tests SET uname=?,host=? WHERE id=?;")
	'(update-cpuload-diskfree "UPDATE tests SET cpuload=?,diskfree=? 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-pass-fail-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='';")
	'(top-test-set-running  "UPDATE tests SET state='RUNNING' WHERE run_id=? AND testname=? AND item_path='';")
             SET fail_count=(SELECT count(id) FROM tests WHERE testname=? AND item_path != '' AND status IN ('FAIL','CHECK')),
                 pass_count=(SELECT count(id) FROM tests WHERE testname=? AND item_path != '' AND status IN ('PASS','WARN','WAIVED'))
             WHERE testname=? AND item_path='';") ;; DONE
	'(top-test-set-running  "UPDATE tests SET state='RUNNING' WHERE testname=? AND item_path='';") ;; DONE
	'(top-test-set-per-pf-counts "UPDATE tests
                       SET state=CASE 
                                   WHEN (SELECT count(id) FROM tests 
                                                WHERE run_id=? AND testname=?
                                                WHERE testname=?
                                                     AND item_path != '' 
                                                     AND state in ('RUNNING','NOT_STARTED','LAUNCHED','REMOTEHOSTSTART')) > 0 THEN 'RUNNING'
                                   ELSE 'COMPLETED' END,
                            status=CASE 
                                  WHEN fail_count > 0 THEN 'FAIL' 
                                  WHEN pass_count > 0 AND fail_count=0 THEN 'PASS' 
                                  WHEN (SELECT count(id) FROM tests
                                         WHERE run_id=? AND testname=?
                                         WHERE testname=?
                                              AND item_path != ''
                                              AND status = 'SKIP') > 0 THEN 'SKIP'
                                  ELSE 'UNKNOWN' END
                       WHERE run_id=? AND testname=? AND item_path='';")
                       WHERE testname=? AND item_path='';") ;; DONE

	;; STEPS
	'(delete-test-step-records "UPDATE test_steps SET status='DELETED' WHERE id=?;")
	'(delete-test-data-records "UPDATE test_data  SET status='DELETED' WHERE id=?;") ;; using status since no state field
	))

(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
1871
1872
1873
1874
1875
1876
1877
1878

1879
1880
1881
1882
1883
1884
1885







1886
1887
1888
1889
1890
1891
1892
1716
1717
1718
1719
1720
1721
1722

1723







1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737







-
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+







(define (db:process-write db request-item)
  (let ((stmt-key (vector-ref request-item 0))
	(query    (vector-ref request-item 1))
	(params   (vector-ref request-item 2))
	(queryh   (sqlite3:prepare db query)))
    (apply sqlite3:execute stmt params)
    #f))

;; DISABLING FOR NOW 
(define *db:process-queue-mutex* (make-mutex))

(define *number-of-writes*         0)
(define *writes-total-delay*       0)
(define *total-non-write-delay*    0)
(define *number-non-write-queries* 0)

;; DISABLING FOR NOW (define *number-of-writes*         0)
;; DISABLING FOR NOW (define *writes-total-delay*       0)
;; DISABLING FOR NOW (define *total-non-write-delay*    0)
;; DISABLING FOR NOW (define *number-non-write-queries* 0)
;; DISABLING FOR NOW 
;; DISABLING FOR NOW ;; The queue is a list of vectors where the zeroth slot indicates the type of query to
;; DISABLING FOR NOW ;; apply and the second slot is the time of the query and the third entry is a list of 
(define (db:general-call db stmtname params)
  (let ((query (let ((q (alist-ref (if (string? stmtname)
				       (string->symbol stmtname)
				       stmtname)
				   db:queries)))
		 (if q (car q) #f))))
    (apply sqlite3:execute db query params)
1977
1978
1979
1980
1981
1982
1983
1984

1985
1986
1987



1988
1989
1990
1991
1992




1993
1994
1995
1996
1997
1998
1999

2000
2001
2002
2003

2004

2005
2006
2007
2008
2009
2010


2011
2012
2013
2014


2015
2016
2017
2018
2019
2020
2021

2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038

2039
2040
2041
2042
2043
2044
2045
1822
1823
1824
1825
1826
1827
1828

1829
1830
1831

1832
1833
1834
1835




1836
1837
1838
1839
1840
1841
1842
1843
1844
1845

1846
1847
1848
1849
1850
1851

1852
1853
1854
1855
1856


1857
1858
1859
1860


1861
1862
1863
1864
1865
1866
1867
1868

1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885

1886
1887
1888
1889
1890
1891
1892
1893







-
+


-
+
+
+

-
-
-
-
+
+
+
+






-
+




+
-
+




-
-
+
+


-
-
+
+






-
+
















-
+







			   ;; this test is younger, store it in the hash
			   (hash-table-set! tests-hash full-testname testdat))))
		   results)
		  (if (null? tal)
		      (map cdr (hash-table->alist tests-hash)) ;; return a list of the most recent tests
		      (loop (car tal)(cdr tal))))))))))

(define (db:test-get-records-for-index-file db run-id test-name)
(define (db:test-get-records-for-index-file dbstruct run-id test-name)
  (let ((res '()))
    (sqlite3:for-each-row 
     (lambda (id itempath state status run_duration logf comment)
     (lambda (id itempath state status run_duration logf-id comment-id)
       (let ((logf    (db:get-string dbstruct logf-id))
	     (comment (db:get-string dbstruct comment-id)))
       (set! res (cons (vector id itempath state status run_duration logf comment) res)))
     db
     "SELECT id,item_path,state,status,run_duration,final_logf,comment FROM tests WHERE run_id=? AND testname=? AND item_path != '';"
     run-id test-name)
    res))
     (db:get-db dbstruct run-id)
     "SELECT id,item_path,state,status,run_duration,final_logf_id,comment_id FROM tests WHERE testname=? AND item_path != '';"
     test-name)
    res)))

;;======================================================================
;; Tests meta data
;;======================================================================

;; read the record given a testname
(define (db:testmeta-get-record db testname)
(define (db:testmeta-get-record dbstruct testname)
  (let ((res #f))
    (sqlite3:for-each-row
     (lambda (id testname author owner description reviewed iterated avg_runtime avg_disk tags)
       (set! res (vector id testname author owner description reviewed iterated avg_runtime avg_disk tags)))
     (db:get-db dbstruct #f)
     db "SELECT id,testname,author,owner,description,reviewed,iterated,avg_runtime,avg_disk,tags FROM test_meta WHERE testname=?;"
     "SELECT id,testname,author,owner,description,reviewed,iterated,avg_runtime,avg_disk,tags FROM test_meta WHERE testname=?;"
     testname)
    res))

;; create a new record for a given testname
(define (db:testmeta-add-record db testname)
  (sqlite3:execute db "INSERT OR IGNORE INTO test_meta (testname,author,owner,description,reviewed,iterated,avg_runtime,avg_disk,tags) VALUES (?,'','','','','','','','');" testname))
(define (db:testmeta-add-record dbstruct testname)
  (sqlite3:execute (db:get-db dbstruct #f) "INSERT OR IGNORE INTO test_meta (testname,author,owner,description,reviewed,iterated,avg_runtime,avg_disk,tags) VALUES (?,'','','','','','','','');" testname))

;; update one of the testmeta fields
(define (db:testmeta-update-field db testname field value)
  (sqlite3:execute db (conc "UPDATE test_meta SET " field "=? WHERE testname=?;") value testname))
(define (db:testmeta-update-field dbstruct testname field value)
  (sqlite3:execute (db:get-db dbstruct #f) (conc "UPDATE test_meta SET " field "=? WHERE testname=?;") value testname))

(define (db:testmeta-get-all db)
  (let ((res '()))
    (sqlite3:for-each-row
     (lambda (a . b)
       (set! res (cons (apply vector a b) res)))
     db
     (db:get-db dbstruct run-id)
     "SELECT id,testname,author,owner,description,reviewed,iterated,avg_runtime,avg_disk,tags,jobgroup FROM test_meta;")
    res))

;;======================================================================
;; M I S C   M A N A G E M E N T   I T E M S 
;;======================================================================

;; the new prereqs calculation, looks also at itempath if specified
;; all prereqs must be met:
;;    if prereq test with itempath='' is COMPLETED and PASS, WARN, CHECK, or WAIVED then prereq is met
;;    if prereq test with itempath=ref-item-path and COMPLETED with PASS, WARN, CHECK, or WAIVED then prereq is met
;;
;; Note: mode 'normal means that tests must be COMPLETED and ok (i.e. PASS, WARN, CHECK, SKIP or WAIVED)
;;       mode 'toplevel means that tests must be COMPLETED only
;;       mode 'itemmatch or 'itemwait means that tests items must be COMPLETED and (PASS|WARN|WAIVED|CHECK) [[ NB// NOT IMPLEMENTED YET ]]
;; 
(define (db:get-prereqs-not-met db run-id waitons ref-item-path mode)
(define (db:get-prereqs-not-met dbstruct run-id waitons ref-item-path mode)
  (if (or (not waitons)
	  (null? waitons))
      '()
      (let* ((unmet-pre-reqs '())
	     (result         '()))
	(for-each 
	 (lambda (waitontest-name)
2099
2100
2101
2102
2103
2104
2105


2106
2107
2108
2109

2110
2111
2112
2113
2114
2115
2116
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958

1959
1960
1961
1962
1963
1964
1965
1966







+
+



-
+







		 (set! result (append (if (null? tests)(list waitontest-name) tests) result)))))
	 waitons)
	(delete-duplicates result))))

;;======================================================================
;; Extract ods file from the db
;;======================================================================

;; NOT REWRITTEN YET!!!!!

;; runspatt is a comma delimited list of run patterns
;; keypatt-alist must contain *all* keys with an associated pattern: '( ("KEY1" "%") .. )
(define (db:extract-ods-file db outputfile keypatt-alist runspatt pathmod)
(define (db:extract-ods-file dbstruct outputfile keypatt-alist runspatt pathmod)
  (let* ((keysstr  (string-intersperse (map car keypatt-alist) ","))
	 (keyqry   (string-intersperse (map (lambda (p)(conc (car p) " LIKE ? ")) keypatt-alist) " AND "))
	 (numkeys  (length keypatt-alist))
	 (test-ids '())
	 (windows  (and pathmod (substring-index "\\" pathmod)))
	 (tempdir  (conc "/tmp/" (current-user-name) "/" runspatt "_" (random 10000) "_" (current-process-id)))
	 (runsheader (append (list "Run Id" "Runname") ; 0 1