Megatest

;;======================================================================
;; S U M M A R Y 
;;======================================================================
;;
;; General info about the run(s) and megatest area
(define (dashboard:summary commondat tabdat #!key (tab-num #f))
  (let* ((rawconfig        (read-config (conc *toppath* "/megatest.config") #f #f)) ;; changed to #f since I want #{} to be expanded by [system ...] to NOT be expanded. WAS: 'return-string)))
	 (changed          #f))
    (iup:vbox
     (iup:split
      #:value 500
      (iup:frame 
       #:title "General Info"
       (iup:vbox
	(iup:hbox

			(bval (vector-ref b 2))
			(anum (string->number aval))
			(bnum (string->number bval)))
		   (if (and anum bnum)
		       (< anum bnum)
		       (string<= aval bval)))))))






















(define (dashboard:one-run-updater commondat tabdat tb cell-lookup run-matrix)




  (let* ((changed      #f)






	 (runs-dat     (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f))
					 (runs-header  (vector-ref runs-dat 0)) ;; 0 is header, 1 is list of records
					 (run-id       (dboard:tabdat-curr-run-id tabdat))
					 (last-update  0) ;; fix me
					 (tests-dat    (dboard:get-tests-dat tabdat run-id last-update))
					 (tests-mindat (dcommon:minimize-test-data tests-dat))
					 (indices      (common:sparse-list-generate-index tests-mindat)) ;;  proc: set-cell))
					 (row-indices  (cadr indices))

						       (key  (conc "0:" num)))
						  (if (not (equal? (iup:attribute run-matrix key) name))
						      (begin
							(set! changed #t)
							(iup:attribute-set! run-matrix key name)
							(iup:attribute-set! run-matrix "FITTOTEXT" (conc "C" num))))))
					      col-indices)
    (if changed (iup:attribute-set! run-matrix "REDRAW" "ALL"))))
    
;; This is the Run Summary tab
;; 
(define (dashboard:one-run commondat tabdat #!key (tab-num #f))
  (let* ((tb      (iup:treebox
		   #:value 0
		   #:name "Runs"
		   #:expand "YES"
		   #:addexpanded "NO"
		   #:selection-cb
		   (lambda (obj id state)
		     ;; (print "obj: " obj ", id: " id ", state: " state)
		     (let* ((run-path (tree:node->path obj id))
			    (run-id   (tree-path->run-id tabdat (cdr run-path))))
		       (if (number? run-id)
			   (begin
			     (dboard:tabdat-curr-run-id-set! tabdat run-id)
			     ;; (dashboard:update-run-summary-tab)
			     )
			   (debug:print-error 0 *default-log-port* "tree-path->run-id returned non-number " run-id)))
		     ;; (print "path: " (tree:node->path obj id) " run-id: " run-id)
		     )))
	 (cell-lookup (make-hash-table))
	 (run-matrix (iup:matrix
		      #:expand "YES"
		      #:click-cb
		      (lambda (obj lin col status)
			(let* ((toolpath (car (argv)))
			       (key      (conc lin ":" col))
			       (test-id  (hash-table-ref/default cell-lookup key -1))
			       (cmd      (conc toolpath " -test " (dboard:tabdat-curr-run-id tabdat) "," test-id "&")))
			  (system cmd)))))
	 (one-run-updater  (lambda ()
			     (if  (dashboard:database-changed? commondat tabdat)
				  (dashboard:one-run-updater commondat tabdat tb cell-lookup run-matrix)))))
    (dboard:commondat-add-updater commondat one-run-updater tab-num: tab-num)
    (dboard:tabdat-runs-tree-set! tabdat tb)
    (iup:split
     tb
     run-matrix)))

;; This is the New View tab

      ;; (dboard:commondat-add-updater 
      ;;  commondat 
      ;;  (lambda ()
      ;; 	 (dashboard:summary-tab-updater commondat 0))
      ;;  tab-num: 0)
      ;; runs tab
      (dboard:commondat-curr-tab-num-set! commondat 0)
      (dboard:commondat-add-updater 
       commondat 
       (lambda ()
      	 (dashboard:runs-tab-updater commondat 1))
       tab-num: 1)
      (iup:callback-set! *tim*
			 "ACTION_CB"
			 (lambda (time-obj)
			   (let ((update-is-running #f))
			     (mutex-lock! (dboard:commondat-update-mutex commondat))
			     (set! update-is-running (dboard:commondat-updating commondat))
			     (if (not update-is-running)

;; P R O C E S S   R U N S
;;======================================================================

;; MOVE THIS INTO *data*
(define *cachedata* (make-hash-table))
(hash-table-set! *cachedata* "runid-to-col"    (make-hash-table))
(hash-table-set! *cachedata* "testname-to-row" (make-hash-table))

;; modify a cell if the data is changed, return #t or-ed with previous if modified, #f elsewise
;;
(define (dcommon:modifiy-if-different mtrx cell-name new-val prev-changed)
  (let ((curr-val (iup:attribute mtrx cell-name)))
    (if (not (equal? curr-val new-val)) 
	(begin
	  (iup:attribute-set! mtrx cell-name col-name)
	  #t) ;; need a re-draw
	prev-changed)))


;; 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
;;
;; Mode is 'full or 'incremental for full refresh or incremental refresh
(define (dcommon:run-update keys data runname keypatts testpatt states statuses mode window-id)
  (let* (;; count and offset => #f so not used
	 ;; the synchash calls modify the "data" hash
	 (changed         #f)
	 (get-runs-sig    (conc (client:get-signature) " get-runs"))
	 (get-tests-sig   (conc (client:get-signature) " get-tests"))
	 (get-details-sig (conc (client:get-signature) " get-test-details"))

	 ;; test-ids to get and display are indexed on window-id in curr-test-ids hash
	 (test-ids        (hash-table-values (dboard:tabdat-curr-test-ids data)))
	 ;; run-id is #f in next line to send the query to server 0

				      (time-a   (db:get-value-by-header record-a header "event_time"))
				      (time-b   (db:get-value-by-header record-b header "event_time")))
				 (> time-a time-b)))
			     ))
	 (runid-to-col    (hash-table-ref *cachedata* "runid-to-col"))
	 (testname-to-row (hash-table-ref *cachedata* "testname-to-row")) 
	 (colnum       1)
	 (rownum       0)
	 (cellname (conc rownum ":" colnum))) ;; rownum = 0 is the header
;; (debug:print 0 *default-log-port* "test-ids " test-ids ", tests-detail-changes " tests-detail-changes)
    
	 ;; tests related stuff
	 ;; (all-testnames (delete-duplicates (map db:test-get-testname test-changes))))

    ;; Given a run-id and testname/item_path calculate a cell R:C

    ;; NOTE: Also build the test tree browser and look up table
    ;;
    ;; Each run is unique on its keys and runname or run-id, store in hash on colnum
    (for-each (lambda (run-id)
		(let* ((run-record (hash-table-ref/default runs-hash run-id #f))
		       (key-vals   (map (lambda (key)(db:get-value-by-header run-record header key))
					keys))
		       (run-name   (db:get-value-by-header run-record header "runname"))
		       (col-name   (conc (string-intersperse key-vals "\n") "\n" run-name))
		       (run-path   (append key-vals (list run-name))))
		  (hash-table-set! (dboard:tabdat-run-keys data) run-id run-path)
		  ;; modify cell - but only if changed
		  (set! changed (dcommon:modifiy-if-different (dboard:tabdat-runs-matrix data) cellname col-name changed))

		  (hash-table-set! runid-to-col run-id (list colnum run-record))
		  ;; Here we update the tests treebox and tree keys
		  (tree:add-node (dboard:tabdat-tests-tree data) "Runs" (append key-vals (list run-name))
				 userdata: (conc "run-id: " run-id))
		  (set! colnum (+ colnum 1))))
	      run-ids)

				(print "INFONOTE: run-path: " run-path)
				(tree:add-node (dboard:tabdat-tests-tree data) "Runs" 
					       test-path
					       userdata: (conc "test-id: " test-id))
				(let ((node-num (tree:find-node tb (cons "Runs" test-path)))
				      (color    (car (gutils:get-color-for-state-status state status))))
				  (debug:print 0 *default-log-port* "node-num: " node-num ", color: " color)

				  (set! changed (dcommon:modifiy-if-different 
						 tb
						 (conc "COLOR" node-num)
						 color changed))

				  ;; (iup:attribute-set! tb (conc "COLOR" node-num) color)
				  )
				(hash-table-set! (dboard:tabdat-path-test-ids data) test-path test-id)
				(if (not rownum)
				    (let ((rownums (hash-table-values testname-to-row)))
				      (set! rownum (if (null? rownums)
						       1
						       (+ 1 (apply max rownums))))
				      (hash-table-set! testname-to-row fullname rownum)
				      ;; create the label
				      (set! changed (dcommon:modifiy-if-different 
						     (dboard:tabdat-runs-matrix data)
						     (conc rownum ":" 0)
						     dispname
						     changed))
				      ;; (iup:attribute-set! (dboard:tabdat-runs-matrix data)
				      ;;   		  (conc rownum ":" 0) dispname)
				      ))
				;; set the cell text and color
				;; (debug:print 2 *default-log-port* "rownum:colnum=" rownum ":" colnum ", state=" status)
				(set! changed (dcommon:modifiy-if-different 
						     (dboard:tabdat-runs-matrix data)
						    (conc rownum ":" colnum)
						    (if (member state '("ARCHIVED" "COMPLETED"))
							status
							 state)
						     changed))
				;; (iup:attribute-set! (dboard:tabdat-runs-matrix data)
				;; 		    (conc rownum ":" colnum)
				;; 		    (if (member state '("ARCHIVED" "COMPLETED"))
				;; 			status
				;; 			state))
				(set! changed (dcommon:modifiy-if-different 
					       (dboard:tabdat-runs-matrix data)
						    (conc "BGCOLOR" rownum ":" colnum)
					       (car (gutils:get-color-for-state-status state status))
					       changed))
				;; (iup:attribute-set! (dboard:tabdat-runs-matrix data)
				;; 		    (conc "BGCOLOR" rownum ":" colnum)
				;; 		    (car (gutils:get-color-for-state-status state status)))
				))
			    tests)))
	      run-ids)

    (let ((updater (hash-table-ref/default  (dboard:commondat-updaters commondat) window-id #f)))
      (if updater (updater (hash-table-ref/default data get-details-sig #f))))

    (if changed (iup:attribute-set! (dboard:tabdat-runs-matrix data) "REDRAW" "ALL"))
    ;; (debug:print 2 *default-log-port* "run-changes: " run-changes)
    ;; (debug:print 2 *default-log-port* "test-changes: " test-changes)
    (list run-changes all-test-changes)))

;;======================================================================
;; TESTS DATA
;;======================================================================