98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
|
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
+
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
|
(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*)
(handle-exceptions
exn
(begin
(debug:print 0 "WARNING: stats collection failed in update-db-stats")
#f) ;; if this fails we don't care, it is just stats
(let* ((cmd (if (eq? rawcmd 'general-call) (car params) rawcmd))
(stat-vec (hash-table-ref/default *db-stats* cmd #f)))
(if (not stat-vec)
(let ((newvec (vector 0 0)))
(hash-table-set! *db-stats* cmd newvec)
(set! stat-vec newvec)))
(vector-set! stat-vec 0 (+ (vector-ref stat-vec 0) 1))
(vector-set! stat-vec 1 (+ (vector-ref stat-vec 1) duration)))
(let* ((cmd (if (eq? rawcmd 'general-call) (car params) rawcmd))
(stat-vec (hash-table-ref/default *db-stats* cmd #f)))
(if (not stat-vec)
(let ((newvec (vector 0 0)))
(hash-table-set! *db-stats* cmd newvec)
(set! stat-vec newvec)))
(vector-set! stat-vec 0 (+ (vector-ref stat-vec 0) 1))
(vector-set! stat-vec 1 (+ (vector-ref stat-vec 1) duration))))
(mutex-unlock! *db-stats-mutex*))
(define (rmt:print-db-stats)
(let ((fmtstr "~40a~7-d~9-d~20,2-f")) ;; "~20,2-f"
(debug:print 18 "DB Stats\n========")
(debug:print 18 (format #f "~40a~8a~10a~10a" "Cmd" "Count" "TotTime" "Avg"))
|