Index: Makefile ================================================================== --- Makefile +++ Makefile @@ -60,10 +60,14 @@ $(PREFIX)/share/docs/megatest_manual.html : docs/manual/megatest_manual.html mkdir -p $(PREFIX)/share/docs $(INSTALL) docs/manual/megatest_manual.html $(PREFIX)/share/docs/megatest_manual.html for png in $(PNGFILES);do $(INSTALL) docs/manual/$$png $(PREFIX)/share/docs/$$png;done +$(PREFIX)/share/db/mt-pg.sql : mt-pg.sql + mkdir -p $(PREFIX)/share/db + $(INSTALL) mt-pg.sql $(PREFIX)/share/db/mt-pg.sql + #multi-dboard : multi-dboard.scm $(OFILES) $(GOFILES) # csc $(CSCOPTS) $(OFILES) $(GOFILES) multi-dboard.scm -o multi-dboard # # $(PREFIX)/bin/revtagfsl : utils/revtagfsl.scm @@ -188,11 +192,12 @@ $(INSTALL) dboard $(PREFIX)/bin/.$(ARCHSTR)/dboard install : $(PREFIX)/bin/.$(ARCHSTR) $(PREFIX)/bin/.$(ARCHSTR)/mtest $(PREFIX)/bin/megatest \ $(PREFIX)/bin/.$(ARCHSTR)/dboard $(PREFIX)/bin/dashboard $(HELPERS) $(PREFIX)/bin/nbfake \ $(PREFIX)/bin/nbfind $(PREFIX)/bin/loadrunner $(PREFIX)/bin/viewscreen $(PREFIX)/bin/mt_xterm \ - $(PREFIX)/share/docs/megatest_manual.html $(PREFIX)/bin/remrun $(PREFIX)/bin/mtutil + $(PREFIX)/share/docs/megatest_manual.html $(PREFIX)/bin/remrun $(PREFIX)/bin/mtutil \ + $(PREFIX)/share/db/mt-pg.sql $(PREFIX)/bin/.$(ARCHSTR) : mkdir -p $(PREFIX)/bin/.$(ARCHSTR) mkdir -p $(PREFIX)/bin/.$(ARCHSTR)/lib Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -14,13 +14,16 @@ ;;====================================================================== ;; dbstruct vector containing all the relevant dbs like main.db, megatest.db, run.db etc (use (srfi 18) extras tcp stack) -(use sqlite3 srfi-1 posix regex regex-case srfi-69 csv-xml s11n md5 message-digest base64 format dot-locking z3 typed-records matchable) +(use sqlite3 srfi-1 posix regex regex-case srfi-69 csv-xml s11n md5 message-digest base64 format dot-locking z3 typed-records sql-null matchable) (import (prefix sqlite3 sqlite3:)) (import (prefix base64 base64:)) +;; (include "/nfs/site/disks/icf_fdk_cw_gwa002/srehman/fossil/dbi/dbi.scm") +;; (import (prefix dbi dbi:)) +(use (prefix dbi dbi:)) (declare (unit db)) (declare (uses common)) (declare (uses keys)) (declare (uses ods)) @@ -46,10 +49,11 @@ (defstruct dbr:dbstruct ;; (tmpdb #f) (dbstack #f) ;; stack for tmp db handles, do not initialize with a stack (mtdb #f) (refndb #f) + (slave-dbs '()) (homehost #f) ;; not used yet (on-homehost #f) ;; not used yet ) ;; goal is to converge on one struct for an area but for now it is too confusing @@ -280,16 +284,49 @@ (dbfexists (file-exists? (conc dbpath "/megatest.db"))) (tmpdb (db:open-megatest-db path: dbpath)) ;; lock-create-open dbpath db:initialize-main-db)) (mtdb (db:open-megatest-db)) (refndb (db:open-megatest-db path: dbpath name: "megatest_ref.db")) (write-access (file-write-access? dbpath))) + + (if (args:get-arg "-server") + (if (configf:get-section *configdat* "ext-sync") + (let* ((dblist (configf:get-section *configdat* "ext-sync")) + (res '()) + (cfgdb #f)) + (for-each (lambda (dbitem) + (let* ((stringsplit (string-split (cadr dbitem))) + (dbtype (string->symbol (car stringsplit))) + (dbpath (cadr stringsplit))) + (case dbtype + ((sqlite3) + (set! cfgdb (dbi:open dbtype (cons (cons 'dbname dbpath) '()) )) + (db:initialize-main-db (dbi:db-conn cfgdb)) + (db:initialize-run-id-db (dbi:db-conn cfgdb)) + (set! res (cons (cons cfgdb dbpath) res))) + ((pg) + (let* ((dbinfo '())) + (for-each + (lambda (x) + (if (not (eqv? (string->symbol x) dbtype)) + (let* ((pair (string-split x ":"))) + (if (not (eqv? pair '())) + (set! dbinfo (cons (cons (string->symbol (car pair)) (cadr pair)) dbinfo)))))) + stringsplit) + (set! cfgdb (dbi:open dbtype dbinfo)) + (set! res (cons (cons cfgdb (alist-ref 'host dbinfo)) res)) + ))))) + dblist) + (dbr:dbstruct-slave-dbs-set! dbstruct res) + ))) + (if (and dbexists (not write-access)) (set! *db-write-access* #f)) (dbr:dbstruct-mtdb-set! dbstruct mtdb) (dbr:dbstruct-dbstack-set! dbstruct (make-stack)) (stack-push! (dbr:dbstruct-dbstack dbstruct) tmpdb) ;; olddb is already a (cons db path) (dbr:dbstruct-refndb-set! dbstruct refndb) + ;; (mutex-unlock! *rundb-mutex*) (if (and (not dbfexists) write-access) ;; *db-write-access*) ;; did not have a prior db and do have write access (begin (debug:print 0 *default-log-port* "filling db " (db:dbdat-get-path tmpdb) " with data from " (db:dbdat-get-path mtdb)) @@ -378,79 +415,97 @@ (list ;; (list "strs" ;; '("id" #f) ;; '("str" #f)) (list "tests" - '("id" #f) - '("run_id" #f) - '("testname" #f) - '("host" #f) - '("cpuload" #f) - '("diskfree" #f) - '("uname" #f) - '("rundir" #f) - '("shortdir" #f) - '("item_path" #f) - '("state" #f) - '("status" #f) - '("attemptnum" #f) - '("final_logf" #f) - '("logdat" #f) - '("run_duration" #f) - '("comment" #f) - '("event_time" #f) - '("fail_count" #f) - '("pass_count" #f) - '("archived" #f)) + '("id" "INTEGER" 'key) + '("run_id" "INTEGER") + '("testname" "TEXT") + '("host" "TEXT") + '("cpuload" "REAL") + '("diskfree" "INTEGER") + '("uname" "TEXT") + '("rundir" "TEXT") + '("shortdir" "TEXT") + '("item_path" "TEXT") + '("state" "TEXT") + '("status" "TEXT") + '("attemptnum" "INTEGER") + '("final_logf" "TEXT") + '("logdat" "TEXT") + '("run_duration" "INTEGER") + '("comment" "TEXT") + '("event_time" "INTEGER") + '("fail_count" "INTEGER") + '("pass_count" "INTEGER") + '("archived" "INTEGER")) (list "test_steps" - '("id" #f) - '("test_id" #f) - '("stepname" #f) - '("state" #f) - '("status" #f) - '("event_time" #f) - '("comment" #f) - '("logfile" #f)) + '("id" "INTEGER" 'key) + '("test_id" "INTEGER") + '("stepname" "TEXT") + '("state" "TEXT") + '("status" "TEXT") + '("event_time" "INTEGER") + '("comment" "TEXT") + '("logfile" "TEXT")) (list "test_data" - '("id" #f) - '("test_id" #f) - '("category" #f) - '("variable" #f) - '("value" #f) - '("expected" #f) - '("tol" #f) - '("units" #f) - '("comment" #f) - '("status" #f) - '("type" #f)))) + '("id" "INTEGER" 'key) + '("test_id" "INTEGER") + '("category" "TEXT") + '("variable" "TEXT") + '("value" "REAL") + '("expected" "REAL") + '("tol" "REAL") + '("units" "TEXT") + '("comment" "TEXT") + '("status" "TEXT") + '("type" "TEXT")))) ;; needs db to get keys, this is for syncing all tables ;; (define (db:sync-main-list dbstruct) (let ((keys (db:get-keys dbstruct))) (list (list "keys" - '("id" #f) - '("fieldname" #f) - '("fieldtype" #f)) - (list "metadat" '("var" #f) '("val" #f)) - (append (list "runs" - '("id" #f)) - (map (lambda (k)(list k #f)) - (append keys - (list "runname" "state" "status" "owner" "event_time" "comment" "fail_count" "pass_count" "contour")))) + '("id" "INTEGER" 'key) + '("fieldname" "TEXT") + '("fieldtype" "TEXT")) + (list "metadat" + '("id" "INTEGER" 'key) + '("var" "TEXT") + '("val" "TEXT")) + (append + (list "runs" + '("id" "INTEGER" 'key)) + (map (lambda (key) + (list key "TEXT")) + keys) + (list + ;; '("release" "TEXT") + ;; '("iteration" "TEXT") + ;; '("testsuite_mode" "TEXT") + '("runname" "TEXT") + '("state" "TEXT") + '("status" "TEXT") + '("owner" "TEXT") + '("event_time" "INTEGER") + '("comment" "TEXT") + '("fail_count" "INTEGER") + '("pass_count" "INTEGER"))) + (list "test_meta" - '("id" #f) - '("testname" #f) - '("owner" #f) - '("description" #f) - '("reviewed" #f) - '("iterated" #f) - '("avg_runtime" #f) - '("avg_disk" #f) - '("tags" #f) - '("jobgroup" #f))))) + '("id" "INTEGER" 'key) + '("testname" "TEXT") + '("author" "TEXT") + '("owner" "TEXT") + '("description" "TEXT") + '("reviewed" "TEXT") + '("iterated" "TEXT") + '("avg_runtime" "REAL") + '("avg_disk" "REAL") + '("tags" "TEXT") + '("jobgroup" "TEXT"))))) (define (db:sync-all-tables-list dbstruct) (append (db:sync-main-list dbstruct) db:sync-tests-only)) @@ -481,10 +536,12 @@ (let* ((dbpath (db:dbdat-get-path dbdat)) (dbdir (pathname-directory dbpath)) (fname (pathname-strip-directory dbpath))) (debug:print-info 0 *default-log-port* "Checking db " dbpath " for errors.") (cond + ((eqv? (dbi:db-dbtype (db:dbdat-get-db dbdat)) 'pg) + #t) ((not (file-write-access? dbdir)) (debug:print 0 *default-log-port* "WARNING: can't write to " dbdir ", can't fix " fname) #f) ;; handle special cases, megatest.db and monitor.db @@ -510,11 +567,11 @@ "megatest -import-megatest.db;megatest -cleanup-db") "\"\n") (exit) ;; we can not safely continue when a db was corrupted - even if fixed. ) ;; test read/write access to the database - (let ((db (sqlite3:open-database dbpath))) + (let ((db (dbi:open 'sqlite3 (cons (cons ('dbname dbpath) '()))))) (cond ((equal? fname "megatest.db") (sqlite3:execute db "DELETE FROM tests WHERE state='DELETED';")) ((equal? fname "main.db") (sqlite3:execute db "DELETE FROM runs WHERE state='deleted';")) @@ -523,11 +580,11 @@ ((equal? fname "monitor.db") (sqlite3:execute "DELETE FROM servers WHERE state LIKE 'defunct%';")) (else (sqlite3:execute db "vacuum;"))) - (finalize! db) + (sqlite3:finalize! db) #t)))))) ;; tbls is ( ("tablename" ( "field1" [#f|proc1] ) ( "field2" [#f|proc2] ) .... ) ) ;; db's are dbdat's ;; @@ -534,10 +591,13 @@ ;; if last-update specified ("field-name" . time-in-seconds) ;; then sync only records where field-name >= time-in-seconds ;; IFF field-name exists ;; (define (db:sync-tables tbls last-update fromdb todb . slave-dbs) + (set! todb (cons (dbi:convert (db:dbdat-get-db todb)) (db:dbdat-get-path todb))) + (set! fromdb (cons (dbi:convert (db:dbdat-get-db fromdb)) (db:dbdat-get-path fromdb))) + (handle-exceptions exn (begin (debug:print 0 *default-log-port* "EXCEPTION: database probably overloaded or unreadable in db:sync-tables.") (print-call-chain (current-error-port)) @@ -546,11 +606,11 @@ (debug:print 0 *default-log-port* " status: " ((condition-property-accessor 'sqlite3 'status) exn)) (debug:print 0 *default-log-port* " src db: " (db:dbdat-get-path fromdb)) (for-each (lambda (dbdat) (let ((dbpath (db:dbdat-get-path dbdat))) (debug:print 0 *default-log-port* " dbpath: " dbpath) - (if (not (db:repair-db dbdat)) + (if (not (db:repair-db dbdat)) (begin (debug:print-error 0 *default-log-port* "Failed to rebuild " dbpath ", exiting now.") (exit))))) (cons todb slave-dbs)) @@ -557,13 +617,13 @@ 0) ;; this is the work to be done (cond ((not fromdb) (debug:print 3 *default-log-port* "WARNING: db:sync-tables called with fromdb missing") -1) ((not todb) (debug:print 3 *default-log-port* "WARNING: db:sync-tables called with todb missing") -2) - ((not (sqlite3:database? (db:dbdat-get-db fromdb))) + ((not (dbi:database? (db:dbdat-get-db fromdb))) (debug:print-error 0 *default-log-port* "db:sync-tables called with fromdb not a database " fromdb) -3) - ((not (sqlite3:database? (db:dbdat-get-db todb))) + ((not (dbi:database? (db:dbdat-get-db todb))) (debug:print-error 0 *default-log-port* "db:sync-tables called with todb not a database " todb) -4) (else (let ((stmts (make-hash-table)) ;; table-field => stmt (all-stmts '()) ;; ( ( stmt1 value1 ) ( stml2 value2 )) (numrecs (make-hash-table)) @@ -591,10 +651,11 @@ ";")) (full-ins (conc "INSERT OR REPLACE INTO " tablename " ( " (string-intersperse (map car fields) ",") " ) " " VALUES ( " (string-intersperse (make-list num-fields "?") ",") " );")) (fromdat '()) (fromdats '()) + (tabletypes '()) (totrecords 0) (batch-len (string->number (or (configf:lookup *configdat* "sync" "batchsize") "10"))) (todat (make-hash-table)) (count 0)) @@ -604,13 +665,13 @@ (hash-table-set! field->num field count) (set! count (+ count 1))) fields) ;; read the source table - (sqlite3:for-each-row - (lambda (a . b) - (set! fromdat (cons (apply vector a b) fromdat)) + (dbi:for-each-row + (lambda (a) + (set! fromdat (cons a fromdat)) (if (> (length fromdat) batch-len) (begin (set! fromdats (cons fromdat fromdats)) (set! fromdat '()) (set! totrecords (+ totrecords 1))))) @@ -623,47 +684,77 @@ (if (common:low-noise-print 120 "sync-records") (debug:print-info 4 *default-log-port* "found " totrecords " records to sync")) ;; read the target table - (sqlite3:for-each-row - (lambda (a . b) - (hash-table-set! todat a (apply vector a b))) + (dbi:for-each-row + (lambda (a) + (hash-table-set! todat (vector-ref a 0) a)) (db:dbdat-get-db todb) full-sel) ;; first pass implementation, just insert all changed rows (for-each (lambda (targdb) - (let* ((db (db:dbdat-get-db targdb)) - (stmth (sqlite3:prepare db full-ins))) - (db:delay-if-busy targdb) ;; NO WAITING - (for-each + (set! targdb (dbi:convert (db:dbdat-get-db targdb))) + (if (eqv? (dbi:db-dbtype targdb) 'pg) + (let* ((prep "") + (set-stmt "") + (key (car (map car fields))) + (list-fields (map car fields))) + (set! prep (string-intersperse (map cadr fields) ",")) + (set! prep (conc "PREPARE fullupdate (" prep ") AS UPDATE " tablename " SET ")) ;;maybe add lookup in the future depending on where types are needed + (let loop ((i 1)) + (set! set-stmt (conc set-stmt (list-ref list-fields i) " = $" (+ i 1) ", ")) + (if (< i (- (length list-fields) 2)) + (loop (+ i 1)) + (set! set-stmt (conc set-stmt (list-ref list-fields (+ i 1)) " = $" (+ i 2) " WHERE " key " = $1;")))) + (set! full-ins (conc prep set-stmt)))) + (let* ((db (dbi:convert (db:dbdat-get-db targdb))) + (stmth (dbi:prepare db full-ins))) + ;; (db:delay-if-busy targdb) ;; NO WAITING + + (for-each (lambda (fromdat-lst) - (sqlite3:with-transaction + (dbi:with-transaction db (lambda () (for-each ;; (lambda (fromrow) (let* ((a (vector-ref fromrow 0)) (curr (hash-table-ref/default todat a #f)) - (same #t)) + (same #t) + (res #f) + (len (length (vector->list fromrow)))) (let loop ((i 0)) (if (or (not curr) (not (equal? (vector-ref fromrow i)(vector-ref curr i)))) (set! same #f)) (if (and same (< i (- num-fields 1))) (loop (+ i 1)))) - (if (not same) - (begin - (apply sqlite3:execute stmth (vector->list fromrow)) - (hash-table-set! numrecs tablename (+ 1 (hash-table-ref/default numrecs tablename 0))))))) + (if (eqv? (dbi:db-dbtype db) 'pg) (set! fromrow (list->vector (map (lambda (x) (if (and (string? x) (string-null? x)) (sql-null) x)) (vector->list fromrow))))) + (if (not same) + (begin + (set! res (apply dbi:prepare-exec stmth (vector->list fromrow))) + (hash-table-set! numrecs tablename (+ 1 (hash-table-ref/default numrecs tablename 0))))) + (if (and (not same) (eqv? (dbi:get-res res 'affected-rows) 0)) + (let* ((prep "")) + (set! prep (string-intersperse (map cadr fields) ",")) + (set! prep (conc "INSERT INTO " tablename " ( " (string-intersperse (map car fields) ",") + " ) VALUES ( " (string-intersperse (make-list len "?") ",") " );")) ;;maybe add lookup in the future depending on where types are needed + (begin + (hash-table-set! numrecs tablename (- 1 (hash-table-ref/default numrecs tablename 0))) + (apply dbi:exec db prep (vector->list fromrow)) + (hash-table-set! numrecs tablename (+ 1 (hash-table-ref/default numrecs tablename 0)))))))) + ;;(begin + ;; (dbi:prepare-exec stmth (vector->list fromrow)) + ;;(hash-table-set! numrecs tablename (+ 1 (hash-table-ref/default numrecs tablename 0))))))) fromdat-lst)) )) fromdats) - (sqlite3:finalize! stmth))) + (dbi:close stmth))) (append (list todb) slave-dbs)))) tbls) (let* ((runtime (- (current-milliseconds) start-time)) (should-print (or (debug:debug-mode 12) (common:low-noise-print 120 "db sync" (> runtime 500))))) ;; low and high sync times treated as separate. @@ -827,12 +918,13 @@ ;; (define (db:multi-db-sync dbstruct . options) (if (not (launch:setup)) (debug:print 0 *default-log-port* "ERROR: not able to setup up for megatest.") (let* ((mtdb (dbr:dbstruct-mtdb dbstruct)) - (tmpdb (db:get-db dbstruct)) + (tmpdb (db:get-db dbstruct)) (refndb (dbr:dbstruct-refndb dbstruct)) + (slave-dbs (dbr:dbstruct-slave-dbs dbstruct)) (allow-cleanup #t) ;; (if run-ids #f #t)) ;; (tdbdat (tasks:open-db)) (servers (server:get-list *toppath*)) ;; (tasks:get-all-servers (db:delay-if-busy tdbdat))) (data-synced 0)) ;; count of changed records (I hope) @@ -874,17 +966,50 @@ ;; ;; (dbstruct (if toppath (make-dbr:dbstruct path: toppath local: #t) #f))) ;; (debug:print 0 *default-log-port* "INFO: Propagating " (length testrecs) " records for run-id=" run-id " to run specific db") ;; (db:replace-test-records dbstruct run-id testrecs) ;; (sqlite3:finalize! (db:dbdat-get-db (dbr:dbstruct-rundb dbstruct))))) ;; run-ids))) + + (if (member 'synctoconfig options) + (if (configf:get-section *configdat* "ext-sync") + (let* ((dblist (configf:get-section *configdat* "ext-sync")) + (res '()) + (cfgdb #f)) + (for-each (lambda (dbitem) + (let* ((stringsplit (string-split (cadr dbitem))) + (dbtype (string->symbol (car stringsplit))) + (dbpath (cadr stringsplit))) + (case dbtype + ((sqlite3) + (set! cfgdb (dbi:open dbtype (cons (cons 'dbname dbpath) '()) )) + (db:initialize-main-db (dbi:db-conn cfgdb)) + (db:initialize-run-id-db (dbi:db-conn cfgdb)) + (set! res (cons (cons cfgdb dbpath) res))) + ((pg) + (let* ((dbinfo '())) + (for-each + (lambda (x) + (if (not (eqv? (string->symbol x) dbtype)) + (let* ((pair (string-split x ":"))) + (if (not (eqv? pair '())) + (set! dbinfo (cons (cons (string->symbol (car pair)) (cadr pair)) dbinfo)))))) + stringsplit) + (set! cfgdb (dbi:open dbtype dbinfo)) + (set! res (cons (cons cfgdb (alist-ref 'host dbinfo)) res)) + ))))) + dblist) + (for-each (lambda (todb) + (db:sync-tables (db:sync-all-tables-list dbstruct) #f mtdb todb)) res) + + ))) ;; now ensure all newdb data are synced to megatest.db ;; do not use the run-ids list passed in to the function ;; (if (member 'new2old options) (set! data-synced - (+ (db:sync-tables (db:sync-all-tables-list dbstruct) #f tmpdb refndb mtdb) + (+ (apply db:sync-tables (db:sync-all-tables-list dbstruct) #f tmpdb refndb mtdb slave-dbs) data-synced))) (if (member 'schema options) (begin @@ -1155,11 +1280,11 @@ fail_count INTEGER DEFAULT 0, pass_count INTEGER DEFAULT 0, archived INTEGER DEFAULT 0, -- 0=no, > 1=archive block id where test data can be found last_update INTEGER DEFAULT (strftime('%s','now')), CONSTRAINT testsconstraint UNIQUE (run_id, testname, item_path));") - (sqlite3:execute db "CREATE INDEX IF NOT EXISTS tests_index ON tests (run_id, testname, item_path, uname);") + (sqlite3:execute db "CREATE INDEX IF NOT EXISTS tests_index ON tests (run_id, testname, item_path);") (sqlite3:execute db "CREATE TRIGGER IF NOT EXISTS update_tests_trigger AFTER UPDATE ON tests FOR EACH ROW BEGIN UPDATE tests SET last_update=(strftime('%s','now')) WHERE id=old.id; Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -873,10 +873,15 @@ (begin (debug:print-error 0 *default-log-port* "failed to find the top path to your Megatest area.") ;;(exit 1) #f )) + ;; if have -append-config then read and append here + (let ((cfname (args:get-arg "-append-config"))) + (if (and cfname + (file-read-access? cfname)) + (read-config cfname *configdat* #t))) ;; values are added to the hash, no need to do anything special. *toppath*)) (define (get-best-disk confdat testconfig) (let* ((disks (or (and testconfig (hash-table-ref/default testconfig "disks" #f)) (hash-table-ref/default confdat "disks" #f))) Index: megatest-version.scm ================================================================== --- megatest-version.scm +++ megatest-version.scm @@ -1,7 +1,7 @@ ;; Always use two or four digit decimal ;; 1.01, 1.02...1.10,1.11,1.1101 ... 1.99,2.00.. (declare (unit megatest-version)) -(define megatest-version 1.6308) +(define megatest-version 1.6401) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -163,15 +163,20 @@ -repl : start a repl (useful for extending megatest) -load file.scm : load and run file.scm -mark-incompletes : find and mark incomplete tests -ping run-id|host:port : ping server, exit with 0 if found -debug N|N,M,O... : enable debug 0-N or N and M and O ... + -config fname : override the megatest.config file with fname + -append-config fname : append fname to the megatest.config file Utilities -env2file fname : write the environment to fname.csh and fname.sh - -envcap fname=context : save current variables labeled as context in file fname - -refdb2dat refdb : convert refdb to sexp or to format specified by -dumpmode + -envcap a : save current variables labeled as context 'a' in file envdat.db + -envdelta a-b : output enviroment delta from context a to context b to -o fname + set the output mode with -dumpmode csh, bash or ini + note: ini format will use calls to use curr and minimize path + -refdb2dat refdb : convert refdb to sexp or to format specified by s-dumpmode formats: perl, ruby, sqlite3, csv (for csv the -o param will substitute %s for the sheet name in generating multiple sheets) -o : output file for refdb2dat (defaults to stdout) -archive cmd : archive runs specified by selectors to one of disks specified @@ -204,17 +209,17 @@ Called as " (string-intersperse (argv) " ") " Version " megatest-version ", built from " megatest-fossil-hash )) ;; -gui : start a gui interface -;; -config fname : override the runconfig file with fname ;; process args (define remargs (args:get-args (argv) (list "-runtests" ;; run a specific test "-config" ;; override the config file name + "-append-config" "-execute" ;; run the command encoded in the base64 parameter "-step" "-target" "-reqtarg" ":runname" @@ -338,10 +343,11 @@ "-convert-to-norm" "-convert-to-old" "-import-megatest.db" "-sync-to-megatest.db" + "-sync-to-configdb" "-logging" "-v" ;; verbose 2, more than normal (normal is 1) "-q" ;; quiet 0, errors/warnings only @@ -2001,10 +2007,18 @@ (if (args:get-arg "-sync-to-megatest.db") (begin (db:multi-db-sync (db:setup) 'new2old + ) + (set! *didsomething* #t))) + +(if (args:get-arg "-sync-to-configdb") + (begin + (db:multi-db-sync + (db:setup) + 'synctoconfig ) (set! *didsomething* #t))) (if (args:get-arg "-generate-html") (let* ((toppath (launch:setup))) ADDED mt-pg.sql Index: mt-pg.sql ================================================================== --- /dev/null +++ mt-pg.sql @@ -0,0 +1,182 @@ +CREATE TABLE IF NOT EXISTS keys ( + id INTEGER PRIMARY KEY, + fieldname TEXT, + fieldtype TEXT, + CONSTRAINT keyconstraint UNIQUE (fieldname)); + +CREATE TABLE IF NOT EXISTS areas ( + id INTEGER PRIMARY KEY, + areaname TEXT DEFAULT 'local', + areapath TEXT DEFAULT '.', + last_sync INTEGER DEFAULT 0, + CONSTRAINT areaconstraint UNIQUE (areaname)); + +INSERT INTO areas (id,areaname,areapath) VALUES (0,'local','.'); + +CREATE TABLE IF NOT EXISTS ttype ( + id INTEGER PRIMARY KEY, + target_spec TEXT DEFAULT ''); + +CREATE TABLE IF NOT EXISTS runs ( + id INTEGER PRIMARY KEY, + target TEXT DEFAULT '', + ttype_id INTEGER DEFAULT 0, + runname TEXT DEFAULT 'norun', + state TEXT DEFAULT '', + status TEXT DEFAULT '', + owner TEXT DEFAULT '', + event_time INTEGER DEFAULT extract(epoch from now()), + comment TEXT DEFAULT '', + fail_count INTEGER DEFAULT 0, + pass_count INTEGER DEFAULT 0, + last_update INTEGER DEFAULT extract(epoch from now()), + area_id INTEGER DEFAULT 0, + CONSTRAINT runsconstraint UNIQUE (runname)); + +CREATE TABLE IF NOT EXISTS run_stats ( + id INTEGER PRIMARY KEY, + run_id INTEGER, + state TEXT, + status TEXT, + count INTEGER, + last_update INTEGER DEFAULT extract(epoch from now())); + +CREATE TABLE IF NOT EXISTS test_meta ( + id INTEGER PRIMARY KEY, + testname TEXT DEFAULT '', + author TEXT DEFAULT '', + owner TEXT DEFAULT '', + description TEXT DEFAULT '', + reviewed TEXT, + iterated TEXT DEFAULT '', + avg_runtime REAL, + avg_disk REAL, + tags TEXT DEFAULT '', + jobgroup TEXT DEFAULT 'default', + CONSTRAINT test_meta_constraint UNIQUE (testname)); + +CREATE TABLE IF NOT EXISTS tasks_queue ( + id INTEGER PRIMARY KEY, + action TEXT DEFAULT '', + owner TEXT, + state TEXT DEFAULT 'new', + target TEXT DEFAULT '', + name TEXT DEFAULT '', + testpatt TEXT DEFAULT '', + keylock TEXT, + params TEXT, + creation_time INTEGER DEFAULT extract(epoch from now()), + execution_time INTEGER); + +CREATE TABLE IF NOT EXISTS archive_disks ( + id INTEGER PRIMARY KEY, + archive_area_name TEXT, + disk_path TEXT, + last_df INTEGER DEFAULT -1, + last_df_time INTEGER DEFAULT extract(epoch from now()), + creation_time INTEGER DEFAULT extract(epoch from now())); + +CREATE TABLE IF NOT EXISTS archive_blocks ( + id INTEGER PRIMARY KEY, + archive_disk_id INTEGER, + disk_path TEXT, + last_du INTEGER DEFAULT -1, + last_du_time INTEGER DEFAULT extract(epoch from now()), + creation_time INTEGER DEFAULT extract(epoch from now())); + +CREATE TABLE IF NOT EXISTS archive_allocations ( + id INTEGER PRIMARY KEY, + archive_block_id INTEGER, + testname TEXT, + item_path TEXT, + creation_time INTEGER DEFAULT extract(epoch from now())); + +CREATE TABLE IF NOT EXISTS extradat ( + id INTEGER PRIMARY KEY, + run_id INTEGER, + key TEXT, + val TEXT); + +CREATE TABLE IF NOT EXISTS metadat ( + id INTEGER PRIMARY KEY, + var TEXT, + val TEXT); + +CREATE TABLE IF NOT EXISTS access_log ( + id INTEGER PRIMARY KEY, + "user" TEXT, + accessed TIMESTAMP, + args TEXT); + +CREATE TABLE tests ( + id INTEGER PRIMARY KEY, + run_id INTEGER DEFAULT -1, + testname TEXT DEFAULT 'noname', + host TEXT DEFAULT 'n/a', + cpuload REAL DEFAULT -1, + diskfree INTEGER DEFAULT -1, + uname TEXT DEFAULT 'n/a', + rundir TEXT DEFAULT '/tmp/badname', + shortdir TEXT DEFAULT '/tmp/badname', + item_path TEXT DEFAULT '', + state TEXT DEFAULT 'NOT_STARTED', + status TEXT DEFAULT 'FAIL', + attemptnum INTEGER DEFAULT 0, + final_logf TEXT DEFAULT 'logs/final.log', + logdat TEXT DEFAULT '', + run_duration INTEGER DEFAULT 0, + comment TEXT DEFAULT '', + event_time INTEGER DEFAULT extract(epoch from now()), + fail_count INTEGER DEFAULT 0, + pass_count INTEGER DEFAULT 0, + archived INTEGER DEFAULT 0, -- 0=no, > 1=archive block id where test data can be found + last_update INTEGER DEFAULT extract(epoch from now()), + CONSTRAINT testsconstraint UNIQUE (run_id, testname, item_path)); + +CREATE TABLE IF NOT EXISTS test_steps ( + id INTEGER PRIMARY KEY, + test_id INTEGER, + stepname TEXT, + state TEXT DEFAULT 'NOT_STARTED', + status TEXT DEFAULT 'n/a', + event_time INTEGER DEFAULT extract(epoch from now()), + comment TEXT DEFAULT '', + logfile TEXT DEFAULT '', + last_update INTEGER DEFAULT extract(epoch from now()), + CONSTRAINT test_steps_constraint UNIQUE (test_id,stepname,state)); + +CREATE TABLE IF NOT EXISTS test_data ( + id INTEGER PRIMARY KEY, + test_id INTEGER, + category TEXT DEFAULT '', + variable TEXT, + value REAL, + expected REAL, + tol REAL, + units TEXT, + comment TEXT DEFAULT '', + status TEXT DEFAULT 'n/a', + type TEXT DEFAULT '', + last_update INTEGER DEFAULT extract(epoch from now()), + CONSTRAINT test_data_constraint UNIQUE (test_id,category,variable)); + +CREATE TABLE IF NOT EXISTS test_rundat ( + id INTEGER PRIMARY KEY, + test_id INTEGER, + update_time INTEGER, + cpuload INTEGER DEFAULT -1, + diskfree INTEGER DEFAULT -1, + diskusage INTEGER DEFAULT -1, + run_duration INTEGER DEFAULT 0); + +CREATE TABLE IF NOT EXISTS archives ( + id INTEGER PRIMARY KEY, + test_id INTEGER, + state TEXT DEFAULT 'new', + status TEXT DEFAULT 'n/a', + archive_type TEXT DEFAULT 'bup', + du INTEGER, + archive_path TEXT); + + +TRUNCATE archive_blocks, archive_allocations, extradat, metadat, access_log, tests, test_steps, test_data, test_rundat, archives, keys, runs, run_stats, test_meta, tasks_queue, archive_disks; Index: mtut.scm ================================================================== --- mtut.scm +++ mtut.scm @@ -19,10 +19,11 @@ (declare (uses common)) (declare (uses megatest-version)) (declare (uses margs)) (declare (uses configf)) +(declare (uses rmt)) (include "megatest-fossil-hash.scm") (let ((debugcontrolf (conc (get-environment-variable "HOME") "/.mtutilrc"))) (if (file-exists? debugcontrolf) @@ -51,10 +52,11 @@ remove : remove runs rerun : register action for processing set-ss : set state/status archive : compress and move test data to archive disk kill : stop tests or entire runs + db : database utilities Contour actions: process : runs import, rungen and dispatch Selectors @@ -77,10 +79,13 @@ -log logfile : send stdout and stderr to logfile -repl : start a repl (useful for extending megatest) -load file.scm : load and run file.scm -debug N|N,M,O... : enable debug messages 0-N or N and M and O ... +Utility + pgschema : emit postgresql schema; do \"mtutil db pgschema | psql -d mydb\" + Examples: # Start a megatest run in the area \"mytests\" mtutil -area mytests -action run -target v1.63/aa3e -mode-patt MYPATT -tag-expr quick @@ -175,10 +180,11 @@ (if (and (not (null? remargs)) (not (or (args:get-arg "-runstep") (args:get-arg "-envcap") (args:get-arg "-envdelta") + (member *action* '("db")) ;; very loose checks on db. ))) (debug:print-error 0 *default-log-port* "Unrecognised arguments: " (string-intersperse (if (list? remargs) remargs (argv)) " "))) (if (or (args:any? "-h" "help" "-help" "--help") (member *action* '("-h" "-help" "--help" "help"))) @@ -520,11 +526,23 @@ (generate-run-pkts mtconf toppath) (load-pkts-to-db mtconf) (dispatch-commands mtconf toppath))) ((import) (load-pkts-to-db mtconf)) ;; import pkts ((rungen) (generate-run-pkts mtconf toppath)) - ((dispatch) (dispatch-commands mtconf toppath))))))) + ((dispatch) (dispatch-commands mtconf toppath))))) + ((db) + (if (null? remargs) + (print "ERROR: missing sub command for db command") + (let ((subcmd (car remargs))) + (case (string->symbol subcmd) + ((pgschema) + (let* ((install-home (common:get-install-area)) + (schema-file (conc install-home "/share/db/mt-pg.sql"))) + (if (file-exists? schema-file) + (system (conc "/bin/cat " schema-file))))) + ((junk) + (rmt:get-keys)))))))) (if (or (args:get-arg "-repl") (args:get-arg "-load")) (begin (import extras) ;; might not be needed