81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
|
(rmt:send-receive cmd run-id params))))
(let ((max-avg-qry (string->number (or (configf:lookup *configdat* "server" "server-query-threshold") "800"))))
(debug:print-info 4 "no server and read-only query, bypassing normal channel")
;; (if (rmt:write-frequency-over-limit? cmd run-id)(server:kind-run run-id))
(let ((curr-max (rmt:get-max-query-average)))
(if (> (cdr curr-max) max-avg-qry)
(begin
(debug:print-info 0 "Max average query, " (inexact->exact (round (cdr curr-max))) "ms (" (car curr-max) ") exceeds " max-avg-qry ", try starting server ...")
(server:kind-run run-id))))
(rmt:open-qry-close-locally cmd run-id params)))))
(define (rmt:update-db-stats rawcmd params duration)
(mutex-lock! *db-stats-mutex*)
(let* ((cmd (if (eq? rawcmd 'general-call) (car params) rawcmd))
(stat-vec (hash-table-ref/default *db-stats* cmd #f)))
|
|
|
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
|
(rmt:send-receive cmd run-id params))))
(let ((max-avg-qry (string->number (or (configf:lookup *configdat* "server" "server-query-threshold") "800"))))
(debug:print-info 4 "no server and read-only query, bypassing normal channel")
;; (if (rmt:write-frequency-over-limit? cmd run-id)(server:kind-run run-id))
(let ((curr-max (rmt:get-max-query-average)))
(if (> (cdr curr-max) max-avg-qry)
(begin
(debug:print-info 3 "Max average query, " (inexact->exact (round (cdr curr-max))) "ms (" (car curr-max) ") exceeds " max-avg-qry ", try starting server ...")
(server:kind-run run-id))))
(rmt:open-qry-close-locally cmd run-id params)))))
(define (rmt:update-db-stats rawcmd params duration)
(mutex-lock! *db-stats-mutex*)
(let* ((cmd (if (eq? rawcmd 'general-call) (car params) rawcmd))
(stat-vec (hash-table-ref/default *db-stats* cmd #f)))
|
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
|
(define (rmt:update-run-event_time run-id)
(rmt:send-receive 'update-run-event_time #f (list run-id)))
(define (rmt:get-runs-by-patt keys runnamepatt targpatt offset limit)
(rmt:send-receive 'get-runs-by-patt #f (list keys runnamepatt targpatt offset limit)))
(define (rmt:find-and-mark-incomplete run-id #!key (ovr-deadtime #f))
(rmt:send-receive 'find-and-mark-incomplete #f (list run-id ovr-deadtime)))
;;======================================================================
;; M U L T I R U N Q U E R I E S
;;======================================================================
;; Need to move this to multi-run section and make associated changes
(define (rmt:find-and-mark-incomplete-all-runs #!key (ovr-deadtime #f))
(let ((run-ids (rmt:get-all-run-ids)))
(for-each (lambda (run-id)
(rmt:find-and-mark-incomplete run-id ovr-deadtime: ovr-deadtime))
run-ids)))
;; get the previous record for when this test was run where all keys match but runname
;; returns #f if no such test found, returns a single test record if found
;;
;; Run this at the client end since we have to connect to multiple run-id dbs
;;
|
|
|
|
|
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
|
(define (rmt:update-run-event_time run-id)
(rmt:send-receive 'update-run-event_time #f (list run-id)))
(define (rmt:get-runs-by-patt keys runnamepatt targpatt offset limit)
(rmt:send-receive 'get-runs-by-patt #f (list keys runnamepatt targpatt offset limit)))
(define (rmt:find-and-mark-incomplete run-id ovr-deadtime)
(rmt:send-receive 'find-and-mark-incomplete run-id (list run-id ovr-deadtime)))
;;======================================================================
;; M U L T I R U N Q U E R I E S
;;======================================================================
;; Need to move this to multi-run section and make associated changes
(define (rmt:find-and-mark-incomplete-all-runs #!key (ovr-deadtime #f))
(let ((run-ids (rmt:get-all-run-ids)))
(for-each (lambda (run-id)
(rmt:find-and-mark-incomplete run-id ovr-deadtime))
run-ids)))
;; get the previous record for when this test was run where all keys match but runname
;; returns #f if no such test found, returns a single test record if found
;;
;; Run this at the client end since we have to connect to multiple run-id dbs
;;
|