Megatest

Diff
Login

Differences From Artifact [25f8271ef2]:

To Artifact [8d67468750]:


64
65
66
67
68
69
70

71
72
73
74
75
76
77
78
79
80
81
82
83
84



85
86
87
88
89
90
91
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84

85
86
87
88
89
90
91
92
93
94







+













-
+
+
+







  (dbname      #f) ;; .megatest/1.db
  (mtdbfile    #f) ;; mtrah/.megatest/1.db
  (mtdbdat     #f) ;; only need one of these for syncing
  ;; (dbdats      (make-hash-table))  ;; id => dbdat 
  (tmpdbfile   #f) ;; /tmp/.../.megatest/1.db
  ;; (refndbfile  #f) ;; /tmp/.../.megatest/1.db_ref
  (dbstack     (make-stack)) ;; stack for tmp dbr:dbdat,
  (stack-mutex (make-mutex)) ;; gate pop, push, peek and replace with this mutex (allows safe clean up of old handles)
  (homehost    #f) ;; not used yet
  (on-homehost #f) ;; not used yet
  (read-only   #f)
  (last-sync   0)
  (last-write  (current-seconds))
  )                ;; goal is to converge on one struct for an area but for now it is too confusing

;; need to keep dbhandles and cached statements together
(defstruct dbr:dbdat
  (dbfile      #f)
  (dbh         #f)    
  (stmt-cache  (make-hash-table))
  (read-only   #f)
  (birth-sec   (current-seconds)))
  (birth-sec   (current-seconds))
  (last-used   (current-seconds))
  (in-use      #f))

(define *dbstruct-dbs* #f)
(define *db-open-mutex* (make-mutex))
(define *db-access-mutex* (make-mutex)) ;; used in common.scm
(define *no-sync-db*   #f)
(define *db-sync-in-progress* #f)
(define *db-with-db-mutex*    (make-mutex))
126
127
128
129
130
131
132
133

134
135
136
137
138
139
140
141
142
143
144






145
146
147
148
149
150
151
152






153
154
155


156
157
158
159




























160
161
162
163
164
165
166
167
129
130
131
132
133
134
135

136











137
138
139
140
141
142








143
144
145
146
147
148



149
150




151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178

179
180
181
182
183
184
185







-
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-







             (dbfile:print-err "db:safely-close-sqlite3-db: " db " is not an sqlite3 db")
	     #f
            )
        ))))

;; close all opened run-id dbs
(define (db:close-all dbstruct)
  (if (dbr:dbstruct? dbstruct)
  (assert (dbr:dbstruct? dbstruct) "FATAL: db:close-all called with non-dbstruct "dbstruct)
;; (handle-exceptions
;; 	  exn
;; 	  (begin
;; 	    (debug:print 0 *default-log-port* "WARNING: Finalizing failed, "  ((condition-property-accessor 'exn 'message) exn) ", note - exn=" exn)
;; 	    (print-call-chain *default-log-port*))
	;; (db:sync-touched dbstruct 0 force-sync: #t) ;; NO. Do not do this here. Instead we rely on a server to be started when there are writes, even if the server itself is not going to be used as a server.
        (let* ((subdbs     (hash-table-values (dbr:dbstruct-subdbs dbstruct))))
	  (for-each
	   (lambda (subdb)
	     (let* ((tdbs       (stack->list (dbr:subdb-dbstack subdb)))
		    (mtdbdat    (dbr:dbdat-dbh (dbr:subdb-mtdbdat subdb)))
  (let* ((subdbs     (hash-table-values (dbr:dbstruct-subdbs dbstruct))))
    (for-each
     (lambda (subdb)
       (mutex-lock! (dbr:subdb-stack-mutex subdb))
       (let* ((tdbs       (stack->list (dbr:subdb-dbstack subdb)))
	      (mtdbdat    (dbr:dbdat-dbh (dbr:subdb-mtdbdat subdb))))
		    #;(rdb        (dbr:dbdat-dbh (dbr:subdb-refndb subdb))))
		    
	       (map (lambda (dbdat)
		      (let* ((stmt-cache (dbr:dbdat-stmt-cache dbdat))
			     (dbh        (dbr:dbdat-dbh        dbdat)))
			(db:safely-close-sqlite3-db dbh stmt-cache)))
		    tdbs)
	       (db:safely-close-sqlite3-db mtdbdat (dbr:dbdat-stmt-cache  (dbr:subdb-mtdbdat subdb))) 
	 (map (lambda (dbdat)
		(let* ((stmt-cache (dbr:dbdat-stmt-cache dbdat))
		       (dbh        (dbr:dbdat-dbh        dbdat)))
		  (db:safely-close-sqlite3-db dbh stmt-cache)))
	      tdbs)
	 (db:safely-close-sqlite3-db mtdbdat (dbr:dbdat-stmt-cache  (dbr:subdb-mtdbdat subdb))))
               ;; (if (sqlite3:database? mdb) (sqlite3:finalize! mdb))
	       #;(db:safely-close-sqlite3-db rdb #f))) ;; stmt-cache))))) ;; (if (sqlite3:database? rdb) (sqlite3:finalize! rdb))))))
	   subdbs)
       (mutex-unlock! (dbr:subdb-stack-mutex subdb)))
     subdbs)))
           #t
          )
          #f
  )

;; close  opened run-id dbs that haven't been used in age seconds
(define (db:close-old dbstruct #!key (age 30)) ;; close dbs older than this age
  (assert (dbr:dbstruct? dbstruct) "FATAL: db:close-all called with non-dbstruct "dbstruct)
  (let* ((subdbs     (hash-table-values (dbr:dbstruct-subdbs dbstruct))))
    (for-each
     (lambda (subdb)
       (mutex-lock! (dbr:subdb-stack-mutex subdb))
       (let* ((tdbs       (stack->list (dbr:subdb-dbstack subdb)))
	      (mtdbdat    (dbr:dbdat-dbh (dbr:subdb-mtdbdat subdb))))
	 (dbr:subdb-dbstack-set! subdb (make-stack)) ;; replace the stack with a new one
	 (map (lambda (dbdat)
		(assert (dbr:dbdat-in-use dbdat) "FATAL: dbdat in stack was in use "(dbr:dbdat-dbfile dbdat))
		(if (< (- (current-seconds)
			  (dbr:dbdat-last-used dbdat))
		       age)
		    (stack-push! (dbr:subdb-dbstack subdb) dbdat)    ;; keep it
		    (let* ((stmt-cache (dbr:dbdat-stmt-cache dbdat)) ;; close and discard
			   (dbh        (dbr:dbdat-dbh        dbdat)))
		      (dbfile:print-err "INFO: closing unused dbdat for "(dbr:dbdat-dbfile dbdat))
		      (db:safely-close-sqlite3-db dbh stmt-cache))))
	      tdbs)
	 (let* ((size  (stack-count (dbr:subdb-dbstack subdb)))
		(delta (- (length tdbs) size)))
	   (if (> delta 0)
	       (dbfile:print-err "INFO: removed "delta" and "size" dbs left."))))
       (mutex-unlock! (dbr:subdb-stack-mutex subdb)))
     subdbs)))
)

;; ;; set up a single db (e.g. main.db, 1.db ... etc.)
;; ;;
;; (define (db:setup-db dbstruct areapath run-id)
;;   (let* ((dbname   (db:run-id->dbname run-id))
;; 	 (dbstruct (hash-table-ref/default dbstructs dbname #f)))
;;     (if dbstruct
232
233
234
235
236
237
238

239
240


241
242






243
244
245
246

247
248
249
250
251
252
253
250
251
252
253
254
255
256
257


258
259


260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277







+
-
-
+
+
-
-
+
+
+
+
+
+




+







;;    if run-id is a string treat it as a filename
;;    if db already open - return inmem
;;    if db not open, open inmem, rundb and sync then return inmem
;;    inuse gets set automatically for rundb's
;;
(define (dbfile:get-dbdat dbstruct run-id)
  (let* ((subdb (dbfile:get-subdb dbstruct run-id)))
    (mutex-lock! (dbr:subdb-stack-mutex subdb))
    (if (stack-empty? (dbr:subdb-dbstack subdb))
	#f
    (let* ((res (if (stack-empty? (dbr:subdb-dbstack subdb))
		    #f
	(begin
	  (stack-pop! (dbr:subdb-dbstack subdb))))))
		    (let ((dbdat (stack-pop! (dbr:subdb-dbstack subdb))))
		      (dbr:dbdat-last-used-set! dbdat (current-seconds))
		      (dbr:dbdat-in-use-set! dbdat #t)
		      dbdat))))
      (mutex-unlock! (dbr:subdb-stack-mutex subdb))
      res)))

;; return a previously opened db handle to the stack of available handles
(define (dbfile:add-dbdat dbstruct run-id dbdat)
  (let* ((subdb (dbfile:get-subdb dbstruct run-id)))
    (dbr:dbdat-in-use-set! dbdat #f)
    (stack-push! (dbr:subdb-dbstack subdb) dbdat)
    dbdat))

;; set up a subdb
;;
(define (dbfile:init-subdb dbstruct run-id init-proc)
  (let* ((dbname    (dbfile:run-id->dbname run-id))