Megatest

Diff
Login

Differences From Artifact [eace504e02]:

To Artifact [e69a6c5870]:


282
283
284
285
286
287
288
289
290



291
292
293
294
295
296
297
298
299
300
301
302
303
304
305

306
307

308
309

310
311
312
313

314
315
316
317
318
319
320
282
283
284
285
286
287
288


289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305

306


307
308

309
310
311
312

313
314
315
316
317
318
319
320







-
-
+
+
+














-
+
-
-
+

-
+



-
+







	       (dbfexists    (file-exists? tmpdbfname)) ;; (conc dbpath "/megatest.db")))
               (tmpdb        (db:open-megatest-db path: dbpath)) ;; lock-create-open dbpath db:initialize-main-db))
               (mtdb         (db:open-megatest-db))
               (mtdbpath     (db:dbdat-get-path mtdb))
               (mtdbexists   (file-exists? mtdbpath))
               (refndb       (db:open-megatest-db path: dbpath name: "megatest_ref.db"))
               (write-access (file-write-access? mtdbpath))
	       (mtdbmodtime  (if mtdbexists (file-modification-time mtdbpath)   #f))
	       (tmpdbmodtime (if dbfexists  (file-modification-time tmpdbfname) #f)))
	       (mtdbmodtime  (if mtdbexists (common:lazy-sqlite-db-modification-time mtdbpath)   #f))
	       (tmpdbmodtime (if dbfexists  (common:lazy-sqlite-db-modification-time tmpdbfname) #f))
	       (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)
          (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)
          (dbr:dbstruct-tmpdb-set!  dbstruct tmpdb)
          (dbr:dbstruct-dbstack-set! dbstruct (make-stack)) ;; BB: why a stack?  Why would the number of db's be indeterminate?  Is this a legacy of 1.db 2.db .. ?
          (stack-push! (dbr:dbstruct-dbstack dbstruct) tmpdb) ;; olddb is already a (cons db path)
          (dbr:dbstruct-refndb-set! dbstruct refndb)
          ;;	    (mutex-unlock! *rundb-mutex*)
          (if (and write-access
		   (or (not dbfexists)
		       (not mtdbmodtime)
		       (and modtimedelta
		       (not tmpdbmodtime)
		       (> (- mtdbmodtime tmpdbmodtime) 10))) ;; if db in tmp is over ten seconds older than the file in MTRA then do a sync back
			    (> modtimedelta 10)))) ;; if db in tmp is over ten seconds older than the file in MTRA then do a sync back
	      (begin
		(debug:print 0 *default-log-port* "filling db " (db:dbdat-get-path tmpdb) " with data from " (db:dbdat-get-path mtdb))
		(debug:print 0 *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)
                (debug:print-info 13 *default-log-port* "db:sync-all-tables-list done.")
                )
	      (debug:print 0 *default-log-port* " db, " (db:dbdat-get-path tmpdb) " already exists or fresh enough, not propogating data from " (db:dbdat-get-path mtdb)))
	      (debug:print 0 *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))))

;; 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. 
;;