@@ -759,11 +759,11 @@ (pass-count (db:get-value-by-header row header "pass_count")) (db-contour (db:get-value-by-header row header "contour")) (contour (if (args:get-arg "-prepend-contour") (if (and db-contour (not (equal? db-contour ""))) (begin - (print "db-contour") + (debug:print-info 1 *default-log-port* "db-contour") db-contour) (args:get-arg "-contour")))) (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")) @@ -778,14 +778,16 @@ ;; 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) + (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 - (print "Warning: Run with id " run-id " was created after previous sync and deleted before the sync") #f) + (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) @@ -820,19 +822,19 @@ (begin (if pgdb-test-id (begin (if pgdb-step-id (begin - (print "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 ) + (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)) (begin - (print "Inserting test-step with test-id: " test-id " and step-id " step-id " pgdb test id: " pgdb-test-id) + (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 ) (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 )) - (print "Error: Test not cashed"))) - (print "Error: Could not get test step info for step id " test-step-id )))) ;; this is a wierd senario need to debug + (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) (let ((test-ht (hash-table-ref cached-info 'tests)) (data-ht (hash-table-ref cached-info 'data))) @@ -858,14 +860,14 @@ (begin (if pgdb-test-id (begin (if pgdb-data-id (begin - (print "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) + (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)) (begin - (print "Inserting test-data with test-id: " test-id " and data-id " data-id " pgdb test id: " pgdb-test-id) + (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) @@ -876,13 +878,13 @@ ;(pgdb:insert-test-data dbh pgdb-test-id category variable value expected tol units comment status type ) (set! pgdb-data-id (pgdb:get-test-data-id dbh pgdb-test-id category variable))) (exit)))) (hash-table-set! data-ht data-id pgdb-data-id )) (begin - (print "Error: Test not in pgdb")))) + (debug:print-info 1 *default-log-port* "Error: Test not in pgdb")))) - (print "Error: Could not get test data info for data id " test-data-id )))) ;; this is a wierd senario need to debug + (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) @@ -919,40 +921,48 @@ ;; "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))) - (print "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) + (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)) (begin - (print "Inserting test with run-id: " run-id " and test-id: " test-id " pgdb run id: " pgdb-run-id) + (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)) - (print "WARNING: Skipping run with run-id:" run-id ". This run was created after privious sync and removed before this sync.")))) + (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) (begin (if (handle-exceptions exn (begin - (print ((condition-property-accessor 'exn 'message) exn)) + (debug:print-info 1 *default-log-port* ((condition-property-accessor 'exn 'message) exn)) #f) (pgdb:insert-tag dbh tag)) (set! tag-info (pgdb:get-tag-info-by-name dbh tag)) #f))) ;;add to area_tags (handle-exceptions exn (begin - (print ((condition-property-accessor 'exn 'message) exn)) + (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) + (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)) +run-ids)) + ;; get runs changed since last sync ;; (define (tasks:sync-test-data dbh cached-info area-info) ;; (let* (( @@ -971,33 +981,29 @@ (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)) - (area-tag (if (args:get-arg "-area-tag") + (area-tag (if (args:get-arg "-area-tag") (args:get-arg "-area-tag") ""))) - ;(print "last-sync-time " last-sync-time) - - ;(print "test-ids: " test-ids) - ;(print "--------------------------------------") - ;(print "run-ids: " run-ids) (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 (not (null? test-ids)) (begin - (print "Syncing " (length test-step-ids) " changed tests") + (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-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)) + (pgdb:write-sync-time dbh area-info (- start 1))) (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)))))