Megatest

    (debug:print-info 7 "Current write queue length is " queue-len)

    ;; poll for the write to complete, timeout after 10 seconds
    ;; periodic flushing of the queue is taken care of by 
    ;; db:flush-queue
    (let loop ()
      (thread-sleep! 0.1)
      (thread-sleep! 0.002)
      (mutex-lock! *completed-mutex*)
      (if (hash-table-ref/default *completed-writes* qry-sig #f)
	  (begin
	    (hash-table-delete! *completed-writes* qry-sig)
	    (set! got-it #t)))
      (mutex-unlock! *completed-mutex*)
      (if (and (not got-it)
	       (< (current-seconds) timeout))
	  (begin
	    (thread-sleep! 0.01)
	  (loop)))
	    (loop))))
    (set! *number-of-writes*   (+ *number-of-writes*   1))
    (set! *writes-total-delay* (+ *writes-total-delay* 1))
    got-it))
	  
(define (db:process-queue-item db item)
  (let* ((stmt-key       (cdb:packet-get-qtype item))
	 (qry-sig        (cdb:packet-get-query-sig item))

  (if (setup-for-run)
      (let ((db (open-db)))
	(let loop ()
	  (let ((last-write-flush-time #f))
	    (mutex-lock! *incoming-mutex*)
	    (set! last-write-flush-time *server:last-write-flush*)
	    (mutex-unlock! *incoming-mutex*)
	    (if (> (- (current-milliseconds) last-write-flush-time) 400)
	    (if (> (- (current-milliseconds) last-write-flush-time) 10)
		(begin
		  (mutex-lock! *db:process-queue-mutex*)
		  (db:process-cached-writes db)
		  (mutex-unlock! *db:process-queue-mutex*)
		  (thread-sleep! 0.5))))
		  (thread-sleep! 0.01))))
	  (loop)))
      (begin
	(debug:print 0 "ERROR: failed to setup for Megatest in server:write-queue-handler")
	(exit 1))))
    
;;======================================================================
;; S E R V E R   U T I L I T I E S