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
|
(declare (uses filedb))
(include "common_records.scm")
(include "db_records.scm")
(include "key_records.scm")
(include "run_records.scm")
;; 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))
(if run-id
(db:open-rundb dbstruct run-id)
(db:open-main dbstruct)))
(define (db:set-sync db)
(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)
((string-match (regexp "no" #t) syncval) 0)
((string-match (regexp "(off|normal|full)" #t) syncval) syncval)
(else
(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 "';"))))))
|
<
<
<
<
<
|
<
>
>
|
|
|
>
>
>
>
>
>
>
|
<
<
<
<
<
<
<
<
<
|
<
<
|
>
>
|
|
<
|
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
|
(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
;; 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)))
|
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
(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)
inmem))))
;; This routine creates the db. It is only called if the db is not already opened
;;
(define (db:open-main dbstruct) ;; (conc *toppath* "/megatest.db") (car *configinfo*)))
(let ((mdb (dbr:dbstruct-get-main dbstruct)))
(if mdb
|
>
>
|
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
(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 (db:open-main dbstruct) ;; (conc *toppath* "/megatest.db") (car *configinfo*)))
(let ((mdb (dbr:dbstruct-get-main dbstruct)))
(if mdb
|
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
|
(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))))
;; 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))
;; (define (db:sync-table tblname fields fromdb todb)
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
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
|
(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
(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)
'("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))
|
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
|
;; (define open-run-close
(define open-run-close (if (debug:debug-mode 2)
open-run-close-no-exception-handling
open-run-close-exception-handling))
(define (db:initialize-megatest-db db)
(let* ((configdat (car *configinfo*)) ;; tut tut, global warning...
(keys (keys:configq-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"
|
|
|
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
|
;; (define open-run-close
(define open-run-close (if (debug:debug-mode 2)
open-run-close-no-exception-handling
open-run-close-exception-handling))
(define (db:initialize-megatest-db db)
(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"
|
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
|
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 test_data
(id INTEGER PRIMARY KEY,
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,
|
|
|
|
|
|
|
|
|
|
|
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
|
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 test_data
;; (id INTEGER PRIMARY KEY,
;; 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,
|