Megatest

Diff
Login

Differences From Artifact [b5e5388382]:

To Artifact [cd6cb3bd8f]:


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







+
-
+





+
-
+
+









+
-
+
+







;; 
;; ;; Use to get a path. To get an arbitrary string see next define
;; ;;
;; (define (db:get-path dbstruct id)
;;   (let ((fdb (db:get-filedb dbstruct)))
;;     (filedb:get-path db id)))

;; NB// #f => return dbdir only
;; NB// #f => zeroth db with name=main.db
;;      (was planned to be;  zeroth db with name=main.db)
;;
(define (db:dbfile-path run-id)
  (let* (;; (toppath      (dbr:dbstruct-get-path  dbstruct))
	 (link-tree-path  (configf:lookup *configdat* "setup" "linktree"))
	 (dbpath          (configf:lookup *configdat* "setup" "dbdir"))
	 (fname           (if run-id
	 (fname           (if (eq? run-id 0) "main.db" (conc run-id ".db")))
			      (if (eq? run-id 0) "main.db" (conc run-id ".db"))
			      #f))
	 (dbdir           (if dbpath
			      dbpath
			      (conc link-tree-path "/.db/"))))
    (handle-exceptions
     exn
     (begin
       (debug:print 0 "ERROR: Couldn't create path to " dbdir)
       (exit 1))
     (if (not (directory? dbdir))(create-directory dbdir #t)))
    (if fname
    (conc dbdir fname)))
	(conc dbdir fname)
	dbdir)))
	       
(define (db:set-sync db)
  (let ((syncprag (configf:lookup *configdat* "setup" "sychronous")))
    (sqlite3:execute db (conc "PRAGMA synchronous = " (or syncprag 1) ";"))))

;; open an sql database inside a file lock
;;
267
268
269
270
271
272
273
274

275
276
277
278
279
280
281
272
273
274
275
276
277
278

279
280
281
282
283
284
285
286







-
+







	  (dbr:dbstruct-set-main!   dbstruct dbdat)
	  (dbr:dbstruct-set-olddb!  dbstruct olddb) ;; olddb is already a (cons db path)
	  dbdat))))

;; Make the dbstruct, setup up auxillary db's and call for main db at least once
;;
(define (db:setup run-id #!key (local #f))
  (let* ((dbdir    (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
  (let* ((dbdir    (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
	 (dbstruct (make-dbr:dbstruct path: dbdir local: local)))
    dbstruct))

;; Open the classic megatest.db file in toppath
;;
(define (db:open-megatest-db)
  (let* ((dbpath       (conc *toppath* "/megatest.db"))