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
|
;;
;;======================================================================
;;======================================================================
;; T E S T S P E C I F I C D B
;;======================================================================
;; Create the sqlite db for the individual test(s)
;;
;; Moved these tables into <runid>.db
;; THIS CODE TO BE REMOVED
;;
(define (open-test-db work-area)
(debug:print-info 11 *default-log-port* "open-test-db " work-area)
(if (and work-area
(directory? work-area)
(file-read-access? work-area))
(let* ((dbpath (conc work-area "/testdat.db"))
(dbexists (common:file-exists? dbpath))
(work-area-writeable (file-write-access? work-area))
(db (handle-exceptions ;; open the db if area writeable or db pre-existing. open in-mem otherwise. if exception, open in-mem
exn
(begin
(print-call-chain (current-error-port))
(debug:print 2 *default-log-port* "ERROR: problem accessing test db " work-area ", you probably should clean and re-run this test"
((condition-property-accessor 'exn 'message) exn))
(set! dbexists #f) ;; must force re-creation of tables, more tom-foolery
(sqlite3:open-database ":memory:")) ;; open an in-memory db to allow readonly access
(if (or work-area-writeable
dbexists)
(sqlite3:open-database dbpath)
(sqlite3:open-database ":memory:"))))
(tdb-writeable (and (file-write-access? work-area)
(file-write-access? dbpath)))
(handler (sqlite3:make-busy-timeout (if (args:get-arg "-override-timeout")
(string->number (args:get-arg "-override-timeout"))
136000))))
(if (and tdb-writeable
*db-write-access*)
(sqlite3:set-busy-handler! db handler))
(if (not dbexists)
(begin
(db:set-sync db) ;; (sqlite3:execute db "PRAGMA synchronous = FULL;")
(debug:print-info 11 *default-log-port* "Initialized test database " dbpath)
(tdb:testdb-initialize db)))
;; (sqlite3:execute db "PRAGMA synchronous = 0;")
(debug:print-info 11 *default-log-port* "open-test-db END (sucessful)" work-area)
;; now let's test that everything is correct
(handle-exceptions
exn
(begin
(print-call-chain (current-error-port))
(debug:print-error 0 *default-log-port* "problem accessing test db " work-area ", you probably should clean and re-run this test or remove the file "
dbpath ".\n "
((condition-property-accessor 'exn 'message) exn))
#f)
;; Is there a cheaper single line operation that will check for existance of a table
;; and raise an exception ?
(sqlite3:execute db "SELECT id FROM test_data LIMIT 1;"))
db)
;; no work-area or not readable - create a placeholder to fake rest of world out
(let ((baddb (sqlite3:open-database ":memory:")))
(debug:print-info 11 *default-log-port* "open-test-db END (unsucessful)" work-area)
;; provide an in-mem db (this is dangerous!)
(tdb:testdb-initialize baddb)
baddb)))
;; find and open the testdat.db file for an existing test
(define (tdb:open-test-db-by-test-id test-id #!key (work-area #f))
(let* ((test-path (if work-area
work-area
(rmt:test-get-rundir-from-test-id test-id))))
(debug:print 3 *default-log-port* "TEST PATH: " test-path)
(open-test-db test-path)))
;; find and open the testdat.db file for an existing test
(define (tdb:open-test-db-by-test-id-local dbstruct run-id test-id #!key (work-area #f))
(let* ((test-path (if work-area
work-area
(db:test-get-rundir-from-test-id dbstruct run-id test-id))))
(debug:print 3 *default-log-port* "TEST PATH: " test-path)
(open-test-db test-path)))
;; find and open the testdat.db file for an existing test
(define (tdb:open-run-close-db-by-test-id-local dbstruct run-id test-id work-area proc . params)
(let* ((test-path (if work-area
work-area
(db:test-get-rundir-from-test-id dbstruct run-id test-id)))
(tdb (open-test-db test-path)))
(apply proc tdb params)))
(define (tdb:testdb-initialize db)
(debug:print 11 *default-log-port* "db:testdb-initialize START")
(sqlite3:with-transaction
db
(lambda ()
(for-each
(lambda (sqlcmd)
(sqlite3:execute db sqlcmd))
(list "CREATE TABLE IF NOT EXISTS test_rundat (
id INTEGER PRIMARY KEY,
update_time TIMESTAMP,
cpuload INTEGER DEFAULT -1,
diskfree INTEGER DEFAULT -1,
diskusage INTGER DEFAULT -1,
run_duration INTEGER DEFAULT 0);"
"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));"
"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));"
;; test_meta can be used for handing commands to the test
;; e.g. KILLREQ
;; the ackstate is set to 1 once the command has been completed
"CREATE TABLE IF NOT EXISTS test_meta (
id INTEGER PRIMARY KEY,
var TEXT,
val TEXT,
ackstate INTEGER DEFAULT 0,
CONSTRAINT metadat_constraint UNIQUE (var));"))))
(debug:print 11 *default-log-port* "db:testdb-initialize END"))
;; This routine moved to db:read-test-data
;;
(define (tdb:read-test-data tdb test-id categorypatt)
(let ((res '()))
(sqlite3:for-each-row
(lambda (id test_id category variable value expected tol units comment status type)
(set! res (cons (vector id test_id category variable value expected tol units comment status type) res)))
tdb
"SELECT id,test_id,category,variable,value,expected,tol,units,comment,status,type FROM test_data WHERE test_id=? AND category LIKE ? ORDER BY category,variable;" test-id categorypatt)
(sqlite3:finalize! tdb)
(reverse res)))
;;======================================================================
;; T E S T D A T A
;;======================================================================
;; ;; get a list of test_data records matching categorypatt
;; (define (tdb:read-test-data test-id categorypatt #!key (work-area #f))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
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
|
;;
;;======================================================================
;;======================================================================
;; T E S T S P E C I F I C D B
;;======================================================================
;; =not-used= ;; Create the sqlite db for the individual test(s)
;; =not-used= ;;
;; =not-used= ;; Moved these tables into <runid>.db
;; =not-used= ;; THIS CODE TO BE REMOVED
;; =not-used= ;;
;; =not-used= (define (open-test-db work-area)
;; =not-used= (debug:print-info 11 *default-log-port* "open-test-db " work-area)
;; =not-used= (if (and work-area
;; =not-used= (directory? work-area)
;; =not-used= (file-read-access? work-area))
;; =not-used= (let* ((dbpath (conc work-area "/testdat.db"))
;; =not-used= (dbexists (common:file-exists? dbpath))
;; =not-used= (work-area-writeable (file-write-access? work-area))
;; =not-used= (db (handle-exceptions ;; open the db if area writeable or db pre-existing. open in-mem otherwise. if exception, open in-mem
;; =not-used= exn
;; =not-used= (begin
;; =not-used= (print-call-chain (current-error-port))
;; =not-used= (debug:print 2 *default-log-port* "ERROR: problem accessing test db " work-area ", you probably should clean and re-run this test"
;; =not-used= ((condition-property-accessor 'exn 'message) exn))
;; =not-used= (set! dbexists #f) ;; must force re-creation of tables, more tom-foolery
;; =not-used= (sqlite3:open-database ":memory:")) ;; open an in-memory db to allow readonly access
;; =not-used= (if (or work-area-writeable
;; =not-used= dbexists)
;; =not-used= (sqlite3:open-database dbpath)
;; =not-used= (sqlite3:open-database ":memory:"))))
;; =not-used= (tdb-writeable (and (file-write-access? work-area)
;; =not-used= (file-write-access? dbpath)))
;; =not-used= (handler (sqlite3:make-busy-timeout (if (args:get-arg "-override-timeout")
;; =not-used= (string->number (args:get-arg "-override-timeout"))
;; =not-used= 136000))))
;; =not-used=
;; =not-used= (if (and tdb-writeable
;; =not-used= *db-write-access*)
;; =not-used= (sqlite3:set-busy-handler! db handler))
;; =not-used= (if (not dbexists)
;; =not-used= (begin
;; =not-used= (db:set-sync db) ;; (sqlite3:execute db "PRAGMA synchronous = FULL;")
;; =not-used= (debug:print-info 11 *default-log-port* "Initialized test database " dbpath)
;; =not-used= (tdb:testdb-initialize db)))
;; =not-used= ;; (sqlite3:execute db "PRAGMA synchronous = 0;")
;; =not-used= (debug:print-info 11 *default-log-port* "open-test-db END (sucessful)" work-area)
;; =not-used= ;; now let's test that everything is correct
;; =not-used= (handle-exceptions
;; =not-used= exn
;; =not-used= (begin
;; =not-used= (print-call-chain (current-error-port))
;; =not-used= (debug:print-error 0 *default-log-port* "problem accessing test db " work-area ", you probably should clean and re-run this test or remove the file "
;; =not-used= dbpath ".\n "
;; =not-used= ((condition-property-accessor 'exn 'message) exn))
;; =not-used= #f)
;; =not-used= ;; Is there a cheaper single line operation that will check for existance of a table
;; =not-used= ;; and raise an exception ?
;; =not-used= (sqlite3:execute db "SELECT id FROM test_data LIMIT 1;"))
;; =not-used= db)
;; =not-used= ;; no work-area or not readable - create a placeholder to fake rest of world out
;; =not-used= (let ((baddb (sqlite3:open-database ":memory:")))
;; =not-used= (debug:print-info 11 *default-log-port* "open-test-db END (unsucessful)" work-area)
;; =not-used= ;; provide an in-mem db (this is dangerous!)
;; =not-used= (tdb:testdb-initialize baddb)
;; =not-used= baddb)))
;; =not-used=
;; =not-used= ;; find and open the testdat.db file for an existing test
;; =not-used= (define (tdb:open-test-db-by-test-id test-id #!key (work-area #f))
;; =not-used= (let* ((test-path (if work-area
;; =not-used= work-area
;; =not-used= (rmt:test-get-rundir-from-test-id test-id))))
;; =not-used= (debug:print 3 *default-log-port* "TEST PATH: " test-path)
;; =not-used= (open-test-db test-path)))
;; =not-used=
;; =not-used= ;; find and open the testdat.db file for an existing test
;; =not-used= (define (tdb:open-test-db-by-test-id-local dbstruct run-id test-id #!key (work-area #f))
;; =not-used= (let* ((test-path (if work-area
;; =not-used= work-area
;; =not-used= (db:test-get-rundir-from-test-id dbstruct run-id test-id))))
;; =not-used= (debug:print 3 *default-log-port* "TEST PATH: " test-path)
;; =not-used= (open-test-db test-path)))
;; =not-used=
;; =not-used= ;; find and open the testdat.db file for an existing test
;; =not-used= (define (tdb:open-run-close-db-by-test-id-local dbstruct run-id test-id work-area proc . params)
;; =not-used= (let* ((test-path (if work-area
;; =not-used= work-area
;; =not-used= (db:test-get-rundir-from-test-id dbstruct run-id test-id)))
;; =not-used= (tdb (open-test-db test-path)))
;; =not-used= (apply proc tdb params)))
;; =not-used=
;; =not-used= (define (tdb:testdb-initialize db)
;; =not-used= (debug:print 11 *default-log-port* "db:testdb-initialize START")
;; =not-used= (sqlite3:with-transaction
;; =not-used= db
;; =not-used= (lambda ()
;; =not-used= (for-each
;; =not-used= (lambda (sqlcmd)
;; =not-used= (sqlite3:execute db sqlcmd))
;; =not-used= (list "CREATE TABLE IF NOT EXISTS test_rundat (
;; =not-used= id INTEGER PRIMARY KEY,
;; =not-used= update_time TIMESTAMP,
;; =not-used= cpuload INTEGER DEFAULT -1,
;; =not-used= diskfree INTEGER DEFAULT -1,
;; =not-used= diskusage INTGER DEFAULT -1,
;; =not-used= run_duration INTEGER DEFAULT 0);"
;; =not-used= "CREATE TABLE IF NOT EXISTS test_data (
;; =not-used= id INTEGER PRIMARY KEY,
;; =not-used= test_id INTEGER,
;; =not-used= category TEXT DEFAULT '',
;; =not-used= variable TEXT,
;; =not-used= value REAL,
;; =not-used= expected REAL,
;; =not-used= tol REAL,
;; =not-used= units TEXT,
;; =not-used= comment TEXT DEFAULT '',
;; =not-used= status TEXT DEFAULT 'n/a',
;; =not-used= type TEXT DEFAULT '',
;; =not-used= CONSTRAINT test_data_constraint UNIQUE (test_id,category,variable));"
;; =not-used= "CREATE TABLE IF NOT EXISTS test_steps (
;; =not-used= id INTEGER PRIMARY KEY,
;; =not-used= test_id INTEGER,
;; =not-used= stepname TEXT,
;; =not-used= state TEXT DEFAULT 'NOT_STARTED',
;; =not-used= status TEXT DEFAULT 'n/a',
;; =not-used= event_time TIMESTAMP,
;; =not-used= comment TEXT DEFAULT '',
;; =not-used= logfile TEXT DEFAULT '',
;; =not-used= CONSTRAINT test_steps_constraint UNIQUE (test_id,stepname,state));"
;; =not-used= ;; test_meta can be used for handing commands to the test
;; =not-used= ;; e.g. KILLREQ
;; =not-used= ;; the ackstate is set to 1 once the command has been completed
;; =not-used= "CREATE TABLE IF NOT EXISTS test_meta (
;; =not-used= id INTEGER PRIMARY KEY,
;; =not-used= var TEXT,
;; =not-used= val TEXT,
;; =not-used= ackstate INTEGER DEFAULT 0,
;; =not-used= CONSTRAINT metadat_constraint UNIQUE (var));"))))
;; =not-used= (debug:print 11 *default-log-port* "db:testdb-initialize END"))
;; =not-used=
;; =not-used= ;; This routine moved to db:read-test-data
;; =not-used= ;;
;; =not-used= (define (tdb:read-test-data tdb test-id categorypatt)
;; =not-used= (let ((res '()))
;; =not-used= (sqlite3:for-each-row
;; =not-used= (lambda (id test_id category variable value expected tol units comment status type)
;; =not-used= (set! res (cons (vector id test_id category variable value expected tol units comment status type) res)))
;; =not-used= tdb
;; =not-used= "SELECT id,test_id,category,variable,value,expected,tol,units,comment,status,type FROM test_data WHERE test_id=? AND category LIKE ? ORDER BY category,variable;" test-id categorypatt)
;; =not-used= (sqlite3:finalize! tdb)
;; =not-used= (reverse res)))
;;======================================================================
;; T E S T D A T A
;;======================================================================
;; ;; get a list of test_data records matching categorypatt
;; (define (tdb:read-test-data test-id categorypatt #!key (work-area #f))
|