Megatest

      (debug:print 0 "ERROR: bad value for setenv, key=" key ", value=" val)))

(define home (getenv "HOME"))
(define user (getenv "USER"))

;; GLOBAL GLETCHES
(define-record megatest:area
  name               ;; area name
  path               ;; mt run area home
  transport          ;; defaults to http
  configinfo         ;; legacy config format
  configdat          ;; megatest config
  denoise            ;; focal point for not 
  client-signature   ;; key for client-server conversation
  remote             ;; hash of all the client side connnections
  run-keys           ;; target keys for this area
  runs               ;; used in dashboard
  read-only          ;; can I write to this area?
  )

(define *already-seen-runconfig-info* #f)
(define *waiting-queue*     (make-hash-table))
(define *test-meta-updated* (make-hash-table))
(define *globalexitstatus*  0) ;; attempt to work around possible thread issues
(define *passnum*           0) ;; when running track calls to run-tests or similar

(declare (uses configf))

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

(define help (conc 
	      "Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest
  version " megatest-version "
  license GPL, Copyright (C) Matt Welland 2011

Usage: dashboard [options]
  -h                : this help
  -group groupname  : display this group of areas
  -test testid      : control test identified by testid

		 (argv)
		 (list  "-group" ;; display this group of areas
			"-debug"
			) 
		 (list  "-h"
			"-v"
			"-q"
			)
		 args:arg-hash
		 0))

(if (args:get-arg "-h")
    (begin
      (print help)
      (exit)))


















;; (if (args:get-arg "-host")
;;     (begin
;;       (set! (common:get-remote remote) (string-split (args:get-arg "-host" ":")))
;;       (client:launch))
;;     (client:launch))

;; ease debugging by loading ~/.dashboardrc

     (list setup-matrix jobtools-matrix validvals-matrix envovrd-matrix))

    (iup:attribute-set! validvals-matrix "WIDTH1" "290")
    (iup:attribute-set! envovrd-matrix   "WIDTH1" "290")

    (iup:vbox
     (iup:hbox
      
      (iup:vbox
       (let ((tabs (iup:tabs 
		    ;; The required tab
		    (iup:hbox
		     ;; The keys
		     (iup:frame 
		      #:title "Keys (required)"

		     (iup:frame
		      #:title "Validvalues"
		      validvals-matrix)
		     ))))
	 (iup:attribute-set! tabs "TABTITLE0" "Required settings")
	 (iup:attribute-set! tabs "TABTITLE1" "Optional settings")
	 tabs))
      ))))

;; The runconfigs.config file
;;
(define (rconfig window-id)
  (iup:vbox
   (iup:frame #:title "Default")))

     (lambda (mat)
       ;; (iup:attribute-set! mat "0:1" "Value")
       ;; (iup:attribute-set! mat "0:0" "Var")
       (iup:attribute-set! mat "HEIGHT0" 0)
       (iup:attribute-set! mat "ALIGNMENT1" "ALEFT")
       ;; (iup:attribute-set! mat "FIXTOTEXT" "C1")
       (iup:attribute-set! mat "RESIZEMATRIX" "YES"))
     ;; (iup:attribute-set! mat "WIDTH1" "120")
     ;; (iup:attribute-set! mat "WIDTH0" "100"))
     (list run-info-matrix test-info-matrix test-run-matrix meta-dat-matrix))

    ;; Steps matrix
    (iup:attribute-set! steps-matrix "0:1" "Step Name")
    (iup:attribute-set! steps-matrix "0:2" "Start")
    (iup:attribute-set! steps-matrix "WIDTH2" "40")
    (iup:attribute-set! steps-matrix "0:3" "End")

	  keys)
	 (iup:attribute-set! mat "REDRAW" "ALL")))
     (list
      (list run-info-matrix  '("Run Id"  "Target"   "Runname" "Run Start Time" ))
      (list test-info-matrix '("Test Id" "Testname" "Itempath" "State"   "Status" "Test Start Time" "Comment"))
      (list test-run-matrix  '("Hostname" "Host info" "Disk Free" "CPU Load" "Run Duration"))
      (list meta-dat-matrix  '("Author"   "Owner"     "Last Reviewed" "Tags" "Description"))))
    
    (iup:split
     #:orientation "HORIZONTAL"
     (iup:vbox
      (iup:hbox
       (iup:vbox
	run-info-matrix
	test-info-matrix)
       ;; test-info-matrix)
       (iup:vbox
	test-run-matrix
	meta-dat-matrix))
      (iup:vbox
       (iup:vbox
	(iup:hbox 
	 (iup:button "View Log"    #:action viewlog      #:size "60x" )   ;; #:size "30x" 
	 (iup:button "Start Xterm" #:action xterm        #:size "60x" ))	 ;; #:size "30x" 
	(iup:hbox
	 (iup:button "Run Test"    #:action run-test    #:size "60x" )	 ;; #:size "30x" 
	 (iup:button "Clean Test"  #:action remove-test #:size "60x" )))	 ;; #:size "30x" 
       (iup:hbox
	;; hiup:split ;; hbox
	;; #:orientation "HORIZONTAL"
	;; #:value 300
	command-text-box
	command-launch-button)))
     (iup:vbox
      (let ((tabs (iup:tabs
		   steps-matrix
		   data-matrix)))
	(iup:attribute-set! tabs "TABTITLE0" "Test Steps")
	(iup:attribute-set! tabs "TABTITLE1" "Test Data")
	tabs)))))

;; Test browser
(define (tree-browser data adat window-id)
  ;; (iup:split
  (let* ((tb      (iup:treebox
		   #:selection-cb
		   (lambda (obj id state)
		     ;; (print "obj: " obj ", id: " id ", state: " state)

	     (run-id       (db:test-get-run_id test-data))
	     (targ/runname (hash-table-ref/default (dboard:data-get-run-keys *data*) 
						   run-id
						   '()))
	     (target       (if (null? targ/runname) "" (string-intersperse (reverse (cdr (reverse targ/runname))) "/")))
	     (runname      (if (null? targ/runname) "" (car (cdr targ/runname))))
	     (steps-dat    (tests:get-compressed-steps *dbstruct-local* run-id test-id)))
	
	(if test-data
	    (begin
	      ;; 
	      (for-each 
	       (lambda (data)
		 (let ((mat    (car data))
		       (vals   (cadr data))

				(db:test-get-uname    test-data)
				(db:test-get-diskfree test-data)
				(db:test-get-cpuload  test-data)
				(seconds->hr-min-sec (db:test-get-run_duration test-data)))
			  (make-list 5 "")))
		))
	      (dcommon:populate-steps steps-dat steps-matrix))))))
;;(list meta-dat-matrix
;;      (if test-id
;;	  (list (


;;======================================================================
;; R U N   C O N T R O L
;;======================================================================

;; General displayer
;;
(define (area-display data adat window-id)

  (iup:hbox))

;;======================================================================
;; D A S H B O A R D
;;======================================================================

(define (make-area-panel data area-name window-id)
  (let* ((adat   (hash-table-ref (dboard:data-areas data) area-name))
	 (tb     (tree-browser data adat window-id)) ;; (dboard:areas-tree-browser data)
	 (ad     (area-display data adat window-id))
	 (areas  (dboard:data-areas data)))
    (dboard:area-tree-set!   adat tb)
    (dboard:area-matrix-set! adat ad)
    (iup:split
     #:value 200
     tb ad)))

	   (area-panels (map (lambda (aname)
			       (make-area-panel data aname window-id))
			     area-names))
	   (tabtop      (apply iup:tabs areas)))
      (let loop ((index 0)
		 (hed   (car area-names))
		 (tal   (cdr area-names)))
	(let* ((apath     (hash-table-ref (dboard:data-cfgdat data) hed))
	       (mtconf    (read-config apath (make-hash-table) #f)) ;; megatest.config
	       (area-dat  (make-megatest:area
			   hed      ;; area name
			   apath    ;; path to area
			   'http    ;; transport
			   (list apath mtconf) ;; configinfo (legacy)
			   mtconf   ;; megatest.config
			   (make-hash-table) ;; denoise hash
			   #f       ;; client-signature
			   #f       ;; remote connections
			   #f       ;; run keys
			   (make-hash-table) ;; run-id -> (hash of test-ids => dat)
			   (and (file-exists? apath)(file-write-access? apath)) ;; read-only
			   )))
	  (hash-table-set! (dboard:data-areas data) hed 
			   (make-dboard:area 
			    #f           ;; tree
			    #f           ;; matrix


			    area-dat     ;;
			    #f           ;; view path
			    'default     ;; view type
			    #f           ;; matrix
			    #f           ;; controls
			    #f           ;; cached data
			    #f           ;; filters
			    #f           ;; the run-id
			    (make-hash-table) ;; run-id -> test-id, for current test id
			    ""
			    ))
	  (debug:print 0 "Adding area " hed " with index " index " to dashboard")
	  (iup:attribute-set! tabtop (conc "TABTITLE" index) hed)
	  (if (not (null? tal))
	      (loop (+ index 1)(car tal)(cdr tal))))
	tabtop)))))

  areas             ;; hash of areaname -> area-rec
  current-window-id
  )

(define-record dboard:area
  tree
  matrix

  area-dat  ;; the one-structure (one day dbstruct will be put in here)


  view-path ;; <target/path>/<runname>/...
  view-type ;; standard, etc.
  matrix    ;; the spreadsheet 
  controls  ;; the controls
  data      ;; all the data kept in sync with db
  filters   ;; user filters 
  run-id    ;; the current run-id
  test-ids  ;; the current test id hash, run-id => test-id
  command   ;; the command from the entry field

  )

(define-record dboard:filter
  target    ;; hash of widgets for the target
  runname   ;; the runname widget
  testpatt  ;; the testpatt widget
  )