Megatest

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

(if (not (common:on-homehost?))
    (begin
      (debug:print 0 *default-log-port* "WARNING: Current policy requires running dashboard on homehost: " (common:get-homehost))))
    
;; TODO: Move this inside (main)
;;
(if (not (launch:setup))
    (begin
      (print "Failed to find megatest.config, exiting") 
      (exit 1)))

;; RA => Might require revert for filters 
;; create a watch dog to move changes from lt/.db/*.db to megatest.db
;;
;;;(if (file-write-access? (conc *toppath* "/megatest.db"))
;;(debug:print-info 13 *default-log-port* "Before common:watchdog spawn")
(thread-start! (make-thread common:watchdog "Watchdog thread"))
;;(debug:print-info 13 *default-log-port* "After common:watchdog spawn")
;; (if (not (args:get-arg "-use-db-cache"))
;;     (begin
;;       (debug:print-info 0 *default-log-port* "Forcing db-cache mode due to read-only access to megatest.db")
;;       (hash-table-set! args:arg-hash "-use-db-cache" #t)));;;)
;;)

;; data common to all tabs goes here
;;
(defstruct dboard:commondat
  ((curr-tab-num 0) : number)
  please-update  
  tabdats

  states                                                ;; states for -state s1,s2 ...
  statuses                                              ;; statuses for -status s1,s2 ...
						         
  ;; Selector variables				         
  curr-run-id                                           ;; current row to display in Run summary view
  prev-run-id                                           ;; previous runid selected before current runid was selected (used in xor-two-runs runs summary mode
  curr-test-ids                                         ;; used only in dcommon:run-update which is used in newdashboard
  ((filters-changed  #t)                  : boolean)    ;; to indicate that the user changed filters for this tab
  ((last-filter-str  "")                  : string)      ;; conc the target runname and testpatt for a signature of changed filters
  ((hide-empty-runs  #f)                  : boolean)     
  ((hide-not-hide    #t)                  : boolean)     ;; toggle for hide/not hide empty runs
  (hide-not-hide-button #f)
  ((searchpatts        (make-hash-table)) : hash-table)  ;;
  ((state-ignore-hash  (make-hash-table)) : hash-table)  ;; hash of  STATE => #t/#f for display control
  ((status-ignore-hash (make-hash-table)) : hash-table)  ;; hash of STATUS => #t/#f

(define (dboard:get-tests-for-run-duplicate tabdat run-id run testnamepatt key-vals)
  (let* ((start-time   (current-seconds))
	 (access-mode  (dboard:tabdat-access-mode tabdat))
         (num-to-get   (string->number (or (configf:lookup *configdat* "setup" "num-tests-to-get")
                                           "200")))
	 (states       (hash-table-keys (dboard:tabdat-state-ignore-hash tabdat)))
	 (statuses     (hash-table-keys (dboard:tabdat-status-ignore-hash tabdat)))
         (do-not-use-db-file-timestamps #t) ;; (configf:lookup *configdat* "setup" "do-not-use-db-file-timestamps")) ;; this still hosts runs-summary-tab
         (do-not-use-query-timestamps   #t) ;; (configf:lookup *configdat* "setup" "do-not-use-query-timestamps")) ;; this no longer troubles runs-summary-tab
	 (sort-info    (get-curr-sort))
	 (sort-by      (vector-ref sort-info 1))
	 (sort-order   (vector-ref sort-info 2))
	 (bubble-type  (if (member sort-order '(testname))
			   'testname
			   'itempath))
	 ;; note: the rundat is normally created in "update-rundat". 
	 (run-dat      (or (hash-table-ref/default (dboard:tabdat-allruns-by-id tabdat) run-id #f)
			   (let ((rd (dboard:rundat-make-init run: run key-vals: key-vals)))
			     (hash-table-set! (dboard:tabdat-allruns-by-id tabdat) run-id rd)
			     rd)))
	 ;; (prev-tests  (dboard:rundat-tests prev-dat)) ;; (vector-ref prev-dat 1))
         (last-update  (if ;;(or
                        do-not-use-query-timestamps
                        ;;(dboard:tabdat-filters-changed tabdat))
                        0
                        (dboard:rundat-last-update run-dat)))
	 (last-db-time (if do-not-use-db-file-timestamps
			   0
			   (dboard:rundat-last-db-time run-dat)))
	 (db-path      (or (dboard:rundat-db-path run-dat)
			   (let* ((db-dir (common:get-db-tmp-area))
				  (db-pth (conc db-dir "/megatest.db")))
			     (dboard:rundat-db-path-set! run-dat db-pth)

					     (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "test-name" "%/%")
					     (hash-table-keys (dboard:tabdat-state-ignore-hash tabdat))  ;; '()
					     (hash-table-keys (dboard:tabdat-status-ignore-hash tabdat)) ;; '()
					     #f #f                                                       ;; offset limit
					     (dboard:tabdat-hide-not-hide tabdat)                        ;; not-in
					     #f #f                                                       ;; sort-by sort-order
					     #f ;; get all? "id,testname,item_path,state,status,event_time,run_duration"                        ;; qryval
                                             (if (dboard:tabdat-filters-changed tabdat)
					         0
					         last-update)
					     *dashboard-mode*)
		  '()))) ;; get 'em all
    ;; (debug:print 0 *default-log-port* "dboard:get-tests-dat: got " (length tdat) " test records for run " run-id)
    (sort tdat (lambda (a b)
		 (let* ((aval (vector-ref a 2))
			(bval (vector-ref b 2))
			(anum (string->number aval))

         (tests-ht     (dboard:get-tests-for-run-duplicate tabdat run-id run testnamepatt key-vals))
         (tests-dat    (dashboard:tests-ht->tests-dat tests-ht)) 
         (tests-mindat (dcommon:minimize-test-data tests-dat)))  ;; reduces data for display
    (dboard:tabdat-last-runs-update-set! tabdat (- (current-seconds) 2))
    (hash-table-set! (dboard:tabdat-last-test-dat tabdat) run-id tests-dat)
    (hash-table-set! (dboard:tabdat-run-update-times tabdat) run-id (- (current-seconds) 10))
    (when (not run)
        (debug:print-info 13 *default-log-port* "ERROR: NO RUN FOR RUN-ID run-id="run-id)
        (debug:print-info 13 *default-log-port* "runs-hash-> " (hash-table->alist runs-hash))
        )
    tests-mindat))

(define (dashboard:runs-summary-xor-matrix-content tabdat runs-hash #!key (hide-clean #f))
  (let* ((src-run-id (dboard:tabdat-prev-run-id tabdat))
         (dest-run-id (dboard:tabdat-curr-run-id tabdat)))
    (if (and src-run-id dest-run-id)

                                   (col-num   (cadr (assoc col-name col-indices)))
                                   (key       (conc row-num ":" col-num)))
                              (hash-table-set! cell-lookup key test-id)
                              (if (not (equal? (iup:attribute run-matrix key) (cadr value)))
                                  (begin
                                    (set! changed #t)
                                    (iup:attribute-set! run-matrix key (cadr value))

                                    (iup:attribute-set! run-matrix (conc "BGCOLOR" key) (car value))))))
                          matrix-content)
                
                ;; Col labels - do after setting Cell contents so they are accounted for in the size calc.
                
                (for-each (lambda (ind)
                            (let* ((name (car ind))

                        (debug:catch-and-dump
                         (lambda ()

                           ;; Bummer - we dont have the global get/set api mapped in chicken
                           ;; (let* ((modkeys (iup:global "MODKEYSTATE")))
                           ;;   (BB> "modkeys="modkeys))

                           (debug:print-info 13 *default-log-port* "click-cb: obj="obj" lin="lin" col="col" status="status)
                           ;; status is corrupted on Brandon's home machine.  will have to wait until after shutdown to see if it is still broken in PDX SLES
                           (let* ((toolpath (car (argv)))
                                  (key      (conc lin ":" col))
                                  (test-id   (hash-table-ref/default cell-lookup key -1))
                                  (run-id   (dboard:tabdat-curr-run-id tabdat))
                                  (run-info (rmt:get-run-info run-id))
                                  (target   (rmt:get-target run-id))

                                                    "%")))
                                  (item-path (db:test-get-item-path (rmt:get-test-info-by-id run-id test-id)))
                                  (item-test-path (conc test-name "/" (if (equal? item-path "")
									"%" 
									item-path)))
                                  (status-chars (char-set->list (string->char-set status)))
                                  (testpanel-cmd      (conc toolpath " -test " (dboard:tabdat-curr-run-id tabdat) "," test-id " &")))
                             (debug:print-info 13 *default-log-port* "status-chars=["status-chars"] status=["status"]")
                             (cond
                              ((member #\1 status-chars) ;; 1 is left mouse button
                               (system testpanel-cmd))
                              
                              ((member #\2 status-chars) ;; 2 is middle mouse button
                               
                               (debug:print-info 13 *default-log-port* "mmb- test-name="test-name" testpatt="testpatt)
                               (iup:show (dashboard:popup-menu run-id test-id target runname test-name testpatt item-test-path) ;; popup-menu
                                         #:x 'mouse
                                         #:y 'mouse
                                         #:modal? "NO")
                               )
                              (else
                               (debug:print-info 13 *default-log-port* "unhandled status in run-summary-click-cb.  Doing right click action. (status is corrupted on Brandon's ubuntu host - bad/buggy  iup install??" )
                               (iup:show (dashboard:popup-menu run-id test-id target runname test-name testpatt item-test-path) ;; popup-menu
                                         #:x 'mouse
                                         #:y 'mouse
                                         #:modal? "NO")
                               )
                              )
                            

      (cond ;; nb// no else for this approach.
       ((>= runnum nruns) #f)
       ((>= keynum nkeys) 
	(vector-set! header runnum keyvec)
	(set! hdrlst (cons (apply iup:vbox (reverse res)) hdrlst))
	(loop (+ runnum 1) 0 (make-vector nkeys) '()))
       (else
	(let ((labl  (iup:label "" #:size (conc cell-width btn-height)  #:fontsize btn-fontsz #:expand "HORIZONTAL"))) ;; #:expand "HORIZONTAL" "60x15" 
	  (vector-set! keyvec keynum labl)
	  (loop runnum (+ keynum 1) keyvec (cons labl res))))))
    ;; By here the hdrlst contains a list of vboxes containing nkeys labels
    (let loop ((runnum  0)
	       (testnum 0)
	       (testvec  (make-vector ntests))
	       (res    '()))
      (cond
       ((>= runnum nruns) #f) ;;  (vector tableheader runsvec))
       ((>= testnum ntests) 
	(vector-set! runsvec runnum testvec)
	(set! bdylst (cons (apply iup:vbox (reverse res)) bdylst))
	(loop (+ runnum 1) 0 (make-vector ntests) '()))
       (else
	(let* ((button-key (mkstr runnum testnum))
	       (butn       (iup:button
			    "" ;; button-key 
			    #:size (conc cell-width btn-height )
			    #:expand "HORIZONTAL"
			    #:fontsize btn-fontsz
			    #:button-cb
			    (lambda (obj a pressed x y btn . rem)
			      ;; (print "pressed= " pressed " x= " x " y= " y " rem=" rem " btn=" btn " string? " (string? btn))
			      (if  (substring-index "3" btn)
				   (if (eq? pressed 1)
				       (let* ((toolpath (car (argv)))

     (let* ((tabdat (dboard:common-get-tabdat commondat tab-num: tab-num))
	    (dbkeys (dboard:tabdat-dbkeys tabdat)))
       ;;(print "RA => calling runs-tab-updater with commondat " commondat " tab-num " tab-num)
       ;;(tabdat-values tabdat) ;;RA added 
       ;; (pp (dboard:tabdat->alist tabdat))
       ;; (if (dashboard:database-changed? commondat tabdat context-key: 'runs-rundat)      
       (dashboard:do-update-rundat tabdat)
       ;;(debug:print-info 13 *default-log-port* "dashboard:runs-tab-updater")
       ;;(inspect tabdat)

       (let ((uidat (dboard:commondat-uidat commondat)))
	 ;;(print "RA => Calling update-buttons with tabdat : " tabdat " uidat " uidat)
	 (update-buttons tabdat uidat (dboard:tabdat-numruns tabdat) (dboard:tabdat-num-tests tabdat)))
       ))
   "dashboard:runs-tab-updater"))