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
|
;; timestamp type (val1 val2 ...)
;; type: meta-info, step
(define *incoming-data* '())
(define *incoming-last-time* (current-seconds))
(define *incoming-mutex* (make-mutex))
(define *cache-on* #f)
(define (open-db) ;; (conc *toppath* "/megatest.db") (car *configinfo*)))
(let* ((dbpath (conc *toppath* "/megatest.db")) ;; fname)
(dbexists (file-exists? dbpath))
(db (sqlite3:open-database dbpath)) ;; (never-give-up-open-db dbpath))
(handler (make-busy-timeout (if (args:get-arg "-override-timeout")
(string->number (args:get-arg "-override-timeout"))
36000)))) ;; 136000)))
(sqlite3:set-busy-handler! db handler)
(if (not dbexists)
(db:initialize db))
db))
(define (db:initialize db)
(let* ((configdat (car *configinfo*)) ;; tut tut, global warning...
(keys (config-get-fields configdat))
(havekeys (> (length keys) 0))
(keystr (keys->keystr keys))
(fieldstr (keys->key/field keys)))
(for-each (lambda (key)
(let ((keyn (vector-ref key 0)))
(if (member (string-downcase keyn)
|
|
|
|
|
|
|
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
|
;; timestamp type (val1 val2 ...)
;; type: meta-info, step
(define *incoming-data* '())
(define *incoming-last-time* (current-seconds))
(define *incoming-mutex* (make-mutex))
(define *cache-on* #f)
(define (open-db #!key (path #f)) ;; (conc *toppath* "/megatest.db") (car *configinfo*)))
(let* ((dbpath (conc (if path path *toppath*) "/megatest.db")) ;; fname)
(dbexists (file-exists? dbpath))
(db (sqlite3:open-database dbpath)) ;; (never-give-up-open-db dbpath))
(handler (make-busy-timeout (if (args:get-arg "-override-timeout")
(string->number (args:get-arg "-override-timeout"))
36000)))) ;; 136000)))
(sqlite3:set-busy-handler! db handler)
(if (not dbexists)
(db:initialize db configinfo))
db))
(define (db:initialize db configinfo)
(let* ((configdat (car configinfo)) ;; tut tut, global warning...
(keys (config-get-fields configdat))
(havekeys (> (length keys) 0))
(keystr (keys->keystr keys))
(fieldstr (keys->key/field keys)))
(for-each (lambda (key)
(let ((keyn (vector-ref key 0)))
(if (member (string-downcase keyn)
|