35
36
37
38
39
40
41
42
43
44
45
46
47
48
|
(include "common_records.scm")
(include "db_records.scm")
(include "key_records.scm")
(include "run_records.scm")
(define *rundb-mutex* (make-mutex)) ;; prevent problems opening/closing rundb's
;; Get/open a database
;; if run-id => get run specific db
;; if #f => get main db
;; 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
|
>
>
|
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
|
(include "common_records.scm")
(include "db_records.scm")
(include "key_records.scm")
(include "run_records.scm")
(define *rundb-mutex* (make-mutex)) ;; prevent problems opening/closing rundb's
(define *number-of-writes* 0)
(define *number-non-write-queries* 0)
;; Get/open a database
;; if run-id => get run specific db
;; if #f => get main db
;; 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
|
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
mdb
(let* ((toppath (dbr:dbstruct-get-path dbstruct))
(dbpath (let ((dbdir (conc *toppath* "/db"))) ;; use this opportunity to create our db dir
(if (not (directory-exists? dbdir))
(create-direcory dbdir))
(conc *toppath* "/db/main.db")))
(dbexists (file-exists? dbpath))
(db (sqlite3:open-database dbpath)) ;; (never-give-up-open-db dbpath))
(write-access (file-write-access? dbpath))
(handler (make-busy-timeout 136000)))
(if (and dbexists (not write-access))
(set! *db-write-access* #f))
(if write-access
(begin
(sqlite3:set-busy-handler! db handler)
|
|
|
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
|
mdb
(let* ((toppath (dbr:dbstruct-get-path dbstruct))
(dbpath (let ((dbdir (conc *toppath* "/db"))) ;; use this opportunity to create our db dir
(if (not (directory-exists? dbdir))
(create-direcory dbdir))
(conc *toppath* "/db/main.db")))
(dbexists (file-exists? dbpath))
(db (sqlite3:open-database dbpath))
(write-access (file-write-access? dbpath))
(handler (make-busy-timeout 136000)))
(if (and dbexists (not write-access))
(set! *db-write-access* #f))
(if write-access
(begin
(sqlite3:set-busy-handler! db handler)
|
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
|
;; keeping it around for debugging purposes only
(define (open-run-close-no-exception-handling proc idb . params)
(debug:print-info 11 "open-run-close-no-exception-handling START given a db=" (if idb "yes " "no ") ", params=" params)
(if (or *db-write-access*
(not (member proc *db:all-write-procs*)))
(let* ((db (cond
((sqlite3:database? idb) idb)
((not idb) (open-db))
((procedure? idb) (idb))
(else (open-db))))
(res #f))
(set! res (apply proc db params))
(if (not idb)(sqlite3:finalize! db))
(debug:print-info 11 "open-run-close-no-exception-handling END" )
res)
#f))
|
|
|
|
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
|
;; keeping it around for debugging purposes only
(define (open-run-close-no-exception-handling proc idb . params)
(debug:print-info 11 "open-run-close-no-exception-handling START given a db=" (if idb "yes " "no ") ", params=" params)
(if (or *db-write-access*
(not (member proc *db:all-write-procs*)))
(let* ((db (cond
((sqlite3:database? idb) idb)
((not idb) (make-dbr:dbstruct path: *toppath*))
((procedure? idb) (idb))
(else (make-dbr:dbstruct path: *toppath*))))
(res #f))
(set! res (apply proc db params))
(if (not idb)(sqlite3:finalize! db))
(debug:print-info 11 "open-run-close-no-exception-handling END" )
res)
#f))
|
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
|
;;======================================================================
;; L O G G I N G D B
;;======================================================================
(define (open-logging-db) ;; (conc *toppath* "/megatest.db") (car *configinfo*)))
(let* ((dbpath (conc (if *toppath* (conc *toppath* "/") "") "logging.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"))
136000)))) ;; 136000)))
(sqlite3:set-busy-handler! db handler)
(if (not dbexists)
(begin
(sqlite3:execute db "CREATE TABLE IF NOT EXISTS log (id INTEGER PRIMARY KEY,event_time TIMESTAMP DEFAULT (strftime('%s','now')),logline TEXT,pwd TEXT,cmdline TEXT,pid INTEGER);")
|
|
|
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
|
;;======================================================================
;; L O G G I N G D B
;;======================================================================
(define (open-logging-db) ;; (conc *toppath* "/megatest.db") (car *configinfo*)))
(let* ((dbpath (conc (if *toppath* (conc *toppath* "/") "") "logging.db")) ;; fname)
(dbexists (file-exists? dbpath))
(db (sqlite3:open-database dbpath))
(handler (make-busy-timeout (if (args:get-arg "-override-timeout")
(string->number (args:get-arg "-override-timeout"))
136000)))) ;; 136000)))
(sqlite3:set-busy-handler! db handler)
(if (not dbexists)
(begin
(sqlite3:execute db "CREATE TABLE IF NOT EXISTS log (id INTEGER PRIMARY KEY,event_time TIMESTAMP DEFAULT (strftime('%s','now')),logline TEXT,pwd TEXT,cmdline TEXT,pid INTEGER);")
|