Megatest

     qrystr)
    res))

;;======================================================================
;; QUEUE UP META, TEST STATUS AND STEPS
;;======================================================================

(define (db:updater db)
  (let loop ((start-time (current-time)))
    (thread-sleep! 0.5) ;; move save time around to minimize regular collisions?
    (db:write-cached-data db)
    (loop start-time)))
    
(define (remote:test-update-meta-info db test-id minutes cpuload diskfree tmpfree)
  (mutex-lock! *incoming-mutex*)
  (set! *incoming-data* (cons (vector 'meta-info
				      (current-seconds)
				      (list cpuload
					    diskfree
					    minutes
					    test-id)) ;; run-id test-name item-path minutes cpuload diskfree tmpfree) 
			      *incoming-data*))
  (mutex-unlock! *incoming-mutex*)
  (if *cache-on*
      (debug:print 6 "INFO: *cache-on* is " *cache-on* ", skipping cache write as part of test-update-meta-info")
      (db:write-cached-data db)))


(define (db:write-cached-data db)
  (let ((meta-stmt (sqlite3:prepare db "UPDATE tests SET cpuload=?,diskfree=?,run_duration=?,state='RUNNING' WHERE id=? AND state NOT IN ('COMPLETED','KILLREQ','KILLED');"))
	(step-stmt (sqlite3:prepare db "INSERT OR REPLACE into test_steps (test_id,stepname,state,status,event_time,comment,logfile) VALUES(?,?,?,?,?,?,?);")) ;; strftime('%s','now')#f)
	(data (sort *incoming-data* (lambda (a b)(< (vector-ref a 1)(vector-ref b 1))))))
    (if (> (length data) 0)
	(debug:print 4 "Writing cached data " data))
    (mutex-lock! *incoming-mutex*)
    (sqlite3:with-transaction 
     db
     (lambda ()
       (for-each (lambda (entry)
		   (case (vector-ref entry 0)
		     ((meta-info)
		      (apply sqlite3:execute meta-stmt (vector-ref entry 2)))
		     ((step-status)
		      (apply sqlite3:execute step-stmt (vector-ref entry 2)))
		     (else
		      (debug:print 0 "ERROR: Queued entry not recognised " entry))))
		 data)))
    (sqlite3:finalize! meta-stmt) ;; sqlite is the bottleneck, clear the statements asap?
    (sqlite3:finalize! step-stmt)
    (set! *incoming-data* '())
    (mutex-unlock! *incoming-mutex*)))


(define (db:roll-up-pass-fail-counts db run-id test-name item-path status)
  (if (and (not (equal? item-path ""))
	   (or (equal? status "PASS")
	       (equal? status "WARN")
	       (equal? status "FAIL")
	       (equal? status "WAIVED")

                          'RUNNING'
                       ELSE 'COMPLETED' END,
                          status=CASE WHEN fail_count > 0 THEN 'FAIL' WHEN pass_count > 0 AND fail_count=0 THEN 'PASS' ELSE 'UNKNOWN' END
                       WHERE run_id=? AND testname=? AND item_path='';"
	     run-id test-name run-id test-name))
	#f)
      #f))


;;======================================================================
;; Tests meta data
;;======================================================================

;; read the record given a testname
(define (db:testmeta-get-record db testname)

(define (rdb:test-get-paths-matching db keynames target fname)
   (if *runremote*
       (let ((host (vector-ref *runremote* 0))
	     (port (vector-ref *runremote* 1)))
	 ((rpc:procedure 'rdb:test-get-paths-matching host port) keynames target fname))
       (db:test-get-paths-matching db keynames target fname)))

(define (rdb:open-run-close procname . remargs)
   (if *runremote*
       (let ((host (vector-ref *runremote* 0))
	     (port (vector-ref *runremote* 1)))
	 (apply (rpc:procedure 'rdb:open-run-close host port) procname remargs))
       (apply open-run-close (eval procname) remargs)))

			 (or (not state)
			     (not status)))
		    (begin
		      (debug:print 0 "ERROR: You must specify :state and :status with every call to -test-status\n" help)
		      ;; (sqlite3:finalize! db)
		      (exit 6)))
		(let ((msg (args:get-arg "-m")))
		  ;; Convert to rpc
		  (rdb:open-run-close 'tests:test-set-status! #f test-id state newstatus msg otherdata))))
	  (if db (sqlite3:finalize! db))
	  (set! *didsomething* #t))))

;;======================================================================
;; Various helper commands can go below here
;;======================================================================

;; procstr is the name of the procedure to be called as a string
(define (server:autoremote procstr params)
  (handle-exceptions
   exn
   (begin
     (debug:print 1 "Remote failed for " proc " " params)
     (apply (eval (string->symbol procstr)) params))
   ;; (if *runremote*
   ;;    (apply (eval (string->symbol (conc "remote:" procstr))) params)
   (apply (eval (string->symbol procstr)) params)))

(define (server:start db hostn)
  (debug:print 0 "Attempting to start the server ...")
  (let* ((rpc:listener   (server:find-free-port-and-open (rpc:default-server-port)))
	 (th1            (make-thread
			  (cute (rpc:make-server rpc:listener) "rpc:server")
			  'rpc:server))

     (lambda (procstr . params)
       (server:autoremote procstr params)))

    ;;======================================================================
    ;; db specials here
    ;;======================================================================
    ;; ** set-tests-state-status
    (rpc:publish-procedure!
     'rdb:open-run-close 
     (lambda (procname . remargs)
       (debug:print 4 "INFO: rdb:open-run-close " procname " " remargs)
       (set! *last-db-access* (current-seconds))
       (apply open-run-close (eval procname) remargs)))

    (rpc:publish-procedure!
     'rdb:set-tests-state-status 
     (lambda (run-id testnames currstate currstatus newstate newstatus)
       (set! *last-db-access* (current-seconds))
       (db:set-tests-state-status db run-id testnames currstate currstatus newstate newstatus)))

    (rpc:publish-procedure!