9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
|
;; PURPOSE.
;;======================================================================
;;======================================================================
;; Database access
;;======================================================================
(require-extension (srfi 18) extras tcp rpc)
(import (prefix rpc rpc:))
(use sqlite3 srfi-1 posix regex regex-case srfi-69 csv-xml s11n)
(import (prefix sqlite3 sqlite3:))
(use zmq)
(declare (unit db))
(declare (uses common))
(declare (uses keys))
|
|
|
|
|
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
|
;; PURPOSE.
;;======================================================================
;;======================================================================
;; Database access
;;======================================================================
(require-extension (srfi 18) extras tcp) ;; rpc)
;; (import (prefix rpc rpc:))
(use sqlite3 srfi-1 posix regex regex-case srfi-69 csv-xml s11n md5 message-digest)
(import (prefix sqlite3 sqlite3:))
(use zmq)
(declare (unit db))
(declare (uses common))
(declare (uses keys))
|
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
|
(define (cdb:use-non-blocking-mode proc)
(set! *client-non-blocking-mode* #t)
(let ((res (proc)))
(set! *client-non-blocking-mode* #f)
res))
;; params = 'target cached remparams
(define (cdb:client-call zmq-socket . params)
(debug:print-info 11 "cdb:client-call zmq-socket=" zmq-socket " params=" params)
(let ((zdat (db:obj->string params)) ;; (with-output-to-string (lambda ()(serialize params))))
(res #f))
;; (signal-mask! signal/int)
(set! *received-response* #f)
(send-message zmq-socket zdat)
;; (signal-unmask! signal/int)
(set! res (db:string->obj (if *client-non-blocking-mode*
(receive-message* zmq-socket)
(receive-message zmq-socket))))
(set! *received-response* #t)
(debug:print-info 11 "zmq-socket " (car params) " res=" res)
res))
(define (cdb:set-verbosity zmq-socket val)
(cdb:client-call zmq-socket 'set-verbosity #f val))
(define (cdb:login zmq-socket keyval signature)
(cdb:client-call zmq-socket 'login #t keyval megatest-version signature))
(define (cdb:logout zmq-socket keyval signature)
(cdb:client-call zmq-socket 'logout #t keyval signature))
(define (cdb:num-clients zmq-socket)
(cdb:client-call zmq-socket 'numclients #t))
|
|
|
>
>
>
|
|
<
|
<
<
|
|
|
>
|
|
>
>
|
|
|
|
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
|
(define (cdb:use-non-blocking-mode proc)
(set! *client-non-blocking-mode* #t)
(let ((res (proc)))
(set! *client-non-blocking-mode* #f)
res))
;; params = 'target cached remparams
(define (cdb:client-call zmq-sockets . params)
(debug:print-info 11 "cdb:client-call zmq-sockets=" zmq-sockets " params=" params)
(let* ((push-socket (vector-ref zmq-sockets 0))
(sub-socket (vector-ref zmq-sockets 1))
(query-id (conc (server:get-client-signature) "-" (message-digest-string (md5-primitive) (conc params))))
(zdat (db:obj->string (vector query-id params))) ;; (with-output-to-string (lambda ()(serialize params))))
(res #f)
(get-res (lambda ()
(db:string->obj (if *client-non-blocking-mode*
(receive-message* sub-socket)
(receive-message sub-socket))))))
(send-message push-socket zdat)
(let loop ((res (get-res)))
(if res res
(begin
(thread-sleep! 0.5)
(get-res))))))
(define (cdb:set-verbosity zmq-socket val)
(cdb:client-call zmq-socket 'set-verbosity #f val))
(define (cdb:login zmq-sockets keyval signature)
(cdb:client-call zmq-sockets 'login #t keyval megatest-version signature))
(define (cdb:logout zmq-socket keyval signature)
(cdb:client-call zmq-socket 'logout #t keyval signature))
(define (cdb:num-clients zmq-socket)
(cdb:client-call zmq-socket 'numclients #t))
|