22
23
24
25
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
|
(sqlite3:set-busy-handler! db handler)
(if (not dbexists)
(let* ((keys (config-get-fields configdat))
(havekeys (> (length keys) 0))
(keystr (keys->keystr keys))
(fieldstr (keys->key/field keys)))
;; (sqlite3:execute db "PRAGMA synchronous = OFF;")
(sqlite3:execute db "CREATE TABLE 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:get-fieldname key)(key:get-fieldtype key)))
keys)
(sqlite3:execute db (conc
"CREATE TABLE runs (id INTEGER PRIMARY KEY, "
fieldstr (if havekeys "," "")
"runname TEXT,"
"state TEXT DEFAULT '',"
"status TEXT DEFAULT '',"
"owner TEXT DEFAULT '',"
"event_time TIMESTAMP,"
"comment TEXT DEFAULT '',"
"fail_count INTEGER DEFAULT 0,"
"pass_count INTEGER DEFAULT 0,"
"CONSTRAINT runsconstraint UNIQUE (runname" (if havekeys "," "") keystr "));"))
(sqlite3:execute db (conc "CREATE INDEX runs_index ON runs (runname" (if havekeys "," "") keystr ");"))
(sqlite3:execute db
"CREATE TABLE tests
(id INTEGER PRIMARY KEY,
run_id INTEGER,
testname TEXT,
host TEXT DEFAULT 'n/a',
cpuload REAL DEFAULT -1,
diskfree INTEGER DEFAULT -1,
uname TEXT DEFAULT 'n/a',
|
|
|
|
|
22
23
24
25
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
|
(sqlite3:set-busy-handler! db handler)
(if (not dbexists)
(let* ((keys (config-get-fields configdat))
(havekeys (> (length keys) 0))
(keystr (keys->keystr keys))
(fieldstr (keys->key/field keys)))
;; (sqlite3:execute db "PRAGMA synchronous = OFF;")
(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:get-fieldname key)(key:get-fieldtype key)))
keys)
(sqlite3:execute db (conc
"CREATE TABLE IF NOT EXISTS runs (id INTEGER PRIMARY KEY, "
fieldstr (if havekeys "," "")
"runname TEXT,"
"state TEXT DEFAULT '',"
"status TEXT DEFAULT '',"
"owner TEXT DEFAULT '',"
"event_time TIMESTAMP,"
"comment TEXT DEFAULT '',"
"fail_count INTEGER DEFAULT 0,"
"pass_count INTEGER DEFAULT 0,"
"CONSTRAINT runsconstraint UNIQUE (runname" (if havekeys "," "") keystr "));"))
(sqlite3:execute db (conc "CREATE INDEX runs_index ON runs (runname" (if havekeys "," "") keystr ");"))
(sqlite3:execute db
"CREATE TABLE IF NOT EXISTS tests
(id INTEGER PRIMARY KEY,
run_id INTEGER,
testname TEXT,
host TEXT DEFAULT 'n/a',
cpuload REAL DEFAULT -1,
diskfree INTEGER DEFAULT -1,
uname TEXT DEFAULT 'n/a',
|
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
|
event_time TIMESTAMP,
fail_count INTEGER DEFAULT 0,
pass_count INTEGER DEFAULT 0,
CONSTRAINT testsconstraint UNIQUE (run_id, testname, item_path)
);")
(sqlite3:execute db "CREATE INDEX tests_index ON tests (run_id, testname);")
(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 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 '',
CONSTRAINT test_steps_constraint UNIQUE (test_id,stepname,state));")
(sqlite3:execute db "CREATE TABLE extradat (id INTEGER PRIMARY KEY, run_id INTEGER, key TEXT, val TEXT);")
(sqlite3:execute db "CREATE TABLE metadat (id INTEGER PRIMARY KEY, var TEXT, val TEXT,
CONSTRAINT metadat_constraint UNIQUE (id,var));")
(db:set-var db "MEGATEST_VERSION" megatest-version)
(sqlite3:execute db "CREATE TABLE access_log (id INTEGER PRIMARY KEY, user TEXT, accessed TIMESTAMP, args TEXT);")
(patch-db db)))
db))
;;======================================================================
;; TODO:
;; 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 metadat (id INTEGER PRIMARY KEY, var TEXT, val TEXT,
CONSTRAINT metadat_constraint UNIQUE (id,var));")
(db:set-var db "MEGATEST_VERSION" 1.17)
)
(let ((mver (db:get-var db "MEGATEST_VERSION")))
(print "Current schema version: " mver " current megatest version: " megatest-version)
(if (not mver)
(begin
(print "Adding megatest-version to metadata")
(sqlite3:execute db (db:set-var db "MEGATEST_VERSION" megatest-version))))
;; (if (< mver 1.18)
;; (begin
;; (print "Adding tags column to tests table")
;; (sqlite3:execute db "ALTER TABLE tests ADD COLUMN tags TEXT DEFAULT '';")))
(if (< mver 1.21)
(begin
(sqlite3:execute db "CREATE TABLE 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_contstraint UNIQUE (id,testname));")
(for-each
(lambda (stmt)
(sqlite3:execute db stmt))
(list
"ALTER TABLE tests ADD COLUMN expected_value REAL;" ;; DO NOT Add a default, we want it to be NULL
"ALTER TABLE tests ADD COLUMN value REAL;"
"ALTER TABLE tests ADD COLUMN tol REAL;"
"ALTER TABLE tests ADD COLUMN tol_perc REAL;"
"ALTER TABLE tests ADD COLUMN first_err TEXT;"
"ALTER TABLE tests ADD COLUMN first_warn TEXT;"
"ALTER TABLE tests ADD COLUMN units TEXT;"
))))
(if (< mver megatest-version)
(db:set-var db "MEGATEST_VERSION" megatest-version)))))
;;======================================================================
;; meta get and set vars
;;======================================================================
;; returns number if string->number is successful, string otherwise
(define (db:get-var db var)
(let ((res #f))
(sqlite3:for-each-row
(lambda (val)
(set! res val))
db "SELECT val FROM metadat WHERE var=?;" var)
(if (string? res)
(let ((valnum (string->number res)))
(if valnum valnum res))
res)))
(define (db:set-var db var val)
(sqlite3:execute db "INSERT OR REPLACE INTO metadat (var,val) VALUES (?,?);" var val))
|
|
|
|
|
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
|
<
<
<
<
<
<
<
<
<
<
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
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
|
event_time TIMESTAMP,
fail_count INTEGER DEFAULT 0,
pass_count INTEGER DEFAULT 0,
CONSTRAINT testsconstraint UNIQUE (run_id, testname, item_path)
);")
(sqlite3:execute db "CREATE INDEX tests_index ON tests (run_id, testname);")
(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 '',
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));")
(db:set-var db "MEGATEST_VERSION" megatest-version)
(sqlite3:execute db "CREATE TABLE IF NOT EXISTS access_log (id INTEGER PRIMARY KEY, user TEXT, accessed TIMESTAMP, args TEXT);")
(patch-db db)))
db))
;;======================================================================
;; TODO:
;; 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));")
(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)
(if (not mver)
(begin
(print "Adding megatest-version to metadata")
(sqlite3:execute db (db:set-var db "MEGATEST_VERSION" megatest-version))))
;; (if (< mver 1.18)
;; (begin
;; (print "Adding tags column to tests table")
;; (sqlite3:execute db "ALTER TABLE tests ADD COLUMN tags TEXT DEFAULT '';")))
(if (< mver 1.21)
(begin
(sqlite3:execute db test-meta-def)
(for-each
(lambda (stmt)
(sqlite3:execute db stmt))
(list
"ALTER TABLE tests ADD COLUMN expected_value REAL;" ;; DO NOT Add a default, we want it to be NULL
"ALTER TABLE tests ADD COLUMN value REAL;"
"ALTER TABLE tests ADD COLUMN tol REAL;"
"ALTER TABLE tests ADD COLUMN tol_perc REAL;"
"ALTER TABLE tests ADD COLUMN first_err TEXT;"
"ALTER TABLE tests ADD COLUMN first_warn TEXT;"
"ALTER TABLE tests ADD COLUMN units TEXT;"
))))
(if (< mver 1.22)
(begin
(sqlite3:execute db "DROP TABLE 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,
comment TEXT DEFAULT '',
CONSTRAINT test_data UNIQUE (test_id,category,variable));")))
(if (< mver megatest-version)
(db:set-var db "MEGATEST_VERSION" megatest-version)))))
;;======================================================================
;; meta get and set vars
;;======================================================================
;; returns number if string->number is successful, string otherwise
(define (db:get-var db var)
(let ((res #f))
(sqlite3:for-each-row
(lambda (val)
(set! res val))
db "SELECT val FROM metadat WHERE var=?;" var)
(if (string? res)
(let ((valnum (string->number res)))
(if valnum valnum res))
res)))
(define (db:set-var db var val)
;; Odd, I thought that if a constraint was placed on column then an insert with duplicate data
;; would fail and the insert would fall back to replace.
;; NB// accidently included primary key in the unique constraint which does not work.
(let ((have (db:get-var db var)))
;; (if have
;; (sqlite3:execute db "UPDATE metadat SET val=? WHERE var=?;" val var)
(sqlite3:execute db "INSERT OR REPLACE INTO metadat (var,val) VALUES (?,?);" var val)))
;; 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
(define *db-keys* #f)
(define (db-get-keys db)
|
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
|
(sqlite3:execute db "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))
;;======================================================================
;; Steps
;;======================================================================
;; Run steps
;; make-vector-record "Run steps" db step id test_id stepname step_complete step_pass event_time
(define (make-db:step)(make-vector 6))
(define-inline (db:step-get-id vec) (vector-ref vec 0))
(define-inline (db:step-get-test_id vec) (vector-ref vec 1))
(define-inline (db:step-get-stepname vec) (vector-ref vec 2))
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
459
460
461
462
463
464
465
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
|
(sqlite3:execute db "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))
;;======================================================================
;; T E S T D A T A
;;======================================================================
(define (db:csv->testdata db test-id csvdata)
(let ((csvlist (csv->list csvdata)))
(for-each
(lambda (csvrow)
(apply sqlite3:execute db "INSERT OR REPLACE INTO test_data (test_id,category,variable,value,comment) VALUES (?,?,?,?,?);"
test-id (take (append csvrow '("" "" "" "")) 4)))
csvlist)))
(define (db:load-test-data db run-id test-name itemdat)
(let* ((item-path (item-list->path itemdat))
(testdat (db:get-test-info db run-id test-name item-path))
(test-id (db:test-get-id testdat)))
(debug:print 1 "Enter records to insert in the test_data table, four fields, comma separated per line")
(debug:print 4 "itemdat: " itemdat ", test-name: " test-name ", test-id: " test-id)
(let loop ((lin (read-line)))
(if (not (eof-object? lin))
(begin
(debug:print 4 lin)
(db:csv->testdata db test-id lin)
(loop (read-line)))))))
;;======================================================================
;; S T E P S
;;======================================================================
;; Run steps
;; make-vector-record "Run steps" db step id test_id stepname step_complete step_pass event_time
(define (make-db:step)(make-vector 6))
(define-inline (db:step-get-id vec) (vector-ref vec 0))
(define-inline (db:step-get-test_id vec) (vector-ref vec 1))
(define-inline (db:step-get-stepname vec) (vector-ref vec 2))
|