Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -135,10 +135,11 @@ (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 (sqlite3:open-database dbpath)) + (olddb (db:open-megatest-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 (if write-access @@ -154,10 +155,11 @@ )) ;; add strings db to rundb, not in use yet (sqlite3:set-busy-handler! db handler) (sqlite3:execute db "PRAGMA synchronous = 1;"))) ;; was 0 but 0 is a gamble (dbr:dbstruct-set-rundb! dbstruct db) (dbr:dbstruct-set-inuse! dbstruct #t) + (dbr:dbstruct-set-olddb! dbstruct olddb) (if local (begin (dbr:dbstruct-set-localdb! dbstruct run-id db) ;; (dbr:dbstruct-set-inmem! dbstruct db) ;; direct access ... db) (begin @@ -179,10 +181,11 @@ ;; (if (not (directory-exists? dbdir)) ;; (create-direcory dbdir)) ;; (conc *toppath* "/db/main.db"))) (dbexists (file-exists? dbpath)) (db (sqlite3:open-database dbpath)) + (olddb (db:open-megatest-db)) (write-access (file-write-access? dbpath)) (handler (make-busy-timeout 136000))) (if (and dbexists (not write-access)) (set! *db-write-access* #f)) (if write-access @@ -190,18 +193,20 @@ (sqlite3:set-busy-handler! db handler) (sqlite3:execute db "PRAGMA synchronous = 0;"))) (if (not dbexists) (db:initialize-main-db db)) (dbr:dbstruct-set-main! dbstruct db) + (dbr:dbstruct-set-olddb! dbstruct olddb) db)))) ;; 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")) (dbstruct (make-dbr:dbstruct path: dbdir local: local))) - (db:get-db dbstruct #f) ;; force one call to main + ;; isn't this a hold-over from the multi-db in one process? Commenting it out for now .... + ;; (db:get-db dbstruct #f) ;; force one call to main dbstruct)) ;; Open the classic megatest.db file in toppath ;; (define (db:open-megatest-db) @@ -220,41 +225,24 @@ (begin (db:initialize-main-db db) (db:initialize-run-id-db db))) db)) -;; sync all touched runs to disk -;; -(define (db:sync-touched dbstruct #!key (force-sync #f)) - (let ((tot-synced 0)) - (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))) - (refdb (vector-ref runvec (dbr:dbstruct-field-name->num 'refdb)))) - (if (or (> mtime stime) force-sync) - (let ((num-synced (db:sync-tables db:sync-tests-only inmem refdb rundb))) - (set! tot-synced (+ tot-synced num-synced)) - (vector-set! runvec (dbr:dbstruct-field-name->num 'stime) (current-milliseconds)))))) - (hash-table-values (vector-ref dbstruct 1))) - tot-synced)) - ;; sync run to disk if touched ;; (define (db:sync-touched dbstruct #!key (force-sync #f)) (let ((mtime (dbr:dbstruct-get-mtime dbstruct)) (stime (dbr:dbstruct-get-stime dbstruct)) (rundb (dbr:dbstruct-get-rundb dbstruct)) (inmem (dbr:dbstruct-get-inmem dbstruct)) - (refdb (dbr:dbstruct-get-refdb dbstruct))) + (refdb (dbr:dbstruct-get-refdb dbstruct)) + (olddb (dbr:dbstruct-get-olddb dbstruct))) (if (or (not (number? mtime)) (not (number? stime)) (> mtime stime) force-sync) - (let ((num-synced (db:sync-tables db:sync-tests-only inmem refdb rundb))) + (let ((num-synced (db:sync-tables db:sync-tests-only inmem refdb rundb olddb))) (dbr:dbstruct-set-stime! dbstruct (current-milliseconds)) num-synced) 0))) ;; close all opened run-id dbs @@ -1038,10 +1026,11 @@ ;; ;; ( (runname (( state count ) ... )) ;; ( ... (define (db:get-run-stats dbstruct) (let ((totals (make-hash-table)) + (curr (make-hash-table)) (res '()) (runs-info '())) ;; First get all the runname/run-ids (sqlite3:for-each-row (lambda (run-id runname) @@ -1049,26 +1038,31 @@ (db:get-db dbstruct #f) "SELECT id,runname FROM runs WHERE state != 'deleted';") ;; for each run get stats data (for-each (lambda (run-info) + ;; get the net state/status counts for this run (let ((run-id (car run-info)) (run-name (cadr run-info))) (sqlite3:for-each-row - (lambda (state count) - (if (string? state) - (let* ((stateparts (string-split state "|")) - (newstate (conc (car stateparts) "\n" (cadr stateparts)))) - (hash-table-set! totals newstate (+ (hash-table-ref/default totals newstate 0) count)) - (set! res (cons (list run-name newstate count) res))))) + (lambda (state status count) + (let ((netstate (if (equal? state "COMPLETED") status state))) + (if (string? netstate) + (begin + (hash-table-set! totals netstate (+ (hash-table-ref/default totals netstate 0) count)) + (hash-table-set! curr netstate (+ (hash-table-ref/default curr netstate 0) count)))))) (db:get-db dbstruct run-id) - "SELECT state||'|'||status AS s,count(id) FROM tests AS t ORDER BY s DESC;" ) - ;; (set! res (reverse res)) + "SELECT state,status,count(id) FROM tests AS t GROUP BY state,status ORDER BY state,status DESC;") + ;; add the per run counts to res + (for-each (lambda (state) + (set! res (cons (list run-name state (hash-table-ref curr state)) res))) + (sort (hash-table-keys curr) string>=)) + (set! curr (make-hash-table)))) + runs-info) (for-each (lambda (state) (set! res (cons (list "Totals" state (hash-table-ref totals state)) res))) - (sort (hash-table-keys totals) string>=)))) - runs-info) + (sort (hash-table-keys totals) string>=)) res)) ;; db:get-runs-by-patt ;; get runs by list of criteria ;; register a test run with the db Index: db_records.scm ================================================================== --- db_records.scm +++ db_records.scm @@ -25,10 +25,12 @@ (define-inline (dbr:dbstruct-get-rtime vec) (vector-ref vec 7)) (define-inline (dbr:dbstruct-get-stime vec) (vector-ref vec 8)) (define-inline (dbr:dbstruct-get-inuse vec) (vector-ref vec 9)) (define-inline (dbr:dbstruct-get-refdb vec) (vector-ref vec 10)) (define-inline (dbr:dbstruct-get-locdbs vec) (vector-ref vec 11)) +(define-inline (dbr:dbstruct-get-olddb vec) (vector-ref vec 12)) +(define-inline (dbr:dbstruct-get-run-id vec) (vector-ref vec 13)) (define-inline (dbr:dbstruct-set-main! vec val)(vector-set! vec 0 val)) (define-inline (dbr:dbstruct-set-strdb! vec val)(vector-set! vec 1 val)) (define-inline (dbr:dbstruct-set-path! vec val)(vector-set! vec 2 val)) (define-inline (dbr:dbstruct-set-local! vec val)(vector-set! vec 3 val)) @@ -38,15 +40,17 @@ (define-inline (dbr:dbstruct-set-rtime! vec val)(vector-set! vec 7 val)) (define-inline (dbr:dbstruct-set-stime! vec val)(vector-set! vec 8 val)) (define-inline (dbr:dbstruct-set-inuse! vec val)(vector-set! vec 9 val)) (define-inline (dbr:dbstruct-set-refdb! vec val)(vector-set! vec 10 val)) (define-inline (dbr:dbstruct-set-locdbs! vec val)(vector-set! vec 11 val)) +(define-inline (dbr:dbstruct-set-olddb! vec val)(vector-set! vec 12 val)) +(define-inline (dbr:dbstruct-set-run-id! vec val)(vector-set! vec 13 val)) ;; constructor for dbstruct ;; (define (make-dbr:dbstruct #!key (path #f)(local #f)) - (let ((v (make-vector 12 #f))) + (let ((v (make-vector 14 #f))) (dbr:dbstruct-set-path! v path) (dbr:dbstruct-set-local! v local) (dbr:dbstruct-set-locdbs! v (make-hash-table)) v)) @@ -54,67 +58,10 @@ (hash-table-ref/default (dbr:dbstruct-get-locdbs v) run-id #f)) (define (dbr:dbstruct-set-localdb! v run-id db) (hash-table-set! (dbr:dbstruct-get-locdbs v) run-id db)) -;; ;; get and set main db -;; (define-inline (dbr:dbstruct-get-main vec) (vector-ref vec 0)) -;; (define-inline (dbr:dbstruct-set-main! vec db)(vector-set! vec 0 db)) -;; ;; get the runs hash -;; (define-inline (dbr:dbstruct-get-dbhash vec) (vector-ref vec 1)) -;; ;; the string db -;; (define-inline (dbr:dbstruct-get-strdb vec) (vector-ref vec 2)) -;; (define-inline (dbr:dbstruct-set-strdb! vec db)(vector-set! vec 2 db)) -;; ;; path -;; (define-inline (dbr:dbstruct-get-path vec) (vector-ref vec 3)) -;; (define-inline (dbr:dbstruct-set-path! vec path)(vector-set! vec 3)) -;; ;; local -;; (define-inline (dbr:dbstruct-get-local vec) (vector-ref vec 4)) -;; (define-inline (dbr:dbstruct-set-local! vec val)(vector-set! vec 4 val)) -;; -;; ;; get a rundb vector, create it if not already existing -;; (define (dbr:dbstruct-get-rundb-rec vec run-id) -;; (let* ((dbhash (dbr:dbstruct-get-dbhash vec)) ;; get the runs hash -;; (runvec (hash-table-ref/default dbhash run-id #f))) ;; get the vector for run-id -;; (if (vector? runvec) -;; runvec ;; rundb inmemdb last-mod last-read last-sync in-use refdb -;; (let ((nvec (vector #f #f -1 -1 -1 #f #f))) -;; (hash-table-set! dbhash run-id nvec) -;; nvec)))) -;; -;; ;; [ rundb inmemdb last-mod last-read last-sync ] -;; (define-inline (dbr:dbstruct-field-name->num field-name) -;; (case field-name -;; ((rundb) 0) ;; the on-disk db -;; ((inmem) 1) ;; the in-memory db -;; ((mtime) 2) ;; last modification time -;; ((rtime) 3) ;; last read time -;; ((stime) 4) ;; last sync time -;; ((inuse) 5) ;; is the db currently in use, #t yes, #f no. -;; ((refdb) 6) ;; the db used for reference (can be on disk or inmem) -;; (else -1))) -;; -;; ;; get/set rundb fields -;; (define (dbr:dbstruct-get-runvec-val vec run-id field-name) -;; (let ((runvec (dbr:dbstruct-get-rundb-rec vec run-id)) -;; (fieldnum (dbr:dbstruct-field-name->num field-name))) -;; ;; (vector-set! runvec (dbr:dbstruct-field-name->num 'inuse) #t) -;; (vector-ref runvec fieldnum))) -;; -;; (define (dbr:dbstruct-set-runvec-val! vec run-id field-name val) -;; (let ((runvec (dbr:dbstruct-get-rundb-rec vec run-id))) -;; (vector-set! runvec (dbr:dbstruct-field-name->num field-name) val))) -;; -;; ;; get/set inmemdb -;; (define (dbr:dbstruct-get-inmemdb vec run-id) -;; (let ((runvec (dbr:dbstruct-get-rundb-rec vec run-id))) -;; (vector-ref runvec 1))) -;; -;; (define (dbr:dbstruct-set-inmemdb! vec run-id inmemdb) -;; (let ((runvec (dbr:dbstruct-get-rundb-rec vec run-id))) -;; (vector-set! runvec 1 inmemdb))) - (define (make-db:test)(make-vector 20)) (define-inline (db:test-get-id vec) (vector-ref vec 0)) (define-inline (db:test-get-run_id vec) (vector-ref vec 1)) (define-inline (db:test-get-testname vec) (vector-ref vec 2))