Index: api.scm ================================================================== --- api.scm +++ api.scm @@ -78,11 +78,12 @@ login tasks-get-last testmeta-get-record have-incompletes? synchash-get - get-changed-record-ids + get-changed-record-ids + get-run-record-ids )) (define api:write-queries '( get-keys-write ;; dummy "write" query to force server start @@ -316,12 +317,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)) - + ((get-changed-record-ids) (apply db:get-changed-record-ids dbstruct params)) + ((get-run-record-ids) (apply db:get-run-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: cgisetup/models/pgdb.scm ================================================================== --- cgisetup/models/pgdb.scm +++ cgisetup/models/pgdb.scm @@ -137,10 +137,17 @@ ;; if no run found return #f ;; (define (pgdb:get-run-id dbh spec-id target run-name area-id) (dbi:get-one dbh "SELECT id FROM runs WHERE ttype_id=? AND target=? AND run_name=? and area_id=?;" spec-id target run-name area-id)) + +;; given a target spec id, target and run-name return the run-id +;; if no run found return #f +;; +(define (pgdb:get-run-last-update dbh id ) + (dbi:get-one dbh "SELECT last_update FROM runs WHERE id=?;" + id)) ;; given a run-id return all the run info ;; (define (pgdb:get-run-info dbh run-id ) ;; to join ttype or not? (dbi:get-one-row @@ -148,26 +155,26 @@ "SELECT id,target,ttype_id,run_name,state,status,owner,event_time,comment,fail_count,pass_count,last_update,area_id FROM runs WHERE id=? ;" run-id )) ;; refresh the data in a run record ;; -(define (pgdb:refresh-run-info dbh run-id state status owner event-time comment fail-count pass-count area-id) ;; area-id) +(define (pgdb:refresh-run-info dbh run-id state status owner event-time comment fail-count pass-count area-id last_update) ;; area-id) (dbi:exec dbh "UPDATE runs SET - state=?,status=?,owner=?,event_time=?,comment=?,fail_count=?,pass_count=? + state=?,status=?,owner=?,event_time=?,comment=?,fail_count=?,pass_count=?,last_update=? WHERE id=? and area_id=?;" - state status owner event-time comment fail-count pass-count run-id area-id)) + state status owner event-time comment fail-count pass-count last_update run-id area-id )) ;; given all needed info create run record ;; -(define (pgdb:insert-run dbh ttype-id target run-name state status owner event-time comment fail-count pass-count area-id) +(define (pgdb:insert-run dbh ttype-id target run-name state status owner event-time comment fail-count pass-count area-id last-update) (dbi:exec dbh - "INSERT INTO runs (ttype_id,target,run_name,state,status,owner,event_time,comment,fail_count,pass_count,area_id ) - VALUES (?,?,?,?,?,?,?,?,?,?,?);" - ttype-id target run-name state status owner event-time comment fail-count pass-count area-id)) + "INSERT INTO runs (ttype_id,target,run_name,state,status,owner,event_time,comment,fail_count,pass_count,area_id,last_update) + VALUES (?,?,?,?,?,?,?,?,?,?,?,?);" + ttype-id target run-name state status owner event-time comment fail-count pass-count area-id last-update)) ;;====================================================================== ;; T E S T - S T E P S ;;====================================================================== @@ -175,24 +182,30 @@ (dbi:get-one dbh "SELECT id FROM test_steps WHERE test_id=? AND stepname=? and state = ? ;" test-id stepname state)) -(define (pgdb:insert-test-step dbh test-id stepname state status event_time comment logfile) +(define (pgdb:get-test-step-last-update dbh id ) + (dbi:get-one + dbh + "SELECT last_update FROM test_steps WHERE id=? ;" + id)) + +(define (pgdb:insert-test-step dbh test-id stepname state status event_time comment logfile last-update) (dbi:exec dbh - "INSERT INTO test_steps (test_id,stepname,state,status,event_time,logfile,comment) - VALUES (?,?,?,?,?,?,?);" - test-id stepname state status event_time logfile comment)) + "INSERT INTO test_steps (test_id,stepname,state,status,event_time,logfile,comment,last_update) + VALUES (?,?,?,?,?,?,?, ? );" + test-id stepname state status event_time logfile comment last-update)) -(define (pgdb:update-test-step dbh step-id test-id stepname state status event_time comment logfile) +(define (pgdb:update-test-step dbh step-id test-id stepname state status event_time comment logfile last-update) (dbi:exec dbh "UPDATE test_steps SET - test_id=?,stepname=?,state=?,status=?,event_time=?,logfile=?,comment=? + test_id=?,stepname=?,state=?,status=?,event_time=?,logfile=?,comment=?,last_update=? WHERE id=?;" - test-id stepname state status event_time logfile comment step-id)) + test-id stepname state status event_time logfile comment last-update step-id)) ;;====================================================================== ;; T E S T - D A T A ;;====================================================================== @@ -201,11 +214,17 @@ (dbi:get-one dbh "SELECT id FROM test_data WHERE test_id=? AND category=? and variable = ? ;" test-id category variable)) -(define (pgdb:insert-test-data dbh test-id category variable value expected tol units comment status type) +(define (pgdb:get-test-data-last-update dbh test-data-id ) + (dbi:get-one + dbh + "SELECT last_update FROM test_data WHERE id=? ;" + test-data-id)) + +(define (pgdb:insert-test-data dbh test-id category variable value expected tol units comment status type last-update) ; (print "INSERT INTO test_data (test_id, category, variable, value, expected, tol, units, comment, status, type) ; VALUES (?,?,?,?,?,?,?,?,?,?) " test-id " " category " " variable " " value " " expected " " tol " " units " " comment " " status " " type) (if (not (string? units)) (set! units "" )) (if (not (string? variable)) @@ -217,21 +236,21 @@ (if (not (real? tol)) (set! tol 0 )) (dbi:exec dbh - "INSERT INTO test_data (test_id, category, variable, value, expected, tol, units, comment, status, type) - VALUES (?,?,?,?,?,?,?,?,?,?);" - test-id category variable value expected tol units comment status type)) + "INSERT INTO test_data (test_id, category, variable, value, expected, tol, units, comment, status, type, last_update) + VALUES (?,?,?,?,?,?,?,?,?,?, ?);" + test-id category variable value expected tol units comment status type last-update)) -(define (pgdb:update-test-data dbh data-id test-id category variable value expected tol units comment status type) +(define (pgdb:update-test-data dbh data-id test-id category variable value expected tol units comment status type last-update) (dbi:exec dbh "UPDATE test_data SET - test_id=?, category=?, variable=?, value=?, expected=?, tol=?, units=?, comment=?, status=?, type=? + test_id=?, category=?, variable=?, value=?, expected=?, tol=?, units=?, comment=?, status=?, type=?, last_update=? WHERE id=?;" - test-id category variable value expected tol units comment status type data-id )) + test-id category variable value expected tol units comment status type last-update data-id )) ;;====================================================================== ;; T E S T S @@ -242,33 +261,40 @@ (define (pgdb:get-test-id dbh run-id test-name item-path) (dbi:get-one dbh "SELECT id FROM tests WHERE run_id=? AND test_name=? AND item_path=?;" run-id test-name item-path)) + +(define (pgdb:get-test-last-update dbh id) + (dbi:get-one + dbh + "SELECT last_update FROM tests WHERE id=? ;" + id )) + ;; create new test record ;; -(define (pgdb:insert-test dbh run-id test-name item-path state status host cpuload diskfree uname run-dir log-file run-duration comment event-time archived) +(define (pgdb:insert-test dbh run-id test-name item-path state status host cpuload diskfree uname run-dir log-file run-duration comment event-time archived last-update) (dbi:exec dbh - "INSERT INTO tests (run_id,test_name,item_path,state,status,host,cpuload,diskfree,uname,rundir,final_logf,run_duration,comment,event_time,archived) - VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?);" + "INSERT INTO tests (run_id,test_name,item_path,state,status,host,cpuload,diskfree,uname,rundir,final_logf,run_duration,comment,event_time,archived,last_update) + VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?);" run-id test-name item-path state status host cpuload diskfree uname - run-dir log-file run-duration comment event-time archived)) + run-dir log-file run-duration comment event-time archived last-update)) ;; update existing test record ;; -(define (pgdb:update-test dbh test-id run-id test-name item-path state status host cpuload diskfree uname run-dir log-file run-duration comment event-time archived) +(define (pgdb:update-test dbh test-id run-id test-name item-path state status host cpuload diskfree uname run-dir log-file run-duration comment event-time archived last-update) (dbi:exec dbh "UPDATE tests SET - run_id=?,test_name=?,item_path=?,state=?,status=?,host=?,cpuload=?,diskfree=?,uname=?,rundir=?,final_logf=?,run_duration=?,comment=?,event_time=?,archived=? + run_id=?,test_name=?,item_path=?,state=?,status=?,host=?,cpuload=?,diskfree=?,uname=?,rundir=?,final_logf=?,run_duration=?,comment=?,event_time=?,archived=?,last_update=? WHERE id=?;" run-id test-name item-path state status host cpuload diskfree uname - run-dir log-file run-duration comment event-time archived test-id)) + run-dir log-file run-duration comment event-time archived last-update test-id)) (define (pgdb:get-tests dbh target-patt) (dbi:get-rows dbh "SELECT t.id,t.run_id,t.test_name,t.item_path,t.state,t.status,t.host,t.cpuload,t.diskfree,t.uname,t.rundir,t.final_logf,t.run_duration,t.comment,t.event_time,t.archived, Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -2532,11 +2532,11 @@ (define (db:get-run-info dbstruct run-id) ;;(if (hash-table-ref/default *run-info-cache* run-id #f) ;; (hash-table-ref *run-info-cache* run-id) (let* ((res (vector #f #f #f #f)) (keys (db:get-keys dbstruct)) - (remfields (list "id" "runname" "state" "status" "owner" "event_time" "comment" "fail_count" "pass_count" "contour")) ;; "area_id")) + (remfields (list "id" "runname" "state" "status" "owner" "event_time" "comment" "fail_count" "pass_count" "contour" "last_update")) ;; "area_id")) (header (append keys remfields)) (keystr (conc (keys->keystr keys) "," (string-intersperse remfields ",")))) (debug:print-info 11 *default-log-port* "db:get-run-info run-id: " run-id " header: " header " keystr: " keystr) @@ -3072,11 +3072,11 @@ #f test-id)))) (define db:test-record-fields '("id" "run_id" "testname" "state" "status" "event_time" "host" "cpuload" "diskfree" "uname" "rundir" "item_path" - "run_duration" "final_logf" "comment" "shortdir" "attemptnum" "archived")) + "run_duration" "final_logf" "comment" "shortdir" "attemptnum" "archived" "last_update")) ;; fields *must* be a non-empty list ;; (define (db:field->number fieldname fields) (if (null? fields) @@ -3177,13 +3177,13 @@ #f ;; run-id #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) + (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 last-update) ;; 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))) + (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 last-update))) db (conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id=?;") test-id) res)))) @@ -3304,16 +3304,16 @@ (db:with-db dbstruct #f #f (lambda (db) - (let* ((res (vector #f #f #f #f #f #f #f #f))) + (let* ((res (vector #f #f #f #f #f #f #f #f #f))) (sqlite3:for-each-row - (lambda (id test-id stepname state status event-time logfile comment) - (set! res (vector id test-id stepname state status event-time (if (string? logfile) logfile "") comment))) + (lambda (id test-id stepname state status event-time logfile comment last-update) + (set! res (vector id test-id stepname state status event-time (if (string? logfile) logfile "") comment last-update))) db - "SELECT id,test_id,stepname,state,status,event_time,logfile,comment FROM test_steps WHERE id=? ORDER BY id ASC;" ;; event_time DESC,id ASC; + "SELECT id,test_id,stepname,state,status,event_time,logfile,comment,last_update FROM test_steps WHERE id=? ORDER BY id ASC;" ;; event_time DESC,id ASC; test-step-id) res)))) (define (db:get-steps-data dbstruct run-id test-id) (db:with-db @@ -3338,16 +3338,16 @@ (db:with-db dbstruct #f #f (lambda (db) - (let* ((res (vector #f #f #f #f #f #f #f #f #f #f #f))) + (let* ((res (vector #f #f #f #f #f #f #f #f #f #f #f #f))) (sqlite3:for-each-row - (lambda (id test-id category variable value expected tol units comment status type ) - (set! res (vector id test-id category variable value expected tol units comment status type))) + (lambda (id test-id category variable value expected tol units comment status type last-update) + (set! res (vector id test-id category variable value expected tol units comment status type last-update))) db - "SELECT id,test_id, category, variable, value, expected, tol, units, comment, status, type FROM test_data WHERE id=? ORDER BY id ASC;" ;; event_time DESC,id ASC; + "SELECT id,test_id, category, variable, value, expected, tol, units, comment, status, type, last_update FROM test_data WHERE id=? ORDER BY id ASC;" ;; event_time DESC,id ASC; test-data-id) res)))) ;; WARNING: Do NOT call this for the parent test on an iterated test @@ -3528,11 +3528,11 @@ (set! res (cons (vector id test_id category variable value expected tol units comment status type) res))) db "SELECT id,test_id,category,variable,value,expected,tol,units,comment,status,type FROM test_data WHERE test_id=? AND category LIKE ? ORDER BY category,variable;" test-id categorypatt) (reverse res))))) -;; This routine moved from tdb.scm, tdb:read-test-data +;; This routine moved from tdb.scm, :read-test-data ;; (define (db:read-test-data* dbstruct run-id test-id categorypatt varpatt) (let* ((res '())) (db:with-db dbstruct #f #f @@ -4485,10 +4485,32 @@ ;; (if (not ever-seen)(set! result (cons waitontest-name result))))) ((not ever-seen) (set! result (append (if (null? waiton-tests)(list waitontest-name) waiton-tests) result)))))) waitons) (delete-duplicates result))))) +;;====================================================================== +;; To sync individual run +;;====================================================================== +(define (db:get-run-record-ids dbstruct target run keynames test-patt) +(let ((backcons (lambda (lst item)(cons item lst)))) + (db:with-db + dbstruct #f #f + (lambda (db) + (let* ((keystr (string-intersperse + (map (lambda (key val) + (conc key " like '" val "'")) + keynames + (string-split target "/")) + " AND ")) + (run-qry (conc "SELECT id FROM runs WHERE " keystr " and runname='" run"'")) + (test-qry (conc "SELECT id FROM tests WHERE run_id in (" run-qry ") and testname like '" test-patt "'"))) + ;(print run-qry) + `((runs . ,(fold-row backcons '() db run-qry)) + (tests . ,(fold-row backcons '() db test-qry)) + (test_steps . ,(fold-row backcons '() db (conc "SELECT id FROM test_steps WHERE test_id in (" test-qry ")"))) + (test_data . ,(fold-row backcons '() db (conc "SELECT id FROM test_data WHERE test_id in (" test-qry ")" ))) + )))))) ;;====================================================================== ;; Just for sync, procedures to make sync easy ;;====================================================================== @@ -4499,16 +4521,16 @@ ;; 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)) + `((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)) + (run_stats . ,(fold-row backcons '() db "SELECT id FROM run_stats WHERE last_update>=?" since-time)) ))))) ;;====================================================================== ;; Extract ods file from the db ;;====================================================================== Index: db_records.scm ================================================================== --- db_records.scm +++ db_records.scm @@ -102,10 +102,11 @@ (define-inline (db:test-get-run_duration vec) (vector-ref vec 12)) (define-inline (db:test-get-final_logf vec) (vector-ref vec 13)) (define-inline (db:test-get-comment vec) (vector-ref vec 14)) (define-inline (db:test-get-process_id vec) (vector-ref vec 16)) (define-inline (db:test-get-archived vec) (vector-ref vec 17)) +(define-inline (db:test-get-last_update vec) (vector-ref vec 18)) ;; (define-inline (db:test-get-pass_count vec) (vector-ref vec 15)) ;; (define-inline (db:test-get-fail_count vec) (vector-ref vec 16)) (define-inline (db:test-get-fullname vec) (conc (db:test-get-testname vec) "/" (db:test-get-item-path vec))) @@ -186,10 +187,11 @@ (define-inline (db:test-data-get-tol vec) (vector-ref vec 6)) (define-inline (db:test-data-get-units vec) (vector-ref vec 7)) (define-inline (db:test-data-get-comment vec) (vector-ref vec 8)) (define-inline (db:test-data-get-status vec) (vector-ref vec 9)) (define-inline (db:test-data-get-type vec) (vector-ref vec 10)) +(define-inline (db:test-data-get-last_update vec) (vector-ref vec 11)) (define-inline (db:test-data-set-id! vec val)(vector-set! vec 0 val)) (define-inline (db:test-data-set-test_id! vec val)(vector-set! vec 1 val)) (define-inline (db:test-data-set-category! vec val)(vector-set! vec 2 val)) (define-inline (db:test-data-set-variable! vec val)(vector-set! vec 3 val)) @@ -204,27 +206,28 @@ ;;====================================================================== ;; S T E P S ;;====================================================================== ;; Run steps ;; make-vector-record "Run steps" db step id test_id stepname step_complete step_pass event_time -(define (make-db:step)(make-vector 7)) +(define (make-db:step)(make-vector 9)) (define-inline (tdb:step-get-id vec) (vector-ref vec 0)) (define-inline (tdb:step-get-test_id vec) (vector-ref vec 1)) (define-inline (tdb:step-get-stepname vec) (vector-ref vec 2)) (define-inline (tdb:step-get-state vec) (vector-ref vec 3)) (define-inline (tdb:step-get-status vec) (vector-ref vec 4)) (define-inline (tdb:step-get-event_time vec) (vector-ref vec 5)) (define-inline (tdb:step-get-logfile vec) (vector-ref vec 6)) (define-inline (tdb:step-get-comment vec) (vector-ref vec 7)) +(define-inline (tdb:step-get-last_update vec) (vector-ref vec 8)) (define-inline (tdb:step-set-id! vec val)(vector-set! vec 0 val)) (define-inline (tdb:step-set-test_id! vec val)(vector-set! vec 1 val)) (define-inline (tdb:step-set-stepname! vec val)(vector-set! vec 2 val)) (define-inline (tdb:step-set-state! vec val)(vector-set! vec 3 val)) (define-inline (tdb:step-set-status! vec val)(vector-set! vec 4 val)) (define-inline (tdb:step-set-event_time! vec val)(vector-set! vec 5 val)) (define-inline (tdb:step-set-logfile! vec val)(vector-set! vec 6 val)) -(define-inline (tdb:step-set-comment! vec vak)(vector-set! vec 7 val)) +(define-inline (tdb:step-set-comment! vec val)(vector-set! vec 7 val)) ;; The steps table (define (make-db:steps-table)(make-vector 5)) (define-inline (tdb:steps-table-get-stepname vec) (vector-ref vec 0)) Index: megatest-version.scm ================================================================== --- megatest-version.scm +++ megatest-version.scm @@ -18,6 +18,6 @@ ;; 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.6519) +(define megatest-version 1.6521) Index: mt-pg.sql ================================================================== --- mt-pg.sql +++ mt-pg.sql @@ -42,13 +42,17 @@ DROP TABLE IF EXISTS sessions; DROP TABLE IF EXISTS tags; DROP TABLE IF EXISTS users; DROP TABLE IF EXISTS webviews; DROP TABLE IF EXISTS area_tags; - DROP TABLE IF EXISTS users_webviews; - +DROP TABLE IF EXISTS base_paths; +DROP TABLE IF EXISTS area_owners; +DROP TABLE IF EXISTS shared_user_views; +DROP TABLE IF EXISTS cctrl_info; +DROP TABLE IF EXISTS cctrl_config; +DROP TABLE IF EXISTS platforms; CREATE TABLE IF NOT EXISTS session_vars ( id SERIAL PRIMARY KEY, session_id INTEGER, @@ -262,10 +266,11 @@ id SERIAL PRIMARY KEY , username TEXT NOT NULL, fullname TEXT NOT NULL, email TEXT NOT NULL, default_view TEXT default '', + is_admin boolean default 'f', deleted INTEGER default 0 ); CREATE TABLE IF NOT EXISTS base_paths( id SERIAL PRIMARY KEY , @@ -296,10 +301,11 @@ ttype_id INTEGER DEFAULT 0, view_specifics TEXT , col TEXT NOT NULL, row TEXT NOT NULL, public INTEGER DEFAULT 0, + search_patt TEXT default '.*', deleted INTEGER default 0 ); @@ -322,18 +328,18 @@ ); CREATE TABLE IF NOT EXISTS cctrl_config( id SERIAL PRIMARY KEY , area_type Text, + metadata text default '', cmd TEXT ); CREATE TABLE IF NOT EXISTS platforms( id SERIAL PRIMARY KEY , name Text ); - -- TRUNCATE archive_blocks, archive_allocations, extradat, metadat, -- access_log, tests, test_steps, test_data, test_rundat, archives, runs, -- run_stats, test_meta, tasks_queue, archive_disks; Index: mtut.scm ================================================================== --- mtut.scm +++ mtut.scm @@ -1733,12 +1733,12 @@ (debug:print 0 *default-log-port* ctime " received " instr ) ;(nn-send rep "ok") (if (not (equal? instr "ping")) (begin (debug:print 0 *default-log-port* ctime " running \"" script " " instr "\"") - ;(system (conc script " '" instr "'")) - (process-run script (list instr )) + (system (conc script " '" instr "' &")) + ;(process-run script (list instr )) (debug:print 0 *default-log-port* ctime " done" )) (begin (if (not (equal? instr "load")) (print "Checking load") Index: rmt.scm ================================================================== --- rmt.scm +++ rmt.scm @@ -465,10 +465,13 @@ ;; NOT COMPLETED (define (rmt:runtests user run-id testpatt params) (rmt:send-receive 'runtests run-id testpatt)) +(define (rmt:get-run-record-ids target run keynames test-patt) + (rmt:send-receive 'get-run-record-ids #f (list target run keynames test-patt))) + (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 Index: tasks.scm ================================================================== --- tasks.scm +++ tasks.scm @@ -738,11 +738,11 @@ ;; gets mtpg-run-id and syncs the record if different ;; -(define (tasks:run-id->mtpg-run-id dbh cached-info run-id area-info) +(define (tasks:run-id->mtpg-run-id dbh cached-info run-id area-info smallest-last-update-time) (let* ((runs-ht (hash-table-ref cached-info 'runs)) (runinf (hash-table-ref/default runs-ht run-id #f)) (area-id (vector-ref area-info 0))) (if runinf runinf ;; already cached @@ -762,46 +762,53 @@ (if (and db-contour (not (equal? db-contour "")) (string? db-contour )) (begin (debug:print-info 1 *default-log-port* "db-contour") db-contour) (args:get-arg "-contour")))) + (last-update (db:get-value-by-header row header "last_update")) (keytarg (if (or (args:get-arg "-prepend-contour") (args:get-arg "-prefix-target")) (conc "MT_CONTOUR/MT_AREA/" (string-intersperse (rmt:get-keys) "/")) (string-intersperse (rmt:get-keys) "/"))) ;; e.g. version/iteration/platform (target (if (or (args:get-arg "-prepend-contour") (args:get-arg "-prefix-target")) (conc (or (args:get-arg "-prefix-target") (conc contour "/" (common:get-area-name) "/")) (rmt:get-target run-id)) (rmt:get-target run-id))) ;; e.g. v1.63/a3e1/ubuntu (spec-id (pgdb:get-ttype dbh keytarg)) - (new-run-id (pgdb:get-run-id dbh spec-id target run-name area-id)) - ;; (area-id (db:get-value-by-header row header "area_id)")) - ) - (if new-run-id - (begin ;; let ((run-record (pgdb:get-run-info dbh new-run-id)) - (hash-table-set! runs-ht run-id new-run-id) + (new-run-id (pgdb:get-run-id dbh spec-id target run-name area-id))) + (if new-run-id + (begin ;; let ((run-record (pgdb:get-run-info dbh new-run-id)) + (hash-table-set! runs-ht run-id new-run-id) ;; ensure key fields are up to date + ;; if last_update == pgdb_last_update do not update smallest-last-update-time + (let* ((pgdb-last-update (pgdb:get-run-last-update dbh new-run-id)) + (smallest-time (hash-table-ref/default smallest-last-update-time "smallest-time" #f))) + (if (and (> last-update pgdb-last-update) (or (not smallest-time) (< last-update smallest-time))) + (hash-table-set! smallest-last-update-time "smallest-time" last-update))) (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 area-id last-update) (debug:print-info 1 *default-log-port* "Working on run-id " run-id " pgdb-id" new-run-id ) new-run-id) (if (equal? state "deleted") - (begin - (debug:print-info 1 *default-log-port* "Warning: Run with id " run-id " was created after previous sync and deleted before the sync") #f) - (if (handle-exceptions - exn - (begin (print-call-chain) - (print ((condition-property-accessor 'exn 'message) exn)) - #f) - - (pgdb:insert-run + (begin + (debug:print-info 1 *default-log-port* "Warning: Run with id " run-id " was created after previous sync and deleted before the sync") #f) + (if (handle-exceptions + exn + (begin (print-call-chain) + (print ((condition-property-accessor 'exn 'message) exn)) + #f) + (print "inserting") + (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 area-info) + spec-id target run-name state status owner event-time comment fail-count pass-count area-id last-update)) + (let* ((smallest-time (hash-table-ref/default smallest-last-update-time "smallest-time" #f))) + (if (or (not smallest-time) (< last-update smallest-time)) + (hash-table-set! smallest-last-update-time "smallest-time" last-update)) + (tasks:run-id->mtpg-run-id dbh cached-info run-id area-info smallest-last-update-time)) #f))))))) -(define (tasks:sync-test-steps dbh cached-info test-step-ids) +(define (tasks:sync-test-steps dbh cached-info test-step-ids smallest-last-update-time) ; (print "Sync Steps " test-step-ids ) (let ((test-ht (hash-table-ref cached-info 'tests)) (step-ht (hash-table-ref cached-info 'steps))) (for-each (lambda (test-step-id) @@ -812,32 +819,39 @@ (state (tdb:step-get-state test-step-info)) (status (tdb:step-get-status test-step-info)) (event_time (tdb:step-get-event_time test-step-info)) (comment (tdb:step-get-comment test-step-info)) (logfile (tdb:step-get-logfile test-step-info)) + (last-update (tdb:step-get-last_update test-step-info)) (pgdb-test-id (hash-table-ref/default test-ht test-id #f)) - (pgdb-step-id (if pgdb-test-id - (pgdb:get-test-step-id dbh pgdb-test-id stepname state) - #f))) + (smallest-time (hash-table-ref/default smallest-last-update-time "smallest-time" #f)) + (pgdb-step-id (if pgdb-test-id + (pgdb:get-test-step-id dbh pgdb-test-id stepname state) + #f))) (if step-id (begin (if pgdb-test-id (begin (if pgdb-step-id (begin (debug:print-info 1 *default-log-port* "Updating existing test-step with test-id: " test-id " and step-id " step-id " pgdb test id: " pgdb-test-id " pgdb step id " pgdb-step-id ) - (pgdb:update-test-step dbh pgdb-step-id pgdb-test-id stepname state status event_time comment logfile)) + (let* ((pgdb-last-update (pgdb:get-test-step-last-update dbh pgdb-step-id))) + (if (and (> last-update pgdb-last-update) (or (not smallest-time) (< last-update smallest-time))) + (hash-table-set! smallest-last-update-time "smallest-time" last-update))) + (pgdb:update-test-step dbh pgdb-step-id pgdb-test-id stepname state status event_time comment logfile last-update)) (begin (debug:print-info 1 *default-log-port* "Inserting test-step with test-id: " test-id " and step-id " step-id " pgdb test id: " pgdb-test-id) - (pgdb:insert-test-step dbh pgdb-test-id stepname state status event_time comment logfile ) + (if (or (not smallest-time) (< last-update smallest-time)) + (hash-table-set! smallest-last-update-time "smallest-time" last-update)) + (pgdb:insert-test-step dbh pgdb-test-id stepname state status event_time comment logfile last-update ) (set! pgdb-step-id (pgdb:get-test-step-id dbh pgdb-test-id stepname state)))) (hash-table-set! step-ht step-id pgdb-step-id )) (debug:print-info 1 *default-log-port* "Error: Test not cashed"))) (debug:print-info 1 *default-log-port* "Error: Could not get test step info for step id " test-step-id )))) ;; this is a wierd senario need to debug test-step-ids))) -(define (tasks:sync-test-gen-data dbh cached-info test-data-ids) +(define (tasks:sync-test-gen-data dbh cached-info test-data-ids smallest-last-update-time) (let ((test-ht (hash-table-ref cached-info 'tests)) (data-ht (hash-table-ref cached-info 'data))) (for-each (lambda (test-data-id) (let* ((test-data-info (rmt:get-data-info-by-id test-data-id)) @@ -849,11 +863,14 @@ (expected (db:test-data-get-expected test-data-info)) (tol (db:test-data-get-tol test-data-info)) (units (db:test-data-get-units test-data-info)) (comment (db:test-data-get-comment test-data-info)) (status (db:test-data-get-status test-data-info)) - (type (db:test-data-get-type test-data-info)) + (type (db:test-data-get-type test-data-info)) + (last-update (db:test-data-get-last_update test-data-info)) + (smallest-time (hash-table-ref/default smallest-last-update-time "smallest-time" #f)) + (pgdb-test-id (hash-table-ref/default test-ht test-id #f)) (pgdb-data-id (if pgdb-test-id (pgdb:get-test-data-id dbh pgdb-test-id category variable) #f))) (if data-id @@ -861,39 +878,44 @@ (if pgdb-test-id (begin (if pgdb-data-id (begin (debug:print-info 1 *default-log-port* "Updating existing test-data with test-id: " test-id " and data-id " data-id " pgdb test id: " pgdb-test-id " pgdb data id " pgdb-data-id) - (pgdb:update-test-data dbh pgdb-data-id pgdb-test-id category variable value expected tol units comment status type)) + (let* ((pgdb-last-update (pgdb:get-test-data-last-update dbh pgdb-data-id))) + (if (and (> last-update pgdb-last-update) (or (not smallest-time) (< last-update smallest-time))) + (hash-table-set! smallest-last-update-time "smallest-time" last-update))) + (pgdb:update-test-data dbh pgdb-data-id pgdb-test-id category variable value expected tol units comment status type last-update)) (begin (debug:print-info 1 *default-log-port* "Inserting test-data with test-id: " test-id " and data-id " data-id " pgdb test id: " pgdb-test-id) (if (handle-exceptions exn (begin (print-call-chain) (print ((condition-property-accessor 'exn 'message) exn)) #f) - (pgdb:insert-test-data dbh pgdb-test-id category variable value expected tol units comment status type )) + (pgdb:insert-test-data dbh pgdb-test-id category variable value expected tol units comment status type last-update)) ;(tasks:run-id->mtpg-run-id dbh cached-info run-id area-info) (begin ;(pgdb:insert-test-data dbh pgdb-test-id category variable value expected tol units comment status type ) + (if (or (not smallest-time) (< last-update smallest-time)) + (hash-table-set! smallest-last-update-time "smallest-time" last-update)) (set! pgdb-data-id (pgdb:get-test-data-id dbh pgdb-test-id category variable))) - (exit)))) + #f))) (hash-table-set! data-ht data-id pgdb-data-id )) (begin (debug:print-info 1 *default-log-port* "Error: Test not in pgdb")))) (debug:print-info 1 *default-log-port* "Error: Could not get test data info for data id " test-data-id )))) ;; this is a wierd senario need to debug test-data-ids))) -(define (tasks:sync-tests-data dbh cached-info test-ids area-info) +(define (tasks:sync-tests-data dbh cached-info test-ids area-info smallest-last-update-time) (let ((test-ht (hash-table-ref cached-info 'tests))) (for-each (lambda (test-id) - ;(print test-id) + ; (print 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)) @@ -907,12 +929,13 @@ (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 area-info)) - + (last-update (db:test-get-last_update test-info)) + (pgdb-run-id (tasks:run-id->mtpg-run-id dbh cached-info run-id area-info smallest-last-update-time)) + (smallest-time (hash-table-ref/default smallest-last-update-time "smallest-time" #f)) (pgdb-test-id (if pgdb-run-id (begin ;(print pgdb-run-id) (pgdb:get-test-id dbh pgdb-run-id test-name item-path)) #f))) @@ -921,18 +944,23 @@ ;; "run_duration" "final_logf" "comment" "shortdir" "attemptnum" "archived" (if pgdb-run-id (begin (if pgdb-test-id ;; have a record (begin ;; let ((key-name (conc run-id "/" test-name "/" item-path))) - (debug:print-info 1 *default-log-port* "Updating existing test with run-id: " run-id " and test-id: " test-id " pgdb run id: " pgdb-run-id " pgdb-test-id " pgdb-test-id) - (pgdb:update-test dbh pgdb-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)) + (debug:print-info 0 *default-log-port* "Updating existing test with run-id: " run-id " and test-id: " test-id " pgdb run id: " pgdb-run-id " pgdb-test-id " pgdb-test-id) + (let* ((pgdb-last-update (pgdb:get-test-last-update dbh pgdb-test-id))) + (if (and (> last-update pgdb-last-update) (or (not smallest-time) (< last-update smallest-time))) + (hash-table-set! smallest-last-update-time "smallest-time" last-update))) + (pgdb:update-test dbh pgdb-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 last-update)) (begin - (debug:print-info 1 *default-log-port* "Inserting test with run-id: " run-id " and test-id: " test-id " pgdb run id: " pgdb-run-id) - (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) - (set! pgdb-test-id (pgdb:get-test-id dbh pgdb-run-id test-name item-path)))) - (hash-table-set! test-ht test-id pgdb-test-id)) - (debug:print-info 1 *default-log-port* "WARNING: Skipping run with run-id:" run-id ". This run was created after privious sync and removed before this sync.")))) + (debug:print-info 0 *default-log-port* "Inserting test with run-id: " run-id " and test-id: " test-id " pgdb run id: " pgdb-run-id) + (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 last-update) + (if (or (not smallest-time) (< last-update smallest-time)) + (hash-table-set! smallest-last-update-time "smallest-time" last-update)) + (set! pgdb-test-id (pgdb:get-test-id dbh pgdb-run-id test-name item-path)))) + (hash-table-set! test-ht test-id pgdb-test-id)) + (debug:print-info 1 *default-log-port* "WARNING: Skipping run with run-id:" run-id ". This run was created after privious sync and removed before this sync.")))) test-ids))) (define (task:add-area-tag dbh area-info tag) (let* ((tag-info (pgdb:get-tag-info-by-name dbh tag))) (if (not tag-info) @@ -952,15 +980,15 @@ (debug:print-info 1 *default-log-port* ((condition-property-accessor 'exn 'message) exn)) #f) (if (not (pgdb:is-area-taged-with-a-tag dbh (vector-ref tag-info 0) (vector-ref area-info 0))) (pgdb:insert-area-tag dbh (vector-ref tag-info 0) (vector-ref area-info 0)))))) -(define (tasks:sync-run-data dbh cached-info run-ids area-info) +(define (tasks:sync-run-data dbh cached-info run-ids area-info smallest-last-update-time) (for-each (lambda (run-id) (debug:print-info 1 *default-log-port* "Check if run with " run-id " needs to be synced" ) - (tasks:run-id->mtpg-run-id dbh cached-info run-id area-info)) + (tasks:run-id->mtpg-run-id dbh cached-info run-id area-info smallest-last-update-time)) run-ids)) ;; get runs changed since last sync ;; (define (tasks:sync-test-data dbh cached-info area-info) @@ -968,18 +996,41 @@ (define (tasks:sync-to-postgres configdat dest) (let* ((dbh (pgdb:open configdat dbname: dest)) (area-info (pgdb:get-area-by-path dbh *toppath*)) (cached-info (make-hash-table)) - (start (current-seconds))) + (start (current-seconds)) + (test-patt (if (args:get-arg "-testpatt") + (args:get-arg "-testpatt") + "%")) + (target (if (args:get-arg "-target") + (args:get-arg "-target") + #f)) + (run-name (if (args:get-arg "-runname") + (args:get-arg "-runname") + #f))) + (if (and target (not run-name)) + (begin + (print "Error: Provide runname") + (exit 1)) + (print target)) + (if (and (not target) run-name) + (begin + (print "Error: Provide target") + (exit 1)) + (print run-name)) + (for-each (lambda (dtype) (hash-table-set! cached-info dtype (make-hash-table))) '(runs targets tests steps data)) (hash-table-set! cached-info 'start start) ;; when done we'll set sync times to this (if area-info (let* ((last-sync-time (vector-ref area-info 3)) - (changed (rmt:get-changed-record-ids last-sync-time)) + (smallest-last-update-time (make-hash-table)) + (changed (if (and target run-name) + (rmt:get-run-record-ids target run-name (rmt:get-keys) test-patt) + (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)) @@ -990,20 +1041,25 @@ (set! area-tag *default-area-tag*)) (if (not (equal? area-tag "")) (task:add-area-tag dbh area-info area-tag)) (if (or (not (null? test-ids)) (not (null? run-ids))) (begin - (debug:print-info 1 *default-log-port* "Syncing " (length test-step-ids) " changed tests") - ;;Assumption here is that if test-step or test data is changed then the test last update time is changed - ;; not syncing run stats at this time as they can be derived from tests table. - (tasks:sync-tests-data dbh cached-info test-ids area-info) - ;(exit) - (tasks:sync-run-data dbh cached-info run-ids area-info) - (tasks:sync-test-steps dbh cached-info test-step-ids) - (tasks:sync-test-gen-data dbh cached-info test-data-ids))) - (pgdb:write-sync-time dbh area-info (- start 1))) + (print "syncing runs") + (tasks:sync-run-data dbh cached-info run-ids area-info smallest-last-update-time) + (print "syncing tests") + (tasks:sync-tests-data dbh cached-info test-ids area-info smallest-last-update-time) + (print "syncing test steps") + (tasks:sync-test-steps dbh cached-info test-step-ids smallest-last-update-time) + (print "syncing test data") + (tasks:sync-test-gen-data dbh cached-info test-data-ids smallest-last-update-time) + (print "----------done---------------"))) + (let* ((smallest-time (hash-table-ref/default smallest-last-update-time "smallest-time" #f))) + (print "smallest-time :" smallest-time " last-sync-time " last-sync-time) + (if (not (and target run-name)) + (if (or (and smallest-time (> smallest-time last-sync-time)) (and smallest-time (eq? last-sync-time 0))) + (pgdb:write-sync-time dbh area-info smallest-time))))) ;;this needs to be changed (if (tasks:set-area dbh configdat) (tasks:sync-to-postgres configdat dest) (begin (debug:print 0 *default-log-port* "ERROR: unable to create an area record") #f)))))