174
175
176
177
178
179
180
181
182
183
184
185
186
187
|
(db (sqlite3:open-database dbfullname))
(handler (sqlite3:make-busy-timeout 136000)))
(sqlite3:set-busy-handler! db handler)
(if (and dbexists
write-access)
(init-proc db))
db))))
(define *sync-in-progress* #f)
;; Open the cachedb db and the on-disk db
;; populate the cachedb db with data
;;
;; Updates fields in dbstruct
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
|
(db (sqlite3:open-database dbfullname))
(handler (sqlite3:make-busy-timeout 136000)))
(sqlite3:set-busy-handler! db handler)
(if (and dbexists
write-access)
(init-proc db))
db))))
;; try every second until tries times proc
;;
(define (db:keep-trying-until-true proc params tries)
(let* ((res (apply proc params)))
(if res
res
(if (> tries 0)
(begin
(thread-sleep! 1)
(db:keep-trying-until-true proc params (- tries 1)))
(begin
;; (debug:print-info 0 *default-log-port* "proc never returned true, params="params)
(print"db:keep-trying-until-true proc never returned true, proc = " proc " params =" params " tries = " tries)
#f)))))
(define *sync-in-progress* #f)
;; Open the cachedb db and the on-disk db
;; populate the cachedb db with data
;;
;; Updates fields in dbstruct
|
794
795
796
797
798
799
800
801
802
803
804
805
806
807
|
(begin
(debug:print-info 0 *default-log-port* "Found old test in LAUNCHED state, test-id=" test-id
" 1 day since event_time marked")
(set! oldlaunched (cons (list test-id run-dir uname testname item-path run-id) oldlaunched)))))
stmth3
run-id))))
(list incompleted oldlaunched toplevels)))
;;======================================================================
;; db to db sync
;;======================================================================
(define (dbmod:db-to-db-sync src-db dest-db last-update init-proc keys)
(if (and (file-exists? src-db) ;; can't proceed without a source
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
|
(begin
(debug:print-info 0 *default-log-port* "Found old test in LAUNCHED state, test-id=" test-id
" 1 day since event_time marked")
(set! oldlaunched (cons (list test-id run-dir uname testname item-path run-id) oldlaunched)))))
stmth3
run-id))))
(list incompleted oldlaunched toplevels)))
(define (db:set-state-status-by-state-status dbstruct run-id testname currstate currstatus newstate newstatus)
;; clear caches needed
(let* ((qry (conc "UPDATE tests SET state=?,status=? WHERE "
(if currstate (conc "state='" currstate "' AND ") "")
(if currstatus (conc "status='" currstatus "' AND ") "")
" run_id=? AND testname LIKE ?;")))
(db:with-db
dbstruct
run-id
#t
(lambda (dbdat db)
(sqlite3:execute db qry
(or newstate currstate "NOT_STARTED")
(or newstatus currstate "UNKNOWN")
run-id testname)))))
(define (db:set-state-status-by-state-status dbstruct run-id testname currstate currstatus newstate newstatus)
;; clear caches needed
(let* ((qry (conc "UPDATE tests SET state=?,status=? WHERE "
(if currstate (conc "state='" currstate "' AND ") "")
(if currstatus (conc "status='" currstatus "' AND ") "")
" run_id=? AND testname LIKE ?;")))
(db:with-db
dbstruct
run-id
#t
(lambda (dbdat db)
(sqlite3:execute db qry
(or newstate currstate "NOT_STARTED")
(or newstatus currstate "UNKNOWN")
run-id testname)))))
;;======================================================================
;; db to db sync
;;======================================================================
(define (dbmod:db-to-db-sync src-db dest-db last-update init-proc keys)
(if (and (file-exists? src-db) ;; can't proceed without a source
|