︙ | | | ︙ | |
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
|
tmpdb))))
;; Make the dbstruct, setup up auxillary db's and call for main db at least once
;;
;; called in http-transport and replicated in rmt.scm for *local* access.
;;
(define (db:setup #!key (areapath #f)) ;; . junk) ;; #!key (run-id #f) (local #f))
(let* (;; (dbdir (db:dbfile-path)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
(dbstruct (make-dbr:dbstruct))) ;; ) ;; path: dbdir local: local)))
(db:open-db dbstruct areapath: #f)
dbstruct))
;; open the local db for direct access (no server)
;;
(define (db:open-local-db-handle)
(or *dbstruct-db*
(let ((dbstruct (db:setup))) ;; #f local: #t)))
(set! *dbstruct-db* dbstruct)
dbstruct)))
;; Open the classic megatest.db file (defaults to open in toppath)
;;
;; NOTE: returns a dbdat not a dbstruct!
;;
(define (db:open-megatest-db #!key (path #f)(name #f))
(let* ((dbpath (conc (or path *toppath*) "/" (or name "megatest.db")))
(dbexists (file-exists? dbpath))
|
>
|
|
|
<
<
<
<
<
<
<
|
|
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
|
tmpdb))))
;; Make the dbstruct, setup up auxillary db's and call for main db at least once
;;
;; called in http-transport and replicated in rmt.scm for *local* access.
;;
(define (db:setup #!key (areapath #f)) ;; . junk) ;; #!key (run-id #f) (local #f))
(or *dbstruct-db*
(let* (;; (dbdir (db:dbfile-path)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
(dbstruct (make-dbr:dbstruct))) ;; ) ;; path: dbdir local: local)))
(db:open-db dbstruct areapath: #f)
(set! *dbstruct-db* dbstruct)
dbstruct)))
;; Open the classic megatest.db file (defaults to open in toppath)
;;
;; NOTE: returns a dbdat not a dbstruct!
;;
(define (db:open-megatest-db #!key (path #f)(name #f))
(let* ((dbpath (conc (or path *toppath*) "/" (or name "megatest.db")))
(dbexists (file-exists? dbpath))
|
︙ | | | ︙ | |
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
|
(tmpdb (dbr:dbstruct-tmpdb dbstruct))
(mtdb (dbr:dbstruct-mtdb dbstruct))
(refndb (dbr:dbstruct-refndb dbstruct))
;; (runid (dbr:dbstruct-run-id dbstruct))
)
(debug:print-info 4 *default-log-port* "Syncing for run-id: " run-id)
;; (mutex-lock! *http-mutex*)
(db:sync-tables (db:sync-all-tables-list tmpdb) #f tmpdb refndb mtdb)))
;; (if (eq? run-id 0)
;; ;; runid equal to 0 is main.db
;; (if maindb
;; (if (or (not (number? mtime))
;; (not (number? stime))
;; (> mtime stime)
;; force-sync)
|
|
|
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
|
(tmpdb (dbr:dbstruct-tmpdb dbstruct))
(mtdb (dbr:dbstruct-mtdb dbstruct))
(refndb (dbr:dbstruct-refndb dbstruct))
;; (runid (dbr:dbstruct-run-id dbstruct))
)
(debug:print-info 4 *default-log-port* "Syncing for run-id: " run-id)
;; (mutex-lock! *http-mutex*)
(db:sync-tables (db:sync-all-tables-list dbstruct) #f tmpdb refndb mtdb)))
;; (if (eq? run-id 0)
;; ;; runid equal to 0 is main.db
;; (if maindb
;; (if (or (not (number? mtime))
;; (not (number? stime))
;; (> mtime stime)
;; force-sync)
|
︙ | | | ︙ | |
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
|
"FAIL"
status)
statuses)
statuses)))
*common:std-statuses* >))
(newstate (if (null? all-curr-states) "NOT_STARTED" (car all-curr-states)))
(newstatus (if (null? all-curr-statuses) "n/a" (car all-curr-statuses))))
(print "Setting toplevel to: " newstate "/" newstatus)
(db:test-set-state-status-by-id dbstruct run-id tl-test-id newstate newstatus #f)))))))
(define db:roll-up-pass-fail-counts db:set-state-status-and-roll-up-items)
;; call with state = #f to roll up with out accounting for state/status of this item
;;
;; (define (db:roll-up-pass-fail-counts dbstruct run-id test-name item-path state status)
|
|
|
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
|
"FAIL"
status)
statuses)
statuses)))
*common:std-statuses* >))
(newstate (if (null? all-curr-states) "NOT_STARTED" (car all-curr-states)))
(newstatus (if (null? all-curr-statuses) "n/a" (car all-curr-statuses))))
;; (print "Setting toplevel to: " newstate "/" newstatus)
(db:test-set-state-status-by-id dbstruct run-id tl-test-id newstate newstatus #f)))))))
(define db:roll-up-pass-fail-counts db:set-state-status-and-roll-up-items)
;; call with state = #f to roll up with out accounting for state/status of this item
;;
;; (define (db:roll-up-pass-fail-counts dbstruct run-id test-name item-path state status)
|
︙ | | | ︙ | |
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
|
(set! logf final_logf)
(set! res (list path final_logf))
(if (directory? path)
(debug:print 2 *default-log-port* "Found path: " path)
(debug:print 2 *default-log-port* "No such path: " path))) ;; )
db
"SELECT rundir,final_logf FROM tests WHERE testname=? AND item_path='' AND run_id=?;"
test-name)
res))))
;;======================================================================
;; A G R E G A T E D T R A N S A C T I O N D B W R I T E S
;;======================================================================
(define db:queries
|
|
|
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
|
(set! logf final_logf)
(set! res (list path final_logf))
(if (directory? path)
(debug:print 2 *default-log-port* "Found path: " path)
(debug:print 2 *default-log-port* "No such path: " path))) ;; )
db
"SELECT rundir,final_logf FROM tests WHERE testname=? AND item_path='' AND run_id=?;"
test-name run-id)
res))))
;;======================================================================
;; A G R E G A T E D T R A N S A C T I O N D B W R I T E S
;;======================================================================
(define db:queries
|
︙ | | | ︙ | |
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
|
;; can use wildcards. Also can likely be factored in with get test paths?
;;
;; Run this remotely!!
;;
(define (db:get-matching-previous-test-run-records dbstruct run-id test-name item-path)
(let* ((dbdat (db:get-db dbstruct #f))
(db (db:dbdat-get-db dbdat))
(keys (db:get-keys db))
(selstr (string-intersperse keys ","))
(qrystr (string-intersperse (map (lambda (x)(conc x "=?")) keys) " AND "))
(keyvals #f)
(tests-hash (make-hash-table)))
;; first look up the key values from the run selected by run-id
;; (db:delay-if-busy dbdat)
(sqlite3:for-each-row
|
|
|
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
|
;; can use wildcards. Also can likely be factored in with get test paths?
;;
;; Run this remotely!!
;;
(define (db:get-matching-previous-test-run-records dbstruct run-id test-name item-path)
(let* ((dbdat (db:get-db dbstruct #f))
(db (db:dbdat-get-db dbdat))
(keys (db:get-keys dbstruct))
(selstr (string-intersperse keys ","))
(qrystr (string-intersperse (map (lambda (x)(conc x "=?")) keys) " AND "))
(keyvals #f)
(tests-hash (make-hash-table)))
;; first look up the key values from the run selected by run-id
;; (db:delay-if-busy dbdat)
(sqlite3:for-each-row
|
︙ | | | ︙ | |