Megatest

Diff
Login

Differences From Artifact [eb6ea73393]:

To Artifact [17ed94a823]:


10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
;;======================================================================

(use format)
(require-library iup)
(import (prefix iup iup:))
(use canvas-draw)
(import canvas-draw-iup)
(use regex typed-records)

(declare (unit dcommon))

(declare (uses megatest-version))
(declare (uses gutils))
(declare (uses db))
(declare (uses synchash))







|







10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
;;======================================================================

(use format)
(require-library iup)
(import (prefix iup iup:))
(use canvas-draw)
(import canvas-draw-iup)
(use regex typed-records matchable)

(declare (unit dcommon))

(declare (uses megatest-version))
(declare (uses gutils))
(declare (uses db))
(declare (uses synchash))
618
619
620
621
622
623
624

625
626
627
628
629
630
631
632
633
634
635
636






637
638
639
640
641
642
643
644

645
646
647
648

649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
				     #:numcol 7
				     #:numcol-visible 7
				     #:numlin-visible 5
				     ))
	 (colnames       (list "Id" "MTver" "Pid" "Host" "Interface:OutPort" "RunTime" "State" "RunId"))
	 (updater        (lambda ()
			   (if (dashboard:monitor-changed? commondat tabdat)

			       (let ((servers (tasks:get-all-servers (db:delay-if-busy tdbdat))))
				 (iup:attribute-set! servers-matrix "NUMLIN" (length servers))
				 ;; (set! colnum 0)
				 ;; (for-each (lambda (colname)
				 ;;    	 ;; (print "colnum: " colnum " colname: " colname)
				 ;;    	 (iup:attribute-set! servers-matrix (conc "0:" colnum) colname)
				 ;;    	 (set! colnum (+ 1 colnum)))
				 ;;           colnames)
				 (set! rownum 1)
				 (for-each 
				  (lambda (server)
				    (set! colnum 0)






				    (let* ((vals (list (vector-ref server 0) ;; Id
						       (vector-ref server 9) ;; MT-Ver
						       (vector-ref server 1) ;; Pid
						       (vector-ref server 2) ;; Hostname
						       (conc (vector-ref server 3) ":" (vector-ref server 4)) ;; IP:Port
						       (seconds->hr-min-sec (- (current-seconds)(vector-ref server 6)))
						       ;; (vector-ref server 5) ;; Pubport
						       ;; (vector-ref server 10) ;; Last beat

						       ;; (vector-ref server 6) ;; Start time
						       ;; (vector-ref server 7) ;; Priority
						       ;; (vector-ref server 8) ;; State
						       (vector-ref server 8) ;; State

						       (vector-ref server 12)  ;; RunId
						       )))
				      (for-each (lambda (val)
						  (let* ((row-col (conc rownum ":" colnum))
							 (curr-val (iup:attribute servers-matrix row-col)))
						    (if (not (equal? (conc val) curr-val))
							(begin
							  (iup:attribute-set! servers-matrix row-col val)
							  (iup:attribute-set! servers-matrix "FITTOTEXT" (conc "C" colnum))))
						    (set! colnum (+ 1 colnum))))
						vals)
				      (set! rownum (+ rownum 1)))
				    (iup:attribute-set! servers-matrix "REDRAW" "ALL"))
				  servers))))))
    (set! colnum 0)
    (for-each (lambda (colname)
		(iup:attribute-set! servers-matrix (conc "0:" colnum) colname)
		(iup:attribute-set! servers-matrix "FITTOTEXT" (conc "C" colnum))
		(set! colnum (+ colnum 1)))
	      colnames)
    ;; (set! dashboard:update-servers-table updater) 







>
|











>
>
>
>
>
>
|
|
|
|
|
<
|
<
>
|
<
<
|
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|







618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648

649

650
651


652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
				     #:numcol 7
				     #:numcol-visible 7
				     #:numlin-visible 5
				     ))
	 (colnames       (list "Id" "MTver" "Pid" "Host" "Interface:OutPort" "RunTime" "State" "RunId"))
	 (updater        (lambda ()
			   (if (dashboard:monitor-changed? commondat tabdat)
			       (let ((servers  (server:get-list *toppath*)))
				 ;; (tasks:get-all-servers (db:delay-if-busy tdbdat))))
				 (iup:attribute-set! servers-matrix "NUMLIN" (length servers))
				 ;; (set! colnum 0)
				 ;; (for-each (lambda (colname)
				 ;;    	 ;; (print "colnum: " colnum " colname: " colname)
				 ;;    	 (iup:attribute-set! servers-matrix (conc "0:" colnum) colname)
				 ;;    	 (set! colnum (+ 1 colnum)))
				 ;;           colnames)
				 (set! rownum 1)
				 (for-each 
				  (lambda (server)
				    (set! colnum 0)
				    (match-let (((mod-time host port start-time pid)
						 server))
				      (let* ((uptime  (- (current-seconds) mod-time))
					     (runtime (if start-time
							  (- (current-seconds) start-time)
							  0))
					     (vals (list "-"  ;; (vector-ref server 0) ;; Id
							 "-"  ;; (vector-ref server 9) ;; MT-Ver
							 pid  ;; (vector-ref server 1) ;; Pid
							 host ;; (vector-ref server 2) ;; Hostname
							 (conc host ":" port) ;; (conc (vector-ref server 3) ":" (vector-ref server 4)) ;; IP:Port

							 (seconds->hr-min-sec runtime) ;; (- (current-seconds) start-time)) ;; (vector-ref server 6)))

							 (cond
							  ((< uptime 5)  "alive")


							  ((< uptime 16) "probably alive");; less than 15 seconds since mod, call it alive (vector-ref server 8) ;; State
							  (else "dead"))
							 "-" ;; (vector-ref server 12)  ;; RunId
							 )))
					(for-each (lambda (val)
						    (let* ((row-col (conc rownum ":" colnum))
							   (curr-val (iup:attribute servers-matrix row-col)))
						      (if (not (equal? (conc val) curr-val))
							  (begin
							    (iup:attribute-set! servers-matrix row-col val)
							    (iup:attribute-set! servers-matrix "FITTOTEXT" (conc "C" colnum))))
						      (set! colnum (+ 1 colnum))))
						  vals)
					(set! rownum (+ rownum 1)))
				      (iup:attribute-set! servers-matrix "REDRAW" "ALL")))
				    (sort servers (lambda (a b)(< (car a)(car b))))))))))
    (set! colnum 0)
    (for-each (lambda (colname)
		(iup:attribute-set! servers-matrix (conc "0:" colnum) colname)
		(iup:attribute-set! servers-matrix "FITTOTEXT" (conc "C" colnum))
		(set! colnum (+ colnum 1)))
	      colnames)
    ;; (set! dashboard:update-servers-table updater)