Index: api.scm ================================================================== --- api.scm +++ api.scm @@ -265,11 +265,12 @@ (run-id (cadr params)) (realparams (cddr params))) (db:general-call dbstruct stmtname realparams))) ((sdb-qry) (apply sdb:qry params)) ((ping) (current-process-id)) - + ((get-changed-record-ids) (apply db:get-changed-record-ids dbstruct params)) + ;; TESTMETA ((testmeta-get-record) (apply db:testmeta-get-record dbstruct params)) ;; TASKS ((find-task-queue-records) (apply tasks:find-task-queue-records dbstruct params)))))) Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -2842,11 +2842,11 @@ #f (lambda (db) (let ((res #f)) (sqlite3:for-each-row ;; attemptnum added to hold pid of top process (not Megatest) controlling a test (lambda (id run-id testname state status event-time host cpuload diskfree uname rundir-id item-path run_duration final-logf-id comment short-dir-id attemptnum archived) - ;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 + ;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 (set! res (vector id run-id testname state status event-time host cpuload diskfree uname rundir-id item-path run_duration final-logf-id comment short-dir-id attemptnum archived))) db (conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id=?;") test-id) res)))) @@ -3887,10 +3887,31 @@ ;; (if (not ever-seen)(set! result (cons waitontest-name result))))) (if (not ever-seen) (set! result (append (if (null? tests)(list waitontest-name) tests) result))))) waitons) (delete-duplicates result)))) + +;;====================================================================== +;; Just for sync, procedures to make sync easy +;;====================================================================== + +;; get an alist of record ids changed since time since-time +;; '((runs . (1 2 3 ...))(steps . (5 6 7 ...) ...)) +;; +(define (db:get-changed-record-ids dbstruct since-time) + ;; no transaction, allow the db to be accessed between the big queries + (let ((backcons (lambda (lst item)(cons item lst)))) + (db:with-db + dbstruct #f #f + (lambda (db) + `((runs . ,(fold-row backcons '() db "SELECT id FROM runs WHERE last_update>?" since-time)) + (tests . ,(fold-row backcons '() db "SELECT id FROM tests WHERE last_update>?" since-time)) + (test_steps . ,(fold-row backcons '() db "SELECT id FROM test_steps WHERE last_update>?" since-time)) + (test_data . ,(fold-row backcons '() db "SELECT id FROM test_data WHERE last_update>?" since-time)) + ;; (test_meta . ,(fold-row backcons '() db "SELECT id FROM test_meta WHERE last_update>?" since-time)) + (run_stats . ,(fold-row backcons '() db "SELECT id FROM run_stats WHERE last_update>?" since-time)) + ))))) ;;====================================================================== ;; Extract ods file from the db ;;====================================================================== Index: mt-pg.sql ================================================================== --- mt-pg.sql +++ mt-pg.sql @@ -59,21 +59,21 @@ count INTEGER, last_update INTEGER DEFAULT extract(epoch from now())); CREATE TABLE IF NOT EXISTS test_meta ( id SERIAL PRIMARY KEY, - testname TEXT DEFAULT '', + test_name 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)); + CONSTRAINT test_meta_constraint UNIQUE (test_name)); CREATE TABLE IF NOT EXISTS tasks_queue ( id SERIAL PRIMARY KEY, action TEXT DEFAULT '', owner TEXT, @@ -103,11 +103,11 @@ creation_time INTEGER DEFAULT extract(epoch from now())); CREATE TABLE IF NOT EXISTS archive_allocations ( id SERIAL PRIMARY KEY, archive_block_id INTEGER, - testname TEXT, + test_name TEXT, item_path TEXT, creation_time INTEGER DEFAULT extract(epoch from now())); CREATE TABLE IF NOT EXISTS extradat ( id SERIAL PRIMARY KEY, @@ -127,20 +127,20 @@ args TEXT); CREATE TABLE IF NOT EXISTS tests ( id SERIAL PRIMARY KEY, run_id INTEGER DEFAULT -1, - testname TEXT DEFAULT 'noname', + test_name TEXT DEFAULT 'noname', + item_path TEXT DEFAULT '', + state TEXT DEFAULT 'NOT_STARTED', + status TEXT DEFAULT 'FAIL', 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 '', @@ -147,11 +147,11 @@ 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)); + CONSTRAINT testsconstraint UNIQUE (run_id, test_name, item_path)); CREATE TABLE IF NOT EXISTS test_steps ( id SERIAL PRIMARY KEY, test_id INTEGER, stepname TEXT, Index: rmt.scm ================================================================== --- rmt.scm +++ rmt.scm @@ -356,10 +356,13 @@ ;; NOT COMPLETED (define (rmt:runtests user run-id testpatt params) (rmt:send-receive 'runtests run-id testpatt)) +(define (rmt:get-changed-record-ids since-time) + (rmt:send-receive 'get-changed-record-ids #f (list since-time)) ) + ;;====================================================================== ;; T E S T M E T A ;;====================================================================== (define (rmt:get-tests-tags) @@ -409,12 +412,14 @@ (rmt:general-call 'register-test run-id run-id test-name item-path)) (define (rmt:get-test-id run-id testname item-path) (rmt:send-receive 'get-test-id run-id (list run-id testname item-path))) +;; run-id is NOT used +;; (define (rmt:get-test-info-by-id run-id test-id) - (if (and (number? run-id)(number? test-id)) + (if (number? test-id) (rmt:send-receive 'get-test-info-by-id run-id (list run-id test-id)) (begin (debug:print 0 *default-log-port* "WARNING: Bad data handed to rmt:get-test-info-by-id run-id=" run-id ", test-id=" test-id) (print-call-chain (current-error-port)) #f))) Index: tasks.scm ================================================================== --- tasks.scm +++ tasks.scm @@ -19,10 +19,11 @@ (declare (uses pgdb)) ;; (import pgdb) ;; pgdb is a module (include "task_records.scm") +(include "db_records.scm") ;;====================================================================== ;; Tasks db ;;====================================================================== @@ -636,39 +637,81 @@ (hash-table-set! runs-ht run-id new-run-id) ;; ensure key fields are up to date (pgdb:refresh-run-info dbh new-run-id - state status owner event-time comment fail-count pass-count)) ;; area-id)) + state status owner event-time comment fail-count pass-count) + new-run-id) (if (handle-exceptions exn (begin (print-call-chain) #f) (pgdb:insert-run dbh spec-id target run-name state status owner event-time comment fail-count pass-count)) ;; area-id)) (tasks:run-id->mtpg-run-id dbh cached-info run-id) #f)))))) - - - - ;;(define (tasks:sync-test-data dbh cached-info area-info) - ;; (let* (( + +(define (tasks:sync-tests-data dbh cached-info test-ids) + (let ((test-ht (hash-table-ref cached-info 'tests))) + (for-each + (lambda (test-id) + (let* ((test-info (rmt:get-test-info-by-id #f test-id)) + (run-id (db:test-get-run_id test-info)) ;; look these up in db_records.scm + (test-id (db:test-get-id test-info)) + (test-name (db:test-get-testname test-info)) + (item-path (db:test-get-item-path test-info)) + (state (db:test-get-state test-info)) + (status (db:test-get-status test-info)) + (host (db:test-get-host test-info)) + (cpuload (db:test-get-cpuload test-info)) + (diskfree (db:test-get-diskfree test-info)) + (uname (db:test-get-uname test-info)) + (run-dir (db:test-get-rundir test-info)) + (log-file (db:test-get-final_logf test-info)) + (run-duration (db:test-get-run_duration test-info)) + (comment (db:test-get-comment test-info)) + (event-time (db:test-get-event_time test-info)) + (archived (db:test-get-archived test-info)) + (pgdb-run-id (tasks:run-id->mtpg-run-id dbh cached-info run-id)) + (pgdb-test-id (pgdb:get-test-id dbh pgdb-run-id test-name item-path))) + ;; "id" "run_id" "testname" "state" "status" "event_time" + ;; "host" "cpuload" "diskfree" "uname" "rundir" "item_path" + ;; "run_duration" "final_logf" "comment" "shortdir" "attemptnum" "archived" + (if pgdb-test-id ;; have a record + (begin ;; let ((key-name (conc run-id "/" test-name "/" item-path))) + (hash-table-set! test-ht test-id pgdb-test-id) + (pgdb:update-test dbh test-id pgdb-run-id test-name item-path state status host cpuload diskfree uname run-dir log-file run-duration comment event-time archived)) + (pgdb:insert-test dbh pgdb-run-id test-name item-path state status host cpuload diskfree uname run-dir log-file run-duration comment event-time archived)) + )) + test-ids))) + +;; get runs changed since last sync +;; (define (tasks:sync-test-data dbh cached-info area-info) +;; (let* (( (define (tasks:sync-to-postgres configdat) (let* ((dbh (pgdb:open configdat)) (area-info (pgdb:get-area-by-path dbh *toppath*)) - (cached-info (make-hash-table))) + (cached-info (make-hash-table)) + (start (current-seconds))) (for-each (lambda (dtype) (hash-table-set! cached-info dtype (make-hash-table))) '(runs targets tests)) - (hash-table-set! cached-info 'start (current-seconds)) + (hash-table-set! cached-info 'start start) ;; when done we'll set sync times to this (if area-info - (begin + (let* ((last-sync-time (vector-ref area-info 3)) + (changed (rmt:get-changed-record-ids last-sync-time)) + (run-ids (alist-ref 'runs changed)) + (test-ids (alist-ref 'tests changed)) + (test-step-ids (alist-ref 'test_steps changed)) + (test-data-ids (alist-ref 'test_data changed)) + (run-stat-ids (alist-ref 'run_stats changed))) (print "area-info: " area-info) - (tasks:sync-test-data dbh cached-info area-info) + (if (not (null? test-ids)) + (tasks:sync-tests-data dbh cached-info test-ids)) ) (if (tasks:set-area dbh configdat) (tasks:sync-to-postgres configdat) (begin (debug:print 0 *default-log-port* "ERROR: unable to create an area record") #f)))))