Megatest

Diff
Login

Differences From Artifact [043beb90c3]:

To Artifact [75595b50f0]:


15
16
17
18
19
20
21



22
23
24
25
26
27
28
29










30

31
32
33
34
35












36


37
38
39

40





41


42








43
44
45














46
47
48
49






50
51

52
53

54


55
56
15
16
17
18
19
20
21
22
23
24
25
26
27
28




29
30
31
32
33
34
35
36
37
38
39
40





41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57

58
59
60
61
62
63
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
95
96

97


98

99
100
101
102







+
+
+




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

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

+
+


-
+

+
+
+
+
+
-
+
+

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

-
+
-
-
+
-
+
+


;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

(declare (unit dbmod))
(declare (uses dbfile))
(declare (uses commonmod))
(declare (uses debugprint))

(module dbmod
	*
	
(import scheme chicken data-structures extras)
(import (prefix sqlite3 sqlite3:)
	posix typed-records srfi-18
	srfi-69)
(import scheme
	chicken
	data-structures
	extras

	(prefix sqlite3 sqlite3:)
	posix
	typed-records
	srfi-18
	srfi-69

	commonmod
(define (db:run-id->dbname run-id)
  (cond
   ((number? run-id)(conc run-id ".db"))
   ((not run-id)    "main.db")
   (else            run-id)))
	dbfile
	debugprint
	)

;; NOTE: This returns only the name "1.db", "main.db", not the path
;;
(define (dbmod:run-id->dbfname run-id)
  (conc (dbfile:run-id->dbnum run-id)".db"))

(define (dbmod:get-dbdir dbstruct run-id)
  (let* ((areapath (dbr:dbstruct-areapath dbstruct)))
    (conc areapath"/.megatest")))

(define (dbmod:run-id->full-dbfname dbstruct run-id)
  (conc (dbmod:get-dbdir dbstruct run-id)"/"(dbmod:run-id->dbfname run-id)))

;;======================================================================
;; hash of hashs
;; The inmem one-db file per server method goes in here
;;======================================================================

(define (dbmod:open-inmem-db initproc)
  (let* ((db      (sqlite3:open-database ":memory:"))
	 (handler (sqlite3:make-busy-timeout 3600)))
    (sqlite3:set-busy-handler! db handler)

    (initproc db)
    db))

;; Open the inmem db and the on-disk db
;; populate the inmem db with data
;;
;; Updates fields in dbstruct
;; Returns dbstruct
;;
;; This routine creates the db if not found
;; 
(define (db:hoh-set! dat key1 key2 val)
  (let* ((subhash (hash-table-ref/default dat key1 #f)))
    (if subhash
(define (db:open-dbmoddb dbstruct run-id init-proc) ;;  (conc *toppath* "/megatest.db") (car *configinfo*)))
  (let* ((dbfname      (dbmod:run-id->dbfname run-id))
	 (dbpath       (dbmod:get-dbdir dbstruct run-id))             ;; directory where all the .db files are kept
	 (dbfullname   (dbmod:run-id->full-dbfname dbstruct run-id))
	 (dbexists     (file-exists? dbfullname))
	 (inmem        (dbmod:open-inmem-db init-proc))
	 (write-access (file-write-access? dbpath))
	 (db           (dbfile:with-simple-file-lock
			(conc dbfullname".lock")
			(lambda ()
			  (let* ((db      (sqlite3:open-database dbfullname))
				 (handler (sqlite3:make-busy-timeout 136000)))
			    (sqlite3:set-busy-handler! db handler)
			    (if write-access
	(hash-table-set! subhash key2 val)
	(begin
	  (hash-table-set! dat key1 (make-hash-table))
	  (db:hoh-set! dat key1 key2 val)))))
				(init-proc db))
			    db)))))
    (dbr:dbstruct-inmem-set!    dbstruct inmem)
    (dbr:dbstruct-ondiskdb-set! dbstruct db)
    (dbr:dbstruct-dbfile-set!   dbstruct dbfullname)
    dbstruct))

(define (db:hoh-get dat key1 key2)
(define (dbmod:close-db dbstruct)
  (let* ((subhash (hash-table-ref/default dat key1 #f)))
    (and subhash
  ;; do final sync to disk file
	 (hash-table-ref/default subhash key2 #f))))
  ;; (do-sync ...)
  (sqlite3:finalize! (dbr:dbstruct-ondiskdb dbstruct)))

)