Megatest

  testpatt  ;; the testpatt widget
  )

;;======================================================================
;; D B
;;======================================================================

;; These are all using sql-de-lite and independent of area so cannot use stuff 
;; from db.scm

;; NB// run-id=#f => return dbdir only
;;
(define (areadb:dbfile-path areadat run-id)
  (let* ((cfgdat  (areadat-configdat areadat))
	 (dbdir   (or (configf:lookup cfgdat "setup" "dbdir")

			   (let ((id  (list-ref row 0))
				 (dat (apply make-rundat (append row (list #f #f))))) ;; add placeholders for tests and db
			     (hash-table-set! runs id dat)))
			 (sql maindb (conc "SELECT id,"
					   (string-intersperse keys "'||/||'")
					   ",runname,state,status,event_time FROM runs WHERE state != 'DELETED';"))))
    areadat))
			
;;======================================================================
;; D A S H B O A R D   D B 
;;======================================================================
		
(define (mddb:open-db)
  (let* ((db (open-database (conc (get-environment-variable "HOME") "/.dashboard.db"))))
    (set-busy-handler! db (busy-timeout 10000))
    (for-each
     (lambda (qry)
       (exec (sql db qry)))
     (list 
      "CREATE TABLE IF NOT EXISTS vars       (id INTEGER PRIMARY KEY,key TEXT, val TEXT, CONSTRAINT varsconstraint UNIQUE (key));"
      "CREATE TABLE IF NOT EXISTS dashboards (
          id   INTEGER PRIMARY KEY,
          pid  INTEGER,
          user TEXT,
          host TEXT,
          port INTEGER,
          start_time TIMESTAMP DEFAULT (strftime('%s','now'))
        );"
      ))
    db))

   
;; register a dashboard 
;;
(define (mddb:register-dashboard port)
  (let* ((pid      (current-process-id))
	 (hostname (get-host-name))
	 (username (current-user-name)) ;; (car userinfo)))
	 (db      (mddb:open-db)))
    (print "Register monitor, pid: " pid ", hostname: " hostname ", port: " port ", username: " username)
    (exec (sql db "INSERT OR REPLACE INTO dashboards (pid,user,host,port) VALUES (?,?,?,?);")
	   pid hostname port username)))

;; unregister a monitor
;;
(define (mddb:unregister-dashboard areadat host port)
  (let* ((db      (mddb:open-db)))
    (print "Register unregister monitor, host:port=" host ":" port)
    (exec (sql db "DELETE FROM monitors WHERE host=? AND port=?;")
	   host port)))

;;======================================================================
;; T R E E 
;;======================================================================

;; <area> - <target - ... > - <runname> - <test> - <itempath - ...>

;; ease debugging by loading ~/.dashboardrc
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))
  (if (file-exists? debugcontrolf)
      (load debugcontrolf)))

(let-values 
 (((con port)(dboard:server-start #f)))
 ;; got here, monitor/dashboard was started
 (mddb:register-dashboard port)
 (thread-start! (make-thread (lambda ()(dboard:server-service con port)) "server service"))
 (dboard:make-window 0)
 (mddb:unregister-dashboard (get-host-name) port)
 (dboard:server-close con port))

     (lambda (id pid host last-update delta)
       (print "Going to delete stale record for monitor with pid " pid " on host " host " last updated " delta " seconds ago")
       (set! deadlist (cons id deadlist)))
     mdb 
     "SELECT id,pid,hostname,last_update,strftime('%s','now')-last_update AS delta FROM monitors WHERE delta > 700;")
    (sqlite3:execute mdb (conc "DELETE FROM monitors WHERE id IN ('" (string-intersperse (map conc deadlist) "','") "');")))
  )
(define (tasks:register-monitor db port)
  (let* ((pid (current-process-id))
	 (hostname (get-host-name))
	 (userinfo (user-information (current-user-id)))
	 (username (car userinfo)))
    (print "Register monitor, pid: " pid ", hostname: " hostname ", port: " port ", username: " username)
    (sqlite3:execute db "INSERT INTO monitors (pid,start_time,last_update,hostname,username) VALUES (?,strftime('%s','now'),strftime('%s','now'),?,?);"
		     pid hostname username)))

(define (tasks:get-num-alive-monitors mdb)
  (let ((res 0))
    (sqlite3:for-each-row 
     (lambda (count)
       (set! res count))