Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -318,21 +318,26 @@ (let* ((dbpath (db:dbfile-path )) ;; path to tmp db area (dbexists (common:file-exists? dbpath)) (tmpdbfname (conc dbpath "/megatest.db")) (dbfexists (common:file-exists? tmpdbfname)) ;; (conc dbpath "/megatest.db"))) (mtdbexists (common:file-exists? (conc *toppath* "/megatest.db"))) - + + (mtdbmodtime (if mtdbexists (common:lazy-sqlite-db-modification-time (conc *toppath* "/megatest.db")) #f)) + (tmpdbmodtime (if dbfexists (common:lazy-sqlite-db-modification-time tmpdbfname) #f)) (mtdb (db:open-megatest-db)) (mtdbpath (db:dbdat-get-path mtdb)) (tmpdb (db:open-megatest-db path: dbpath)) ;; lock-create-open dbpath db:initialize-main-db)) (refndb (db:open-megatest-db path: dbpath name: "megatest_ref.db")) (write-access (file-write-access? mtdbpath)) - (mtdbmodtime (if mtdbexists (common:lazy-sqlite-db-modification-time mtdbpath) #f)) - (tmpdbmodtime (if dbfexists (common:lazy-sqlite-db-modification-time tmpdbfname) #f)) + ;(mtdbmodtime (if mtdbexists (common:lazy-sqlite-db-modification-time mtdbpath) #f)) ; moving this before db:open-megatest-db is called. if wal mode is on -WAL and -shm file get created with causing the tmpdbmodtime timestamp always greater than mtdbmodtime + ;(tmpdbmodtime (if dbfexists (common:lazy-sqlite-db-modification-time tmpdbfname) #f)) + ;if wal mode is on -WAL and -shm file get created when db:open-megatest-db is called. modtimedelta will always be < 10 so db in tmp not get synced + ;(tmpdbmodtime (if dbfexists (db:get-last-update-time (car tmpdb)) #f)) + ;(fmt (file-modification-time tmpdbfname)) (modtimedelta (and mtdbmodtime tmpdbmodtime (- mtdbmodtime tmpdbmodtime)))) - - ;;(debug:print-info 13 *default-log-port* "db:open-db>> mtdbpath="mtdbpath" mtdbexists="mtdbexists" and write-access="write-access) + (print "mtdbmodtime " mtdbmodtime " tmpdbmodtime " tmpdbmodtime " mtdbpath " mtdbpath " " (conc *toppath* "/megatest.db")) + ;;(debug:print-info 13 *default-log-port* "db:open-db>> mtdbpath="mtdbpath" mtdbexists="mtdbexists" and write-access="write-access) (if (and dbexists (not write-access)) (begin (set! *db-write-access* #f) (dbr:dbstruct-read-only-set! dbstruct #t))) (dbr:dbstruct-mtdb-set! dbstruct mtdb) @@ -346,16 +351,32 @@ (> modtimedelta 10))) ;; if db in tmp is over ten seconds older than the file in MTRA then do a sync back do-sync) (begin (debug:print 1 *default-log-port* "filling db " (db:dbdat-get-path tmpdb) " with data \n from " (db:dbdat-get-path mtdb) " mod time delta: " modtimedelta) (db:sync-tables (db:sync-all-tables-list dbstruct) #f mtdb refndb tmpdb) + ;touch tmp db to avoid wal mode wierdness + (set! (file-modification-time tmpdbfname) (current-seconds)) (debug:print-info 13 *default-log-port* "db:sync-all-tables-list done.") ) (debug:print 4 *default-log-port* " db, " (db:dbdat-get-path tmpdb) " already exists or fresh enough, not propogating data from\n " (db:dbdat-get-path mtdb) " mod time delta: " modtimedelta) ) ;; (db:multi-db-sync dbstruct 'old2new)) ;; migrate data from megatest.db automatically tmpdb)))) + +(define (db:get-last-update-time db) +; (db:with-db +; dbstruct #f #f +; (lambda (db) + (let ((last-update-time #f)) + (sqlite3:for-each-row + (lambda (lup) + (set! last-update-time lup)) + db + "select max(lup) from ( select max(last_update) as lup from tests union select max(last_update) as lup from runs);") + last-update-time)) +;)) + ;; Make the dbstruct, setup up auxillary db's and call for main db at least once ;; ;; called in http-transport and replicated in rmt.scm for *local* access. ;; (define (db:setup do-sync #!key (areapath #f)) Index: mtut.scm ================================================================== --- mtut.scm +++ mtut.scm @@ -1537,18 +1537,18 @@ (set-signal-handler! signal/int (lambda (signum) (set! *time-to-exit* #t) (debug:print-error 0 *default-log-port* "Received signal " signum " sending email befor exiting !!") (let ((email-body (mtut:stml->string (s:body (s:p (conc "Received signal " signum ". Lister has been terminated on host " (get-environment-variable "HOST") ". ")))))) - (sendmail "priyanka.j.hatwalne@intel.com" "Listner has been terminated." email-body use_html: #t)) + (sendmail contact "Listner has been terminated." email-body use_html: #t)) (exit))) (set-signal-handler! signal/term (lambda (signum) (set! *time-to-exit* #t) (debug:print-error 0 *default-log-port* "Received signal " signum " sending email befor exiting !!") (let ((email-body (mtut:stml->string (s:body (s:p (conc "Received signal " signum ". Lister has been terminated on host " (get-environment-variable "HOST") ". ")))))) - (sendmail "priyanka.j.hatwalne@intel.com" "Listner has been terminated." email-body use_html: #t)) + (sendmail contact "Listner has been terminated." email-body use_html: #t)) (exit))) ;(set-signal-handler! signal/term special-signal-handler) (let loop ((instr (nn-recv rep))) Index: tasks.scm ================================================================== --- tasks.scm +++ tasks.scm @@ -796,11 +796,11 @@ (tasks:run-id->mtpg-run-id dbh cached-info run-id area-info) #f))))))) (define (tasks:sync-test-steps dbh cached-info test-step-ids) - (print "Sync Steps " test-step-ids ) + ; (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) (let* ((test-step-info (rmt:get-steps-info-by-id test-step-id)) @@ -820,11 +820,11 @@ (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 ) + (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 ) (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) (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)))) @@ -858,11 +858,11 @@ (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) + (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) (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) (if (handle-exceptions exn @@ -919,11 +919,11 @@ ;; "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) + (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) (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) (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)))) @@ -974,11 +974,15 @@ (test-data-ids (alist-ref 'test_data changed)) (run-stat-ids (alist-ref 'run_stats changed)) (area-tag (if (args:get-arg "-area-tag") (args:get-arg "-area-tag") ""))) - ; (print "area-info: " area-info) + ;(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))