Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -3122,14 +3122,14 @@ db "SELECT id,test_id,stepname,state,status,event_time,logfile,comment FROM test_steps WHERE status != 'DELETED' AND test_id=? ORDER BY id ASC;" ;; event_time DESC,id ASC; test-id) (reverse res))))) - (define (db:get-steps-info-by-id dbstruct test-step-id) + (define (db:get-steps-info-by-id dbstruct run-id test-step-id) (db:with-db dbstruct - #f + run-id #f (lambda (dbdat db) (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 last-update) @@ -3156,15 +3156,15 @@ ;;====================================================================== ;; T E S T D A T A ;;====================================================================== -(define (db:get-data-info-by-id dbstruct test-data-id) +(define (db:get-data-info-by-id dbstruct run-id test-data-id) (let* ((stmt "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; (db:with-db dbstruct - #f + run-id #f (lambda (dbdat db) (let* ((stmth (db:get-cache-stmth dbdat #f db stmt)) (res (sqlite3:fold-row (lambda (res id test-id category variable value expected tol units comment status type last-update) @@ -4374,26 +4374,82 @@ ;;====================================================================== ;; 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 ...) ...)) +;; get an alist of run ids and test/run, test_step/run pairs changed since time since-time +;; '((runs . (1 2 3 ...))(tests . ((5 . 1) (6 . 3) (6 . 2) (7 . 1) ... ;; (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 (dbdat db) - `((runs . ,(sqlite3:fold-row backcons '() db "SELECT id FROM runs WHERE last_update>=?" since-time)) - (tests . ,(sqlite3:fold-row backcons '() db "SELECT id FROM tests WHERE last_update>=?" since-time)) - (test_steps . ,(sqlite3:fold-row backcons '() db "SELECT id FROM test_steps WHERE last_update>=?" since-time)) - (test_data . ,(sqlite3: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 . ,(sqlite3:fold-row backcons '() db "SELECT id FROM run_stats WHERE last_update>=?" since-time)) - ))))) + (let* ((backcons (lambda (lst item)(cons item lst))) + (all_tests '()) + (all_test_steps '()) + (all_test_data '()) + + (run_ids + (db:with-db dbstruct #f #f + (lambda (dbdat db) + (sqlite3:fold-row backcons '() db "SELECT id FROM runs WHERE last_update>=?" since-time)) + ) + ) + (run_stat_ids + (db:with-db dbstruct #f #f + (lambda (dbdat db) + (sqlite3:fold-row backcons '() db "SELECT id FROM run_stats WHERE last_update>=?" since-time)) + ) + ) + ) + (for-each + (lambda (run_id) + (set! all_tests + (append + (map (lambda (x) (cons x run_id)) + (db:with-db dbstruct run_id #f + (lambda (dbdat db) + (sqlite3:fold-row backcons '() db "SELECT id FROM tests WHERE last_update>=?" since-time) + ) + ) + ) all_tests + ) + ) + (set! all_test_steps + (append + (map (lambda (x) (cons x run_id)) + (db:with-db dbstruct run_id #f + (lambda (dbdat db) + (sqlite3:fold-row backcons '() db "SELECT id FROM test_steps WHERE last_update>=?" since-time) + ) + ) + ) all_test_steps + ) + ) + (set! all_test_data + (append + (map (lambda (x) (cons x run_id)) + (db:with-db dbstruct run_id #f + (lambda (dbdat db) + (sqlite3:fold-row backcons '() db "SELECT id FROM test_data WHERE last_update>=?" since-time) + ) + ) + ) all_test_data + ) + ) + ) + run_ids + ) + (debug:print 2 *default-log-port* "run_ids = " run_ids) + (debug:print 2 *default-log-port* "all_tests = " all_tests) + + `((runs . ,run_ids) + (tests . ,all_tests) + (test_steps . ,all_test_steps) + (test_data . ,all_test_data) + (run_stats . ,run_stat_ids) + ) + ) +) ;;====================================================================== ;; Extract ods file from the db ;;====================================================================== Index: rmt.scm ================================================================== --- rmt.scm +++ rmt.scm @@ -891,12 +891,12 @@ (rmt:send-receive 'delete-steps-for-test! run-id (list run-id test-id))) (define (rmt:get-steps-for-test run-id test-id) (rmt:send-receive 'get-steps-for-test run-id (list run-id test-id))) -(define (rmt:get-steps-info-by-id test-step-id) - (rmt:send-receive 'get-steps-info-by-id #f (list test-step-id))) +(define (rmt:get-steps-info-by-id run-id test-step-id) + (rmt:send-receive 'get-steps-info-by-id #f (list run-id test-step-id))) ;;====================================================================== ;; T E S T D A T A ;;====================================================================== @@ -904,12 +904,12 @@ (rmt:send-receive 'read-test-data run-id (list run-id test-id categorypatt))) (define (rmt:read-test-data-varpatt run-id test-id categorypatt varpatt #!key (work-area #f)) (rmt:send-receive 'read-test-data-varpatt run-id (list run-id test-id categorypatt varpatt))) -(define (rmt:get-data-info-by-id test-data-id) - (rmt:send-receive 'get-data-info-by-id #f (list test-data-id))) +(define (rmt:get-data-info-by-id run-id test-data-id) + (rmt:send-receive 'get-data-info-by-id #f (list run-id test-data-id))) (define (rmt:testmeta-add-record testname) (rmt:send-receive 'testmeta-add-record #f (list testname))) (define (rmt:testmeta-get-record testname) Index: tasks.scm ================================================================== --- tasks.scm +++ tasks.scm @@ -838,14 +838,20 @@ (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))) + (step-ht (hash-table-ref cached-info 'steps)) + (run-id-in #f) + ) (for-each (lambda (test-step-id) - (let* ((test-step-info (rmt:get-steps-info-by-id test-step-id)) + (set! run-id-in (cdr test-step-id)) + (set! test-step-id (car test-step-id)) + + + (let* ((test-step-info (rmt:get-steps-info-by-id run-id-in test-step-id)) (step-id (tdb:step-get-id test-step-info)) (test-id (tdb:step-get-test_id test-step-info)) (stepname (tdb:step-get-stepname test-step-info)) (state (tdb:step-get-state test-step-info)) (status (tdb:step-get-status test-step-info)) @@ -939,15 +945,19 @@ test-data-ids))) (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))) + (let ((test-ht (hash-table-ref cached-info 'tests)) + (run-id-in #f)) (for-each (lambda (test-id) - ; (print test-id) - (let* ((test-info (rmt:get-test-info-by-id #f test-id)) + (set! run-id-in (cdr test-id)) + (set! test-id (car test-id)) + + (debug:print 0 *default-log-port* "test-id: " test-id " run-id: " run-id-in) + (let* ((test-info (rmt:get-test-info-by-id run-id-in 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)) @@ -973,11 +983,11 @@ #f))) ;; "id" "run_id" "testname" "state" "status" "event_time" ;; "host" "cpuload" "diskfree" "uname" "rundir" "item_path" ;; "run_duration" "final_logf" "comment" "shortdir" "attemptnum" "archived" (if (or (not item-path) (string-null? item-path)) - (debug:print-info 0 *default-log-port* "Working on Run id : " run-id "and test name : " test-name)) + (debug:print-info 0 *default-log-port* "Working on Run id : " run-id " and test name : " test-name)) (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 4 *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) @@ -1075,21 +1085,26 @@ "")))) (if (and (equal? area-tag "") (not (pgdb:is-area-taged dbh (vector-ref area-info 0)))) (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 0 *default-log-port* "syncing runs") - (tasks:sync-run-data dbh cached-info run-ids area-info smallest-last-update-time) - (debug:print-info 0 *default-log-port* "syncing tests") - (tasks:sync-tests-data dbh cached-info test-ids area-info smallest-last-update-time) - (debug:print-info 0 *default-log-port* "syncing test steps") - (tasks:sync-test-steps dbh cached-info test-step-ids smallest-last-update-time) - (debug:print-info 0 *default-log-port* "syncing test data") - (tasks:sync-test-gen-data dbh cached-info test-data-ids smallest-last-update-time) - (print "----------done---------------"))) + (if (not (null? run-ids)) + (begin + (debug:print-info 0 *default-log-port* "syncing runs: " run-ids) + (tasks:sync-run-data dbh cached-info run-ids area-info smallest-last-update-time) + ) + ) + (if (not (null? test-ids)) + (begin + (debug:print-info 0 *default-log-port* "syncing tests: " test-ids) + (tasks:sync-tests-data dbh cached-info test-ids area-info smallest-last-update-time) + (debug:print-info 0 *default-log-port* "syncing test steps") + (tasks:sync-test-steps dbh cached-info test-step-ids smallest-last-update-time) + (debug:print-info 0 *default-log-port* "syncing test data") + (tasks:sync-test-gen-data dbh cached-info test-data-ids smallest-last-update-time) + ) + ) (let* ((smallest-time (hash-table-ref/default smallest-last-update-time "smallest-time" (current-seconds)))) (debug:print-info 0 "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