Index: Makefile ================================================================== --- Makefile +++ Makefile @@ -36,10 +36,13 @@ all : $(PREFIX)/bin/.$(ARCHSTR) mtest dboard mtut tcmt transport-mode.scm : transport-mode.scm.template cp transport-mode.scm.template transport-mode.scm +dashboard-mode.scm : transport-mode.scm.template + cp transport-mode.scm.template transport-mode.scm + megatest.scm : transport-mode.scm # dbmod.import.o is just a hack here mofiles/dbfile.o : mofiles/debugprint.o mofiles/commonmod.o dbmod.import.o db.o : dbmod.import.o Index: TODO ================================================================== --- TODO +++ TODO @@ -16,10 +16,13 @@ # along with Megatest. If not, see . TODO ==== +23WW07 +. Remove use of *dbstruct-dbs* + WW15 . fill newview matrix with data, filter pipeline gui elements . improve [script], especially indent handling WW16 Index: dashboard-tests.scm ================================================================== --- dashboard-tests.scm +++ dashboard-tests.scm @@ -459,12 +459,11 @@ ;;====================================================================== ;; ;;====================================================================== (define (dashboard-tests:examine-test run-id test-id) ;; run-id run-key origtest) (let* ((db-path (db:dbfile-path)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/db/" run-id ".db")) - (dbstruct #f) ;; NOT ACTUALLY USED (db:setup)) ;; (make-dbr:dbstruct path: (db:dbfile-path #f) ;; (configf:lookup *configdat* "setup" "linktree") - ;; local: #t)) + (dbstruct #f) ;; NOT USED (testdat (rmt:get-test-info-by-id run-id test-id)) ;; (db:get-test-info-by-id dbstruct run-id test-id)) (db-mod-time 0) ;; (file-modification-time db-path)) (last-update 0) ;; (current-seconds)) (request-update #t)) (if (not testdat) Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -78,11 +78,13 @@ (define (db:with-db dbstruct run-id r/w proc . params) (case (rmt:transport-mode) ((http)(dbfile:with-db dbstruct run-id r/w proc params)) - ((tcp) (dbmod:with-db dbstruct run-id r/w proc params)))) + ((tcp) (dbmod:with-db dbstruct run-id r/w proc params)) + ((nfs) (dbmod:with-db dbstruct run-id r/w proc params)) + (else (assert #f "FATAL: db:with-db called with non-existant transport mode")))) ;;====================================================================== ;; hash of hashs ;;====================================================================== Index: dbfile.scm ================================================================== --- dbfile.scm +++ dbfile.scm @@ -169,39 +169,10 @@ ) #f ) ) -;; ;; set up a single db (e.g. main.db, 1.db ... etc.) -;; ;; -;; (define (db:setup-db dbstruct areapath run-id) -;; (let* ((dbname (db:run-id->dbname run-id)) -;; (dbstruct (hash-table-ref/default dbstructs dbname #f))) -;; (if dbstruct -;; dbstruct -;; (let* ((dbstruct-new (make-dbr:dbstruct))) -;; (db:open-db dbstruct-new run-id areapath: areapath do-sync: #t) -;; (hash-table-set! dbstructs dbname dbstruct-new) -;; dbstruct-new)))) - -;; ; Returns the dbdat for a particular dbfile inside the area -;; ;; -;; (define (dbr:dbstruct-get-dbdat dbstruct dbfile) -;; (hash-table-ref/default (dbr:dbstruct-dbdats dbstruct) dbfile #f)) -;; -;; (define (dbr:dbstruct-dbdat-put! dbstruct dbfile db) -;; (hash-table-set! (dbr:dbstruct-dbdats dbstruct) dbfile db)) -;; -;; (define (db:run-id->first-num run-id) -;; (let* ((s (number->string run-id)) -;; (l (string-length s))) -;; (substring s (- l 1) l))) - -;; 1234 => 4/1234.db -;; #f => 0/main.db -;; (abandoned the idea of num/db) -;; (define (dbfile:run-id->path apath run-id) (conc apath"/"(dbfile:run-id->dbname run-id))) (define (db:dbname->path apath dbname) (conc apath"/"dbname)) @@ -225,14 +196,12 @@ (cond (*dbstruct-dbs* (dbfile:print-err "WARNING: dbfile:setup called when *dbstruct-dbs* is already initialized") *dbstruct-dbs*) ;; TODO: when multiple areas are supported, this optimization will be a hazard (else - (let* ((dbstruct (make-dbr:dbstruct))) + (let* ((dbstruct (make-dbr:dbstruct areapath: areapath tmppath: tmppath))) (set! *dbstruct-dbs* dbstruct) - (dbr:dbstruct-areapath-set! dbstruct areapath) - (dbr:dbstruct-tmppath-set! dbstruct tmppath) dbstruct)))) (define (dbfile:get-subdb dbstruct run-id) (let* ((dbfname (dbfile:run-id->dbname run-id))) (hash-table-ref/default (dbr:dbstruct-subdbs dbstruct) dbfname #f))) Index: dbmod.scm ================================================================== --- dbmod.scm +++ dbmod.scm @@ -60,10 +60,11 @@ ;;====================================================================== (define *dbmod:nfs-db-handles* (make-hash-table)) ;; dbfname -> dbstruct (define (dbmod:nfs-get-dbstruct run-id keys init-proc areapath) + (assert areapath "FATAL: dbmod:nfs-get-dbstruct called without areapath set.") (let* ((dbfname (dbmod:run-id->dbfname run-id)) (dbstruct (hash-table-ref/default *dbmod:nfs-db-handles* dbfname #f))) (if dbstruct (let* ((last-update (dbr:dbstruct-last-update dbstruct)) (curr-secs (current-seconds))) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -1395,12 +1395,11 @@ ;; IDEA: megatest list -runname blah% ... ;; (if (or (args:get-arg "-list-runs") (args:get-arg "-list-db-targets")) (if (launch:setup) - (let* (;; (dbstruct (make-dbr:dbstruct path: *toppath* local: (args:get-arg "-local"))) - (runpatt (args:get-arg "-list-runs")) + (let* ((runpatt (args:get-arg "-list-runs")) (access-mode (db:get-access-mode)) (testpatt (common:args-get-testpatt #f)) ;; (if (args:get-arg "-testpatt") ;; (args:get-arg "-testpatt") ;; "%")) @@ -2066,11 +2065,11 @@ (if (args:get-arg "-extract-ods") (general-run-call "-extract-ods" "Make ods spreadsheet" (lambda (target runname keys keyvals) - (let ((dbstruct (make-dbr:dbstruct path: *toppath* local: #t)) + (let ((dbstruct (make-dbr:dbstruct areapath: *toppath* local: #t)) (outputfile (args:get-arg "-extract-ods")) (runspatt (or (args:get-arg "-runname")(args:get-arg ":runname"))) (pathmod (args:get-arg "-pathmod"))) ;; (keyvalalist (keys->alist keys "%"))) (debug:print 2 *default-log-port* "Extract ods, outputfile: " outputfile " runspatt: " runspatt " keyvals: " keyvals) Index: rmt.scm ================================================================== --- rmt.scm +++ rmt.scm @@ -90,11 +90,11 @@ (define *send-receive-mutex* (make-mutex)) ;; should have separate mutex per run-id ;; RA => e.g. usage (rmt:send-receive 'get-var #f (list varname)) ;; (define (rmt:send-receive cmd rid params #!key (attemptnum 1)(area-dat #f)) ;; start attemptnum at 1 so the modulo below works as expected - + (assert *toppath* "FATAL: rmt:send-receive called with *toppath* not set.") (if (> attemptnum 2) (debug:print 0 *default-log-port* "INFO: attemptnum in rmt:send-receive is " attemptnum)) (cond ((> attemptnum 2) (thread-sleep! 0.05)) @@ -348,11 +348,11 @@ res)) (define (rmt:open-qry-close-locally cmd run-id params #!key (remretries 5)) (let* ((qry-is-write (not (member cmd api:read-only-queries))) (db-file-path (db:dbfile-path)) ;; 0)) - (dbstructs-local (db:setup #t)) ;; make-dbr:dbstruct path: dbdir local: #t))) + (dbstructs-local (db:setup #t)) (read-only (not (file-write-access? db-file-path))) (start (current-milliseconds)) (resdat (if (not (and read-only qry-is-write)) (let ((v (api:execute-requests dbstructs-local (vector (symbol->string cmd) params)))) ;; (handle-exceptions ;; there has been a long history of receiving strange errors from values returned by the client when things go wrong..