59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
-
-
-
|
;; 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)
(if (sqlite3:database? dbstruct) ;; pass sqlite3 databases on through
dbstruct
(begin
(mutex-lock! *rundb-mutex*)
;; db prunning would go here
(mutex-unlock! *rundb-mutex*)
|
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
|
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
|
+
-
+
-
-
-
-
+
+
+
+
+
+
-
+
+
|
;;
;; ;; Use to get a path. To get an arbitrary string see next define
;; ;;
;; (define (db:get-path dbstruct id)
;; (let ((fdb (db:get-filedb dbstruct)))
;; (filedb:get-path db id)))
;; NB// #f => return dbdir only
;; NB// #f => zeroth db with name=main.db
;; (was planned to be; zeroth db with name=main.db)
;;
(define (db:dbfile-path run-id)
(let* (;; (toppath (dbr:dbstruct-get-path dbstruct))
(link-tree-path (configf:lookup *configdat* "setup" "linktree"))
(fname (if (eq? run-id 0) "main.db" (conc run-id ".db")))
(dbdir (conc link-tree-path "/.db/")))
(let* ((dbdir (or (configf:lookup *configdat* "setup" "dbdir")
(conc (configf:lookup *configdat* "setup" "linktree") "/.db")))
(fname (if run-id
(if (eq? run-id 0) "main.db" (conc run-id ".db"))
#f)))
(handle-exceptions
exn
(begin
(debug:print 0 "ERROR: Couldn't create path to " dbdir)
(exit 1))
(if (not (directory? dbdir))(create-directory dbdir #t)))
(if fname
(conc dbdir fname)))
|
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
234
235
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
|
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
234
235
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
|
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
|
(let* ((local (dbr:dbstruct-get-local dbstruct))
(rdb (if local
(dbr:dbstruct-get-localdb dbstruct run-id)
(dbr:dbstruct-get-inmem dbstruct)))) ;; (dbr:dbstruct-get-runrec dbstruct run-id 'inmem)))
(if (or rdb
do-not-open)
rdb
(begin
(mutex-lock! *rundb-mutex*)
(let* ((dbpath (db:dbfile-path run-id)) ;; (conc toppath "/db/" run-id ".db"))
(dbexists (file-exists? dbpath))
(inmem (if local #f (db:open-inmem-db)))
(refdb (if local #f (db:open-inmem-db)))
(db (db:lock-create-open dbpath ;; this is the database physically on disk
(lambda (db)
(handle-exceptions
exn
(begin
(release-dot-lock dbpath)
(if (> attemptnum 2)
(debug:print 0 "ERROR: tried twice, cannot create/initialize db for run-id " run-id ", at path " dbpath)
(db:open-rundb dbstruct run-id attemptnum (+ attemptnum 1))))
(db:initialize-run-id-db db)
(sqlite3:execute
db
"INSERT OR IGNORE INTO tests (id,run_id,testname,event_time,item_path,state,status) VALUES (?,?,'bogustest',strftime('%s','now'),'nowherepath','DELETED','n/a');"
(* run-id 30000) ;; allow for up to 30k tests per run
run-id)
;; do a dummy query to test that the table exists and the db is truly readable
(sqlite3:execute db "SELECT * FROM tests WHERE id=?;" (* run-id 30000))
)))) ;; add strings db to rundb, not in use yet
;; )) ;; (sqlite3:open-database dbpath))
(olddb (if *megatest-db*
*megatest-db*
(let ((db (db:open-megatest-db)))
(set! *megatest-db* db)
db)))
(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
(dbr:dbstruct-set-rundb! dbstruct (cons db dbpath))
(dbr:dbstruct-set-inuse! dbstruct #t)
(dbr:dbstruct-set-olddb! dbstruct olddb)
;; (dbr:dbstruct-set-run-id! dbstruct run-id)
(if local
(begin
(dbr:dbstruct-set-localdb! dbstruct run-id db) ;; (dbr:dbstruct-set-inmem! dbstruct db) ;; direct access ...
db)
(begin
(dbr:dbstruct-set-inmem! dbstruct inmem)
;; dec 14, 2014 - keep deleted records available. hunch is that they are needed for id placeholders
;; (sqlite3:execute db "DELETE FROM tests WHERE state='DELETED';") ;; they just slow us down in this context
(db:sync-tables db:sync-tests-only db inmem)
(db:delay-if-busy refdb) ;; dbpath: (db:dbdat-get-path refdb)) ;; What does delaying here achieve?
(dbr:dbstruct-set-refdb! dbstruct refdb)
(db:sync-tables db:sync-tests-only inmem refdb) ;; use inmem as the reference, don't read again from db
;; sync once more to deal with delays?
;; (db:sync-tables db:sync-tests-only db inmem)
;; (db:sync-tables db:sync-tests-only inmem refdb)
inmem))))))
(let* ((dbpath (db:dbfile-path run-id)) ;; (conc toppath "/db/" run-id ".db"))
(dbexists (file-exists? dbpath))
(inmem (if local #f (db:open-inmem-db)))
(refdb (if local #f (db:open-inmem-db)))
(db (db:lock-create-open dbpath ;; this is the database physically on disk
(lambda (db)
(handle-exceptions
exn
(begin
(release-dot-lock dbpath)
(if (> attemptnum 2)
(debug:print 0 "ERROR: tried twice, cannot create/initialize db for run-id " run-id ", at path " dbpath)
(db:open-rundb dbstruct run-id attemptnum (+ attemptnum 1))))
(db:initialize-run-id-db db)
(sqlite3:execute
db
"INSERT OR IGNORE INTO tests (id,run_id,testname,event_time,item_path,state,status) VALUES (?,?,'bogustest',strftime('%s','now'),'nowherepath','DELETED','n/a');"
(* run-id 30000) ;; allow for up to 30k tests per run
run-id)
;; do a dummy query to test that the table exists and the db is truly readable
(sqlite3:execute db "SELECT * FROM tests WHERE id=?;" (* run-id 30000))
)))) ;; add strings db to rundb, not in use yet
;; )) ;; (sqlite3:open-database dbpath))
(olddb (if *megatest-db*
*megatest-db*
(let ((db (db:open-megatest-db)))
(set! *megatest-db* db)
db)))
(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
(dbr:dbstruct-set-rundb! dbstruct (cons db dbpath))
(dbr:dbstruct-set-inuse! dbstruct #t)
(dbr:dbstruct-set-olddb! dbstruct olddb)
;; (dbr:dbstruct-set-run-id! dbstruct run-id)
(mutex-unlock! *rundb-mutex*)
(if local
(begin
(dbr:dbstruct-set-localdb! dbstruct run-id db) ;; (dbr:dbstruct-set-inmem! dbstruct db) ;; direct access ...
db)
(begin
(dbr:dbstruct-set-inmem! dbstruct inmem)
;; dec 14, 2014 - keep deleted records available. hunch is that they are needed for id placeholders
;; (sqlite3:execute db "DELETE FROM tests WHERE state='DELETED';") ;; they just slow us down in this context
(db:sync-tables db:sync-tests-only db inmem)
(db:delay-if-busy refdb) ;; dbpath: (db:dbdat-get-path refdb)) ;; What does delaying here achieve?
(dbr:dbstruct-set-refdb! dbstruct refdb)
(db:sync-tables db:sync-tests-only inmem refdb) ;; use inmem as the reference, don't read again from db
;; sync once more to deal with delays?
;; (db:sync-tables db:sync-tests-only db inmem)
;; (db:sync-tables db:sync-tests-only inmem refdb)
inmem)))))))
;; This routine creates the db. It is only called if the db is not already ls opened
;;
(define (db:open-main dbstruct) ;; (conc *toppath* "/megatest.db") (car *configinfo*)))
(let ((mdb (dbr:dbstruct-get-main dbstruct)))
(if mdb
mdb
(begin
(mutex-lock! *rundb-mutex*)
(let* ((dbpath (db:dbfile-path 0))
(dbexists (file-exists? dbpath))
(db (db:lock-create-open dbpath db:initialize-main-db))
(olddb (db:open-megatest-db))
(write-access (file-write-access? dbpath))
(dbdat (cons db dbpath)))
(if (and dbexists (not write-access))
(set! *db-write-access* #f))
(dbr:dbstruct-set-main! dbstruct dbdat)
(dbr:dbstruct-set-olddb! dbstruct olddb) ;; olddb is already a (cons db path)
dbdat))))
(let* ((dbpath (db:dbfile-path 0))
(dbexists (file-exists? dbpath))
(db (db:lock-create-open dbpath db:initialize-main-db))
(olddb (db:open-megatest-db))
(write-access (file-write-access? dbpath))
(dbdat (cons db dbpath)))
(if (and dbexists (not write-access))
(set! *db-write-access* #f))
(dbr:dbstruct-set-main! dbstruct dbdat)
(dbr:dbstruct-set-olddb! dbstruct olddb) ;; olddb is already a (cons db path)
(mutex-unlock! *rundb-mutex*)
(if (and (not dbexists)
*db-write-access*) ;; did not have a prior db and do have write access
(db:multi-db-sync #f 'old2new)) ;; migrate data from megatest.db automatically
dbdat)))))
;; Make the dbstruct, setup up auxillary db's and call for main db at least once
;;
(define (db:setup run-id #!key (local #f))
(let* ((dbdir (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
(let* ((dbdir (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
(dbstruct (make-dbr:dbstruct path: dbdir local: local)))
dbstruct))
;; Open the classic megatest.db file in toppath
;;
(define (db:open-megatest-db)
(let* ((dbpath (conc *toppath* "/megatest.db"))
|
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
|
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
|
-
+
|
(set! res (vector test-id run-id testname state status -1 "" -1 -1 "" "-" item-path -1 "-" "-")))
db
"SELECT run_id,testname,item_path,state,status FROM tests WHERE id=?;"
test-id)))
res))
;; get a useful subset of the tests data (used in dashboard
;; use db:mintests-get-{id ,run_id,testname ...}
;; use db:mintest-get-{id ,run_id,testname ...}
;;
(define (db:get-tests-for-runs-mindata dbstruct run-ids testpatt states statuses not-in)
(debug:print 0 "ERROR: BROKN!")
;; (db:get-tests-for-runs dbstruct run-ids testpatt states statuses not-in: not-in qryvals: "id,run_id,testname,state,status,event_time,item_path"))
)
;; get a useful subset of the tests data (used in dashboard
|
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
|
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
|
+
+
+
+
+
+
+
+
+
+
+
+
+
|
run-id
#f
(lambda (db)
(sqlite3:first-result
db
"SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND run_id=? AND NOT (uname = 'n/a' AND item_path = '');" run-id))))
;; For a given testname how many items are running? Used to determine
;; probability for regenerating html
;;
(define (db:get-count-tests-running-for-testname dbstruct run-id testname)
(db:with-db
dbstruct
run-id
#f
(lambda (db)
(sqlite3:first-result
db
"SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND run_id=? AND NOT (uname = 'n/a' AND item_path = '') AND testname=?;" run-id testname))))
(define (db:get-count-tests-running-in-jobgroup dbstruct run-id jobgroup)
(let* ((dbdat (db:get-db dbstruct #f))
(db (db:dbdat-get-db dbdat)))
(if (not jobgroup)
0 ;;
(let ((testnames '()))
;; get the testnames
|
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
|
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
|
-
+
|
#f
(lambda (db)
(sqlite3:first-result
db
(conc "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND testname in ('"
(string-intersperse testnames "','")
"') AND NOT (uname = 'n/a' AND item_path='');")) ;; should this include the (uname = 'n/a' ...) ???
0)))))))
)))))))
;; DEBUG FIXME - need to merge this v.155 query correctly
;; AND testname in (SELECT testname FROM test_meta WHERE jobgroup=?)
;; AND NOT (uname = 'n/a' AND item_path = '');"
;; done with run when:
;; 0 tests in LAUNCHED, NOT_STARTED, REMOTEHOSTSTART, RUNNING
(define (db:estimated-tests-remaining dbstruct run-id)
|