182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
|
testpatt ;; the testpatt widget
)
;;======================================================================
;; D B
;;======================================================================
;; These are all using sqlite 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")
|
|
|
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
|
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")
|
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
|
(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))
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
|
(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 - ...>
|
574
575
576
577
578
579
580
581
582
583
584
|
;; 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)))
(thread-start! (make-thread (lambda ()(dboard:server-service con port)) "server service"))
(dboard:make-window 0)
(dboard:server-close con port))
|
>
>
>
|
616
617
618
619
620
621
622
623
624
625
626
627
628
629
|
;; 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))
|