Megatest

;; TO-DO
;;  1. Make "data" hash-table hierarchial store of all displayed data
;;  2. Update synchash to understand "get-runs", "get-tests" etc.
;;  3. Add extraction of filters to synchash calls
;;
(define (run-update data runname keypatts testpatt states statuses)
  (let ((run-ids '()))
    ;; count and offset => #f so not used
    ;; the synchash calls modify the "data" hash
    (synchash:client-get 'db:get-runs  "get-runs" (length keypatts) data runname #f #f keypatts)
    ;; Now can calculate the run-ids
    (let* ((run-hash (hash-table-ref/default data "get-runs" #f))
	   (run-ids (if run-hash (filter number? (hash-table-keys run-hash)) '())))
      ;; (debug:print-info 2 "run-hash-keys: " (hash-table-keys run-hash))
      ;; (debug:print-info 2 "run-hash: ")(pp (hash-table->alist run-hash))
      ;; (debug:print-info 2 "run-ids: " run-ids)
      (synchash:client-get 'db:get-tests-for-runs "get-tests-for-runs" 0 data run-ids testpatt states statuses))))
  (let* (;; count and offset => #f so not used
	 ;; the synchash calls modify the "data" hash
	 (run-changes (synchash:client-get 'db:get-runs  "get-runs" (length keypatts) data runname #f #f keypatts))
	 ;; Now can calculate the run-ids
	 (run-hash    (hash-table-ref/default data "get-runs" #f))
	 (run-ids     (if run-hash (filter number? (hash-table-keys run-hash)) '()))
	 ;; (debug:print-info 2 "run-hash-keys: " (hash-table-keys run-hash))
	 ;; (debug:print-info 2 "run-hash: ")(pp (hash-table->alist run-hash))
	 ;; (debug:print-info 2 "run-ids: " run-ids)
	 (test-changes (synchash:client-get 'db:get-tests-for-runs "get-tests-for-runs" 0 data run-ids testpatt states statuses)))
    (list run-changes test-changes)))

(define (newdashboard)
  (let* ((data     (make-hash-table))
	 (keys     (cdb:remote-run db:get-keys #f))
	 (runname  "%")
	 (testpatt "%")
	 (keypatts (map (lambda (k)(list (vector-ref k 0) "%")) keys))
	 (states   '())
	 (statuses '()))
    (iup:show (main-panel))
    (iup:callback-set! *tim*
		       "ACTION_CB"
		       (lambda (x)
			 (run-update data runname keypatts testpatt states statuses)))))
			 (let ((changes (run-update data runname keypatts testpatt states statuses)))
			   (debug:print 0 "CHANGES: " changes))))))

(newdashboard)    
(iup:main-loop)

(use spiffy uri-common intarweb http-client spiffy-request-vars)

(declare (unit server))

(declare (uses common))
(declare (uses db))
(declare (uses tasks)) ;; tasks are where stuff is maintained about what is running.
(declare (uses synchash))
(declare (uses http-transport))
(declare (uses zmq-transport))

(include "common_records.scm")
(include "db_records.scm")

(define (server:make-server-url hostport)