1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
|
(directory-fold
(lambda (fname res)
;; is it a journal file?
(let ((parts (string-match "^(.*\\.db)-journal.*" fname)))
(match parts
((_ dbfname)
(hash-table-set! (jstats-jcount jstat) dbfname
(+ (hash-table-ref/default (jstats-jcount jstat) dbfname 0) 1)
))
(else #f)
)))
'()
dbdir
)))
|
|
|
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
|
(directory-fold
(lambda (fname res)
;; is it a journal file?
(let ((parts (string-match "^(.*\\.db)-journal.*" fname)))
(match parts
((_ dbfname)
(hash-table-set! (jstats-jcount jstat) dbfname
(+ (hash-table-ref/default (jstats-jcount jstat) dbfname 0) 1.0)
))
(else #f)
)))
'()
dbdir
)))
|
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
|
;; call this to start a thread that is keeping the journal-stats up to date.
(define (tt:start-stats dbdir)
(thread-start!
(make-thread
(lambda ()(tt:journal-stats-run dbdir)) "Journal stats collection thread")))
(define (tt:get-journal-stats)
(let* ((result (make-jstats))
(hitcounts (jstats-jcount result)))
(if *journal-stats*
(begin
(mutex-lock! *journal-stats-mutex*)
(hash-table-for-each
*journal-stats*
|
|
|
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
|
;; call this to start a thread that is keeping the journal-stats up to date.
(define (tt:start-stats dbdir)
(thread-start!
(make-thread
(lambda ()(tt:journal-stats-run dbdir)) "Journal stats collection thread")))
(define (tt:get-journal-stats #!optional (dbfname #f))
(let* ((result (make-jstats))
(hitcounts (jstats-jcount result)))
(if *journal-stats*
(begin
(mutex-lock! *journal-stats-mutex*)
(hash-table-for-each
*journal-stats*
|
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
|
(lambda (dbfname hit-count)
(hash-table-set! hitcounts dbfname
(+ hit-count
(hash-table-ref/default hitcounts dbfname 0))))))))
(mutex-unlock! *journal-stats-mutex*))
(debug:print 0 *default-log-port* "INFO: *journal-stats* not set."))
;; convert to normalized alist
(let ((tot (min (jstats-count result) 1)) ;; avoid divide by zero
(hits (jstats-jcount result))) ;; 1.db => count
(hash-table-map
hits
(lambda (fname hitcount)
(cons fname (/ hitcount tot)))))))
;; megatest> (import tcp-transportmod)
;; megatest> (tt:write-load-tracking ".mtdb")
;; megatest> (hash-table-keys *journal-stats*)
;; (172060297)
;; megatest> (jstats->alist (hash-table-ref *journal-stats* 172060297))
;; ((count . 1) (jcount . #<hash-table (1)>))
;; megatest> (jstats-jcount (hash-table-ref *journal-stats* 172060297))
;; #<hash-table (1)>
;; megatest> (hash-table->alist (jstats-jcount (hash-table-ref *journal-stats* 172060297)))
;; (("1.db" . 4))
)
|
|
|
|
|
|
|
>
>
>
|
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
|
(lambda (dbfname hit-count)
(hash-table-set! hitcounts dbfname
(+ hit-count
(hash-table-ref/default hitcounts dbfname 0))))))))
(mutex-unlock! *journal-stats-mutex*))
(debug:print 0 *default-log-port* "INFO: *journal-stats* not set."))
;; convert to normalized alist
(let* ((tot (min (jstats-count result) 1)) ;; avoid divide by zero
(hits (jstats-jcount result)) ;; 1.db => count
(res (hash-table-map
hits
(lambda (fname hitcount)
(cons fname (/ hitcount tot))))))
(if dbfname
(or (alist-ref dbfname res equal?) 0)
res))))
;; megatest> (import tcp-transportmod)
;; megatest> (tt:write-load-tracking ".mtdb")
;; megatest> (hash-table-keys *journal-stats*)
;; (172060297)
;; megatest> (jstats->alist (hash-table-ref *journal-stats* 172060297))
;; ((count . 1) (jcount . #<hash-table (1)>))
;; megatest> (jstats-jcount (hash-table-ref *journal-stats* 172060297))
;; #<hash-table (1)>
;; megatest> (hash-table->alist (jstats-jcount (hash-table-ref *journal-stats* 172060297)))
;; (("1.db" . 4))
)
|