Megatest

	  extras
	  hostinfo

	  ports
	  posix
	  files
	  data-structures
	  directory-utils
	  tcp
	  ))
 (chicken-5
  (import chicken.base
	  chicken.condition
	  chicken.file
	  chicken.pathname

  (sort (get-all-ips) ip-pref-less?))

(define (get-all-ips)
  (map address-info-host
       (filter (lambda (x)
		 (equal? (address-info-type x) "tcp"))
	       (address-infos (get-host-name)))))

;;======================================================================
;; Other Utils
;;======================================================================
)

(defstruct jstats
  (count 0)
  (jcount (make-hash-table)) ;; 1.db => journal_count
  )

;; timeblk => jstats
(define *journal-stats* #f) ;; (make-hash-table))

;; monte-carlo-esque random sampling of journal files
;; for all the files:
;;   if .journal
;;      update stats +1 +1
;;      update stats +1  0
;;
(define (tt:write-load-tracking dbdir)
  (let* ((cs    (current-seconds))
	 (key   (inexact->exact (quotient cs 10)))
	 (old   (- key 5)) ;; 4 x 10 seconds ago
	 (jstat (if (hash-table-exists? *journal-stats* key)
		    (hash-table-ref *journal-stats* key )
		    (let ((new (make-jstats)))
		      (hash-table-set! *journal-stats* key new)
		      new))))
    ;; clear out old records
    (for-each
     (lambda (key)
       (if (< key old)
	   (hash-table-delete! *journal-stats* key)))
     (hash-table-keys *journal-stats*))

    ;; increment our count of observations
    (jstats-count-set! jstat (+ (jstats-count jstat) 1))
    
    ;; now find and increment journal file counts
    (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 
     )))

(define *journal-stats-mutex* (make-mutex))

(define (tt:journal-stats-run dbdir)
  (if (not *journal-stats*)(set! *journal-stats* (make-hash-table)))
  (let loop ()
    (mutex-lock! *journal-stats-mutex*)
    (tt:write-load-tracking dbdir)
    (mutex-unlock! *journal-stats-mutex*)
    (thread-sleep! (/ (random 1000) 100.0))
    (loop)))

;; 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*
	   (lambda (k v) ;; key jstats
	     (let* ((count  (jstats-count v))
		    (jcount (jstats-jcount v))) ;; dbfname => hit count
	       (jstats-count-set! result
				  (+ (jstats-count result)
				     (jstats-count v)))
	       (hash-table-for-each
		jcount
		(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))

)