73
74
75
76
77
78
79
80
81
82
83
84
85
86
|
;;
(defstruct dbr:counts
(state #f)
(status #f)
(count 0))
;;======================================================================
;; hash of hashs
;;======================================================================
(define (db:hoh-set! dat key1 key2 val)
(let* ((subhash (hash-table-ref/default dat key1 #f)))
|
>
>
>
>
>
|
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
;;
(defstruct dbr:counts
(state #f)
(status #f)
(count 0))
(define (db:with-db dbstruct run-id r/w proc . params)
(case (rmt:transport-mode)
((http)(dbfile:with-db dbstruct run-id r/w proc params))
((tcp) (dbmod:with-db dbstruct run-id r/w proc params))))
;;======================================================================
;; hash of hashs
;;======================================================================
(define (db:hoh-set! dat key1 key2 val)
(let* ((subhash (hash-table-ref/default dat key1 #f)))
|
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
|
(define (db:setup do-sync)
(assert *toppath* "FATAL: db:setup called before launch:setup has been run.")
(let* ((tmpdir (common:get-db-tmp-area)))
(if (not *dbstruct-dbs*)
(dbfile:setup do-sync *toppath* tmpdir)
*dbstruct-dbs*)))
(define (db:with-db dbstruct run-id r/w proc . params)
(case (rmt:transport-mode)
((http)(dbfile:with-db dbstruct run-id r/w proc params))
((tcp) (dbmod:with-db dbstruct run-id r/w proc params))))
|
<
<
<
<
<
|
129
130
131
132
133
134
135
136
137
138
139
140
141
142
|
(define (db:setup do-sync)
(assert *toppath* "FATAL: db:setup called before launch:setup has been run.")
(let* ((tmpdir (common:get-db-tmp-area)))
(if (not *dbstruct-dbs*)
(dbfile:setup do-sync *toppath* tmpdir)
*dbstruct-dbs*)))
;; moved from dbfile
;;
;; ADD run-id SUPPORT
;;
(define (db:create-all-triggers dbstruct)
(db:with-db
dbstruct #f #f
|
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
|
(if offset (conc " OFFSET " offset) "")
";"))
(debug:print-info 4 *default-log-port* "runs:get-runs-by-patt qry=" qry-str " " runnamepatt)
;(print "runs:get-runs-by-patt qry=" qry-str " " runnamepatt)
(vector header
(reverse
(db:with-db dbstruct #f #f ;; reads db, does not write to it.
(lambda (dbdat db)
(sqlite3:fold-row
(lambda (res . r)
(cons (list->vector r) res))
'()
db
qry-str
runnamepatt)))))))
;; use (get-value-by-header (db:get-header runinfo)(db:get-rows runinfo))
;; NOTE: Does NOT return a list of rows (or one row) for the first slot of the vector
;; this is inconsistent with get-runs but it makes some sense.
;;
(define (db:get-run-info dbstruct run-id)
;;(if (hash-table-ref/default *run-info-cache* run-id #f)
|
>
|
|
|
|
|
|
|
|
|
|
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
|
(if offset (conc " OFFSET " offset) "")
";"))
(debug:print-info 4 *default-log-port* "runs:get-runs-by-patt qry=" qry-str " " runnamepatt)
;(print "runs:get-runs-by-patt qry=" qry-str " " runnamepatt)
(vector header
(reverse
(db:with-db
dbstruct #f #f ;; reads db, does not write to it.
(lambda (dbdat db)
(sqlite3:fold-row
(lambda (res . r)
(cons (list->vector r) res))
'()
db
qry-str
runnamepatt)))))))
;; use (get-value-by-header (db:get-header runinfo)(db:get-rows runinfo))
;; NOTE: Does NOT return a list of rows (or one row) for the first slot of the vector
;; this is inconsistent with get-runs but it makes some sense.
;;
(define (db:get-run-info dbstruct run-id)
;;(if (hash-table-ref/default *run-info-cache* run-id #f)
|