Overview
Context
Changes
Modified api.scm
from [408545c812]
to [a5a1f9f0f0].
︙ | | |
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
|
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
|
-
+
|
((login) (apply db:login dbstruct params))
((general-call) (let ((stmtname (car params))
(run-id (cadr params))
(realparams (cddr params)))
(db:with-db dbstruct run-id #t ;; these are all for modifying the db
(lambda (db)
(db:general-call db stmtname realparams)))))
((sync-inmem->db) (db:sync-touched dbstruct))
((sync-inmem->db) (db:sync-touched dbstruct force-sync: #t))
((kill-server)
(db:sync-tables (db:tbls *inmemdb*) *inmemdb* *db*) ;; (db:sync-to *inmemdb* *db*)
(let ((hostname (car *runremote*))
(port (cadr *runremote*))
(pid (if (null? params) #f (car params)))
(th1 (make-thread (lambda ()(thread-sleep! 3)(debug:print 0 "Server exiting!")(exit 0)) "Server exit thread")))
(debug:print 0 "WARNING: Server on " hostname ":" port " going down by user request!")
|
︙ | | |
Modified db.scm
from [2cba8158d4]
to [aabc9033ad].
︙ | | |
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
|
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
|
+
+
-
+
|
db))))
;; mod-read:
;; 'mod modified data
;; 'read read data
;;
(define (db:done-with dbstruct run-id mod-read)
(if (not (sqlite3:database? dbstruct))
(begin
(mutex-lock! *rundb-mutex*)
(if (eq? mod-read 'mod)
(dbr:dbstruct-set-runvec-val! dbstruct run-id 'mtime (current-milliseconds))
(dbr:dbstruct-set-runvec-val! dbstruct run-id 'rtime (current-milliseconds)))
(dbr:dbstruct-set-runvec-val! dbstruct run-id 'inuse #f)
(mutex-unlock! *rundb-mutex*))
(mutex-unlock! *rundb-mutex*))))
;; (db:with-db dbstruct run-id sqlite3:exec "select blah from blaz;")
;; r/w is a flag to indicate if the db is modified by this query #t = yes, #f = no
;;
(define (db:with-db dbstruct run-id r/w proc . params)
(let* ((db (db:get-db dbstruct run-id)))
(let ((res (apply proc db params)))
|
︙ | | |
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
|
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
234
|
-
+
-
-
+
+
-
-
+
+
+
+
|
(if (not dbexists)
(begin
(db:initialize-main-db db)
(db:initialize-run-id-db db)))
db))
;; sync all touched runs to disk
(define (db:sync-touched dbstruct)
(define (db:sync-touched dbstruct #!key (force-sync #f))
(let ((tot-synced 0))
(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)
(let ((num-sunced (db:sync-tables db:sync-tests-only inmem rundb)))
(if (or (> mtime stime) force-sync)
(let ((num-synced (db:sync-tables db:sync-tests-only inmem rundb)))
(set! tot-synced (+ tot-synced num-synced))
(vector-set! runvec (dbr:dbstruct-field-name->run 'stime (current-milliseconds)))))))
(hash-table-values (vector-ref dbstruct 1)))))
(vector-set! runvec (dbr:dbstruct-field-name->num 'stime) (current-milliseconds))))))
(hash-table-values (vector-ref dbstruct 1)))
tot-synced))
;; close all opened run-id dbs
(define (db:close-all dbstruct)
;; finalize main.db
(db:sync-touched dbstruct force-sync: #t)
(sqlite3:finalize! (db:get-db dbstruct #f))
(for-each
(lambda (runvec)
(let ((rundb (vector-ref runvec (dbr:dbstruct-field-name->num 'rundb))))
(if (sqlite3:database? rundb)
(sqlite3:finalize! rundb)
(debug:print 0 "WARNING: attempting to close databases but got " rundb " instead of a database"))))
|
︙ | | |
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
|
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
|
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
|
'("units" #f)
'("comment" #f)
'("status" #f)
'("type" #f))))
;; needs db to get keys, this is for syncing all tables
;;
(define (db:tbls db)
(define (db:sync-main-list db)
(let ((keys (db:get-keys db)))
(list
(list "keys"
'("id" #f)
'("fieldname" #f)
'("fieldtype" #f))
(list "metadat" '("var" #f) '("val" #f))
(append (list "runs"
'("id" #f))
(map (lambda (k)(list k #f))
(append keys
(list "runname" "state" "status" "owner" "event_time" "comment" "fail_count" "pass_count"))))
(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)
'("comment" #f)
'("logfile" #f))
(list "test_meta"
'("id" #f)
'("testname" #f)
'("owner" #f)
'("description" #f)
'("reviewed" #f)
'("iterated" #f)
|
︙ | | |
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
|
399
400
401
402
403
404
405
406
407
408
409
410
411
412
|
-
-
-
|
(count (cdr dat)))
(set! tot-count (+ tot-count count))
(if (> count 0)
(debug:print 0 (format #f " ~10a ~5a" tblname count)))))
(sort (hash-table->alist numrecs)(lambda (a b)(> (cdr a)(cdr b))))))
tot-count))
(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*
(not (member proc *db:all-write-procs*)))
(let* ((db (cond
((sqlite3:database? idb) idb)
|
︙ | | |
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
|
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
|
+
+
-
-
+
+
-
+
-
+
|
res)))
(db:get-db dbstruct run-id)
(conc "SELECT " db:test-record-qry-selector " FROM tests WHERE run_id=?;")
run-id)
res))
(define (db:replace-test-records dbstruct run-id testrecs)
(db:with-db dbstruct run-id #t
(lambda (db)
(let* ((qmarks (string-intersperse (make-list (length db:test-record-fields) "?") ","))
(qrystr (conc "INSERT OR REPLACE INTO tests (" db:test-record-qry-selector ") VALUES (" qmarks ");"))
(qry (sqlite3:prepare (db:get-db dbstruct run-id) qrystr)))
(debug:print 8 "INFO: replace-test-records, qrystr=" qrystr)
(qry (sqlite3:prepare db qrystr)))
;; (debug:print 8 "INFO: replace-test-records, qrystr=" qrystr)
(for-each
(lambda (rec)
;; (debug:print 0 "INFO: Inserting values: " (string-intersperse (map conc (vector->list rec)) ", "))
(debug:print 0 "INFO: Inserting values: " (string-intersperse (map conc (vector->list rec)) ", "))
(apply sqlite3:execute qry (vector->list rec)))
testrecs)
(sqlite3:finalize! qry)))
(sqlite3:finalize! qry)))))
;; Get test data using test_id
(define (db:get-test-info-by-id dbstruct run-id test-id)
(let ((db (db:get-db dbstruct run-id))
(res #f))
(sqlite3:for-each-row
|
︙ | | |
Modified db_records.scm
from [1641bf9d8d]
to [832e173195].
︙ | | |
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
|
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
|
-
+
-
+
|
(define-inline (dbr:dbstruct-set-local! vec val)(vector-set! vec 4 val))
;; get a rundb vector, create it if not already existing
(define (dbr:dbstruct-get-rundb-rec vec run-id)
(let* ((dbhash (dbr:dbstruct-get-dbhash vec)) ;; get the runs hash
(runvec (hash-table-ref/default dbhash run-id #f))) ;; get the vector for run-id
(if (vector? runvec)
runvec
runvec ;; rundb inmemdb last-mod last-read last-sync in-use
(let ((nvec (vector #f #f -1 -1 -1 #f)))
(hash-table-set! dbhash run-id nvec)
nvec))))
;; [ rundb inmemdb last-mod last-read last-sync ]
(define-inline (dbr:dbstruct-field-name->num field-name)
(case field-name
((rundb) 0) ;; the on-disk db
((inmem) 1) ;; the in-memory db
((mtime) 2) ;; last modification time
((rtime) 3) ;; last read time
((stime) 4) ;; last sync time
((inuse) 5) ;; is the db currently in use
((inuse) 5) ;; is the db currently in use, #t yes, #f no.
(else -1)))
;; get/set rundb fields
(define (dbr:dbstruct-get-runvec-val vec run-id field-name)
(let ((runvec (dbr:dbstruct-get-rundb-rec vec run-id))
(fieldnum (dbr:dbstruct-field-name->num field-name)))
;; (vector-set! runvec (dbr:dbstruct-field-name->num 'inuse) #t)
|
︙ | | |
Modified megatest.scm
from [c3002b1e2f]
to [ef3627057f].
︙ | | |
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
|
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
|
+
+
|
(set! *didsomething* #t)))
(if (args:get-arg "-import-megatest.db")
(let* ((toppath (setup-for-run))
(dbstruct (if toppath (make-dbr:dbstruct path: toppath) #f))
(mtdb (if toppath (db:open-megatest-db)))
(run-ids (if toppath (db:get-run-ids mtdb))))
;; sync runs, test_meta etc.
(db:sync-tables (db:sync-main-list mtdb) mtdb (db:get-db dbstruct #f))
(for-each
(lambda (run-id)
(let ((testrecs (db:get-all-tests-info-by-run-id mtdb run-id)))
(debug:print 0 "INFO: Updating " (length testrecs) " records for run-id=" run-id)
(db:replace-test-records dbstruct run-id testrecs)))
run-ids)
(set! *didsomething* #t)
|
︙ | | |