Overview
Comment: | (no comment) |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | interleaved-queries |
Files: | files | file ages | folders |
SHA1: |
fc67718610bb4bd4e88740fe9d8423f5 |
User & Date: | mrwellan on 2012-11-20 18:09:56 |
Other Links: | branch diff | manifest | tags |
Context
2012-11-20
| ||
19:47 | Backed out accelerations check-in: 44292aaf12 user: matt tags: interleaved-queries | |
18:09 | (no comment) check-in: fc67718610 user: mrwellan tags: interleaved-queries | |
14:58 | (no comment) check-in: 2a8e99f4af user: mrwellan tags: interleaved-queries | |
Changes
Modified db.scm from [1b1ceb5ed3] to [aec6974814].
︙ | ︙ | |||
1130 1131 1132 1133 1134 1135 1136 | ;; now get the actual message (let ((myres (db:string->obj (receive-message* sub-socket)))) (if (equal? query-sig (vector-ref myres 1)) (set! res (vector-ref myres 2)) (loop)))))) (timeout (lambda () (let loop ((n numretries)) | | | 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 | ;; now get the actual message (let ((myres (db:string->obj (receive-message* sub-socket)))) (if (equal? query-sig (vector-ref myres 1)) (set! res (vector-ref myres 2)) (loop)))))) (timeout (lambda () (let loop ((n numretries)) (thread-sleep! 60) (if (not res) (if (> numretries 0) (begin (debug:print 0 "WARNING: no reply to query " params ", trying resend") (debug:print-info 11 "re-sending message") (send-message push-socket zdat) (debug:print-info 11 "message re-sent") |
︙ | ︙ | |||
1255 1256 1257 1258 1259 1260 1261 | ;; The queue is a list of vectors where the zeroth slot indicates the type of query to ;; apply and the second slot is the time of the query and the third entry is a list of ;; values to be applied ;; (define (db:process-queue pubsock indata) (open-run-close (lambda (db . junkparams) | | | < < < < | < < < < < < < < < < < < < < < < < < | < < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < < < < < < < < < < < < < < < | > > > > > > > > | 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 | ;; The queue is a list of vectors where the zeroth slot indicates the type of query to ;; apply and the second slot is the time of the query and the third entry is a list of ;; values to be applied ;; (define (db:process-queue pubsock indata) (open-run-close (lambda (db . junkparams) (let* ((queries (make-hash-table)) (data (sort indata (lambda (a b) (< (cdb:packet-get-qtime a)(cdb:packet-get-qtime b)))))) (for-each (lambda (special-qry) (let* ((stmt-key (cdb:packet-get-qtype special-qry)) (qry-sig (cdb:packet-get-query-sig special-qry)) (return-address (cdb:packet-get-client-sig special-qry)) (qry (hash-table-ref/default queries stmt-key #f)) (params (cdb:packet-get-params special-qry))) (debug:print-info 11 "Special queries/requests stmt-key=" stmt-key ", return-address=" return-address ", qry=" qry ", params=" params) (cond ;; Special queries ((string? qry) (apply sqlite3:execute db qry params) (server:reply pubsock return-address qry-sig #t #t)) ;; ((and (not (null? params)) ;; (procedure? (car params))) ;; (let ((proc (car params)) ;; (remparams (cdr params))) ;; ;; we are being handed a procedure so call it ;; (debug:print-info 11 "Running (apply " proc " " db " " remparams ")") ;; (server:reply pubsock return-address (apply proc db remparams)))) (else (case stmt-key ((immediate) (let ((proc (car params)) (remparams (cdr params))) ;; we are being handed a procedure so call it (debug:print-info 11 "Running (apply " proc " " remparams ")") (server:reply pubsock return-address qry-sig #t (apply proc remparams)))) ((login) (if (< (length params) 3) ;; should get toppath, version and signature '(#f "login failed due to missing params") ;; missing params (let ((calling-path (car params)) (calling-vers (cadr params)) (client-key (caddr params))) (if (and (equal? calling-path *toppath*) (equal? megatest-version calling-vers)) (begin (hash-table-set! *logged-in-clients* client-key (current-seconds)) (server:reply pubsock return-address qry-sig #t '(#t "successful login"))) ;; path matches - pass! Should vet the caller at this time ... (list #f (conc "Login failed due to mismatch paths: " calling-path ", " *toppath*)))))) ((flush sync) (server:reply pubsock return-address qry-sig #t (length data))) ((set-verbosity) (set! *verbosity* (car params)) (server:reply pubsock return-address qry-sig #t '(#t *verbosity*))) ((killserver) (debug:print 0 "WARNING: Server going down in 15 seconds by user request!") (open-run-close tasks:server-deregister tasks:open-db (cadr *server-info*) pullport: (caddr *server-info*)) (thread-start! (make-thread (lambda ()(thread-sleep! 15)(exit)))) (server:reply pubsock return-address qry-sig #t '(#t "exit process started"))) (let ((params (cdb:packet-get-params hed)) (return-address (cdb:packet-get-client-sig hed)) (qry-sig (cdb:packet-get-query-sig hed)) (stmt-key (cdb:packet-get-qtype hed))) (if (or (not (hash-table-ref/default queries stmt-key #f)) (member stmt-key db:special-queries)) (begin (debug:print-info 11 "Handling special statement " stmt-key) (cons hed tal)) (begin (debug:print-info 11 "Executing " stmt-key " for " params) (apply sqlite3:execute (hash-table-ref queries stmt-key) params) (server:reply pubsock return-address qry-sig #t #t) (if (not (null? tal)) (innerloop (car tal)(cdr tal)) '())) )))))))) (else (debug:print 0 "ERROR: Unrecognised queued call " qry " " params) (server:reply pubsock return-address qry-sig #f #t)) (if (not (null? rem)) (outerloop (car rem)(cdr rem)))))) (for-each (lambda (stmt-key) (sqlite3:finalize! (hash-table-ref queries stmt-key))) (hash-table-keys queries)) (let ((cache-size (length data))) (if (> cache-size *max-cache-size*) |
︙ | ︙ |