Index: Makefile ================================================================== --- Makefile +++ Makefile @@ -388,11 +388,11 @@ $(PREFIX)/share/docs/megatest_manual.html $(PREFIX)/bin/remrun $(PREFIX)/bin/mtutil \ $(PREFIX)/share/db/mt-pg.sql \ $(PREFIX)/share/js/jquery-3.1.0.slim.min.js \ $(PREFIX)/bin/.$(ARCHSTR)/lib/libpangox-1.0.so \ $(PREFIX)/bin/.$(ARCHSTR)/lib/libpangox-1.0.so.0 \ - $(PREFIX)/bin/.$(ARCHSTR)/lib/libxcb-xlib.so.0 + $(PREFIX)/bin/.$(ARCHSTR)/lib/libxcb-xlib.so.0 $(PREFIX)/bin/serialize-env # $(PREFIX)/bin/.$(ARCHSTR)/ndboard $(PREFIX)/bin/tcmt # $(PREFIX)/bin/.$(ARCHSTR)/mtexec $(PREFIX)/bin/mtexec $(PREFIX)/bin/serialize-env \ # $(PREFIX)/bin/newdashboard Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -711,13 +711,23 @@ ;; exn ;; (begin ;; (debug:print 0 "ERROR: Failed to create tables. Look at your [fields] section, should be: fieldname TEXT DEFAULT 'yourdefault'") ;; (exit)) (sqlite3:execute db "CREATE TABLE IF NOT EXISTS keys (id INTEGER PRIMARY KEY, fieldname TEXT, fieldtype TEXT, CONSTRAINT keyconstraint UNIQUE (fieldname));") - (for-each (lambda (key) - (sqlite3:execute db "INSERT OR REPLACE INTO keys (fieldname,fieldtype) VALUES (?,?);" key "TEXT")) - keys) + (for-each + (lambda (key) + (let* ((fieldname #f) + (fieldtype #f)) + (sqlite3:for-each-row + (lambda (fn ft) + (set! fieldname fn) + (set! fieldtype ft)) + db + "SELECT fieldname,fieldtype FROM keys WHERE fieldname=?" key) + (if (not fieldname) + (sqlite3:execute db "INSERT INTO keys (fieldname,fieldtype) VALUES (?,?);" key "TEXT")))) + keys) (sqlite3:execute db (conc "CREATE TABLE IF NOT EXISTS runs (id INTEGER PRIMARY KEY, \n " fieldstr (if havekeys "," "") " runname TEXT DEFAULT 'norun', contour TEXT DEFAULT '', @@ -808,11 +818,21 @@ (sqlite3:execute db "CREATE TABLE IF NOT EXISTS metadat (id INTEGER PRIMARY KEY, var TEXT, val TEXT, CONSTRAINT metadat_constraint UNIQUE (var));") (sqlite3:execute db "CREATE TABLE IF NOT EXISTS access_log (id INTEGER PRIMARY KEY, user TEXT, accessed TIMESTAMP, args TEXT);") ;; Must do this *after* running patch db !! No more. ;; cannot use db:set-var since it will deadlock, hardwire the code here - (sqlite3:execute db "INSERT OR REPLACE INTO metadat (var,val) VALUES (?,?);" "MEGATEST_VERSION" (common:version-signature)) + (let* ((prev-version #f) + (curr-version (common:version-signature))) + (sqlite3:for-each-row + (lambda (ver) + (set! prev-version ver)) + db + "SELECT val FROM metadat WHERE var='MEGATEST_VERSION';") + (if prev-version + (if (not (equal? prev-version curr-version)) + (sqlite3:execute db "UPDATE metadat SET val=? WHERE var=?;" curr-version "MEGATEST_VERSION")) + (sqlite3:execute db "INSERT OR REPLACE INTO metadat (var,val) VALUES (?,?);" "MEGATEST_VERSION" curr-version) )) (debug:print-info 11 *default-log-port* "db:initialize END") ;; )))) ;;====================================================================== ;; R U N S P E C I F I C D B ;;====================================================================== Index: dbmod.scm ================================================================== --- dbmod.scm +++ dbmod.scm @@ -103,11 +103,10 @@ (begin (sync-proc last-update) ;; MOVE THIS CALL TO INSIDE THE sync-proc CALL (dbr:dbstruct-last-update-set! dbstruct curr-secs) - ))) (assert (sqlite3:database? dbh) "FATAL: bad db handle in dbmod:with-db") (if use-mutex (mutex-lock! *db-with-db-mutex*)) (let* ((res (apply proc dbdat dbh params))) (if use-mutex (mutex-unlock! *db-with-db-mutex*)) @@ -295,10 +294,11 @@ ;; IFF field-name exists ;; ;; Use (db:sync-all-tables-list keys) to get the tbls input ;; (define (dbmod:sync-tables tbls last-update keys fromdb todb) + (debug:print-info 0 *default-log-port* "dbmod:sync-tables called, from: "fromdb", to: "todb) (assert (sqlite3:database? fromdb) "FATAL: dbmod:sync-tables called with fromdb not a database" fromdb) (assert (sqlite3:database? todb) "FATAL: dbmod:sync-tables called with fromdb not a database" todb) (let ((specials `(("keys" "fieldname") ("metadat" "var") ,(cons "runs" (cons "runname" keys)) @@ -430,11 +430,11 @@ (qry-proc)) (qry-proc)) (set! num-updates (+ num-updates 1)))))) fields-sans-lu) (let ((row (get-row from-db from-id))) ;; need to insert the row - ;; (debug:print 0 *default-log-port* "row="row) + (debug:print 0 *default-log-port* "from-id="from-id", to-ids="to-ids", row="row) (set! num-inserts (+ num-inserts 1)) (ins-row to-db from-id row)))) from-ids))))) (+ num-inserts num-updates)))