Overview
| Comment: | Server control panel done |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | dev |
| Files: | files | file ages | folders |
| SHA1: |
e0d44ae25e993ed0dabee16311216709 |
| User & Date: | mrwellan on 2013-07-10 20:39:48 |
| Other Links: | branch diff | manifest | tags |
Context
|
2013-07-11
| ||
| 00:38 | Added [skip] prevrunning and fileexists. Fixed regression on SKIP color. Fixed bugs in mindata query, configf functions check-in: 45e8d324a3 user: mrwellan tags: dev | |
|
2013-07-10
| ||
| 20:39 | Server control panel done check-in: e0d44ae25e user: mrwellan tags: dev | |
| 18:15 | Added MT_TARGET to testconfig environment. Added first four chars of fossil node hash to version in server registry. check-in: d604df857c user: mrwellan tags: dev | |
Changes
Modified dashboard.scm from [7594703fba] to [61c5e670c0].
| ︙ | ︙ | |||
883 884 885 886 887 888 889 |
#:title "General Info"
(iup:hbox
(dcommon:keys-matrix rawconfig)
(dcommon:general-info)
))
(iup:frame
#:title "Server"
| < < < < < < | < < < < < < < < < < < < < < < < < | 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 |
#:title "General Info"
(iup:hbox
(dcommon:keys-matrix rawconfig)
(dcommon:general-info)
))
(iup:frame
#:title "Server"
(dcommon:servers-table)))
(iup:frame
#:title "Megatest config settings"
(iup:hbox
(dcommon:section-matrix rawconfig "setup" "Varname" "Value")
(iup:vbox
(dcommon:section-matrix rawconfig "server" "Varname" "Value")
;; (iup:frame
|
| ︙ | ︙ | |||
1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 |
(set! *last-db-update-time* (file-modification-time (conc *toppath* "/megatest.db"))))
(define (dashboard:recalc modtime please-update-buttons last-db-update-time)
(or please-update-buttons
(and (> modtime last-db-update-time)
(> (current-seconds)(+ last-db-update-time 1)))))
(define (dashboard:run-update x)
(let* ((modtime (file-modification-time *db-file-path*))
(run-update-time (current-seconds))
(recalc (dashboard:recalc modtime *please-update-buttons* *last-db-update-time*)))
(if recalc
| > > > > > > > > > | < | | 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 |
(set! *last-db-update-time* (file-modification-time (conc *toppath* "/megatest.db"))))
(define (dashboard:recalc modtime please-update-buttons last-db-update-time)
(or please-update-buttons
(and (> modtime last-db-update-time)
(> (current-seconds)(+ last-db-update-time 1)))))
(define *monitor-db-path* (conc *toppath* "/monitor.db"))
(define *last-monitor-update-time* 0)
(define (dashboard:run-update x)
(let* ((modtime (file-modification-time *db-file-path*))
(monitor-modtime (file-modification-time *monitor-db-path*))
(run-update-time (current-seconds))
(recalc (dashboard:recalc modtime *please-update-buttons* *last-db-update-time*)))
(if (and (eq? *current-tab-number* 0)
(> monitor-modtime *last-monitor-update-time*))
(begin
(set! *last-monitor-update-time* monitor-modtime)
(if dashboard:update-servers-table (dashboard:update-servers-table))))
(if recalc
(begin
(case *current-tab-number*
((0)
(if dashboard:update-summary-tab (dashboard:update-summary-tab)))
((1) ;; The runs table is active
(update-rundat (hash-table-ref/default *searchpatts* "runname" "%") *num-runs*
(hash-table-ref/default *searchpatts* "test-name" "%/%")
;; (hash-table-ref/default *searchpatts* "item-name" "%")
(let ((res '()))
(for-each (lambda (key)
(if (not (equal? key "runname"))
|
| ︙ | ︙ |
Modified dcommon.scm from [d64064e1b4] to [1e0e055bdf].
| ︙ | ︙ | |||
24 25 26 27 28 29 30 31 32 33 34 35 36 37 | (include "common_records.scm") (include "db_records.scm") (include "key_records.scm") ;; yes, this is non-ideal (define dashboard:update-summary-tab #f) ;;====================================================================== ;; C O M M O N D A T A S T R U C T U R E ;;====================================================================== ;; ;; A single data structure for all the data used in a dashboard. ;; Share this structure between newdashboard and dashboard with the | > | 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 | (include "common_records.scm") (include "db_records.scm") (include "key_records.scm") ;; yes, this is non-ideal (define dashboard:update-summary-tab #f) (define dashboard:update-servers-table #f) ;;====================================================================== ;; C O M M O N D A T A S T R U C T U R E ;;====================================================================== ;; ;; A single data structure for all the data used in a dashboard. ;; Share this structure between newdashboard and dashboard with the |
| ︙ | ︙ | |||
434 435 436 437 438 439 440 441 442 443 444 445 446 447 |
(updater)
(set! dashboard:update-summary-tab updater)
(iup:attribute-set! stats-matrix "WIDTHDEF" "40")
(iup:vbox
(iup:label "Run statistics" #:expand "HORIZONTAL")
stats-matrix)))
;; The main menu
(define (dcommon:main-menu)
(iup:menu ;; a menu is a special attribute to a dialog (think Gnome putting the menu at screen top)
(iup:menu-item "Files" (iup:menu ;; Note that you can use either #:action or action: for options
(iup:menu-item "Open" action: (lambda (obj)
(iup:show (iup:file-dialog))
(print "File->open " obj)))
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 |
(updater)
(set! dashboard:update-summary-tab updater)
(iup:attribute-set! stats-matrix "WIDTHDEF" "40")
(iup:vbox
(iup:label "Run statistics" #:expand "HORIZONTAL")
stats-matrix)))
(define (dcommon:servers-table)
(let* ((colnum 0)
(rownum 0)
(servers-matrix (iup:matrix #:expand "YES"
#:numcol 7
#:numcol-visible 7
#:numlin-visible 3
))
(colnames (list "Id" "MTver" "Pid" "Host" "Interface:OutPort" "InPort" "State" "Transport"))
(updater (lambda ()
(let ((servers (open-run-close tasks:get-all-servers tasks:open-db)))
(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
(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
(if (< (vector-ref server 10) 20) ;; Status (Please redo this properly!)
"alive"
"dead")
(vector-ref server 11) ;; Transport
)))
(for-each (lambda (val)
;; (print "rownum: " rownum " colnum: " colnum " val: " val)
(iup:attribute-set! servers-matrix (conc rownum ":" colnum) 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)
;; (iup:attribute-set! servers-matrix "WIDTHDEF" "40")
(iup:hbox
(iup:vbox
(iup:button "Start"
;; #:size "50x"
#:expand "YES"
#:action (lambda (obj)
(let ((cmd (conc ;; "xterm -geometry 180x20 -e \""
"megatest -server - &")))
;; ";echo Press any key to continue;bash -c 'read -n 1 -s'\" &")))
(system cmd))))
(iup:button "Stop"
#:expand "YES"
;; #:size "50x"
#:action (lambda (obj)
(let ((cmd (conc ;; "xterm -geometry 180x20 -e \""
"megatest -stop-server 0 &")))
;; ";echo Press any key to continue;bash -c 'read -n 1 -s'\" &")))
(system cmd))))
(iup:button "Restart"
#:expand "YES"
;; #:size "50x"
#:action (lambda (obj)
(let ((cmd (conc ;; "xterm -geometry 180x20 -e \""
"megatest -stop-server 0;megatest -server - &")))
;; ";echo Press any key to continue;bash -c 'read -n 1 -s'\" &")))
(system cmd)))))
servers-matrix
)))
;; The main menu
(define (dcommon:main-menu)
(iup:menu ;; a menu is a special attribute to a dialog (think Gnome putting the menu at screen top)
(iup:menu-item "Files" (iup:menu ;; Note that you can use either #:action or action: for options
(iup:menu-item "Open" action: (lambda (obj)
(iup:show (iup:file-dialog))
(print "File->open " obj)))
|
| ︙ | ︙ |