Overview
Comment: | Partial edits towards getting dashboard responding to db changes after moving to /tmp |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.62-no-rpc |
Files: | files | file ages | folders |
SHA1: |
a861379b8383d7e70506241ac06b1662 |
User & Date: | matt on 2016-11-21 00:02:29 |
Other Links: | branch diff | manifest | tags |
Context
2016-11-21
| ||
08:18 | update to arch figure check-in: dea64201d8 user: mrwellan tags: v1.62-no-rpc | |
00:02 | Partial edits towards getting dashboard responding to db changes after moving to /tmp check-in: a861379b83 user: matt tags: v1.62-no-rpc | |
2016-11-20
| ||
20:56 | Lock on homehost. Servers *always* started if not on homehost check-in: efae6c6bbf user: matt tags: v1.62-no-rpc | |
Changes
Modified common.scm from [46ccba8588] to [7c2ea3f6ac].
︙ | ︙ | |||
94 95 96 97 98 99 100 101 102 103 104 105 106 107 | (define *megatest-db* #f) (define *last-db-access* (current-seconds)) ;; update when db is accessed via server (define *db-write-access* #t) (define *inmemdb* #f) (define *task-db* #f) ;; (vector db path-to-db) (define *db-access-allowed* #t) ;; flag to allow access (define *db-access-mutex* (make-mutex)) ;; SERVER (define *my-client-signature* #f) (define *transport-type* 'http) (define *transport-type* 'http) ;; override with [server] transport http|rpc|nmsg (define *runremote* (make-hash-table)) ;; if set up for server communication this will hold <host port> (define *max-cache-size* 0) | > | 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 | (define *megatest-db* #f) (define *last-db-access* (current-seconds)) ;; update when db is accessed via server (define *db-write-access* #t) (define *inmemdb* #f) (define *task-db* #f) ;; (vector db path-to-db) (define *db-access-allowed* #t) ;; flag to allow access (define *db-access-mutex* (make-mutex)) (define *db-cache-path* #f) ;; SERVER (define *my-client-signature* #f) (define *transport-type* 'http) (define *transport-type* 'http) ;; override with [server] transport http|rpc|nmsg (define *runremote* (make-hash-table)) ;; if set up for server communication this will hold <host port> (define *max-cache-size* 0) |
︙ | ︙ | |||
391 392 393 394 395 396 397 | (define (common:get-testsuite-name) (or (configf:lookup *configdat* "setup" "testsuite" ) (if *toppath* (pathname-file *toppath*) (pathname-file (current-directory))))) (define (common:get-db-tmp-area) | > > | | | | > > | 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 | (define (common:get-testsuite-name) (or (configf:lookup *configdat* "setup" "testsuite" ) (if *toppath* (pathname-file *toppath*) (pathname-file (current-directory))))) (define (common:get-db-tmp-area) (if *db-cache-path* *db-cache-path* (let ((dbpath (create-directory (conc "/tmp/" (current-user-name) "/megatest_cachedb/" (common:get-testsuite-name) "/" (string-translate *toppath* "/" ".")) #t))) (set! *db-cache-path* dbpath) dbpath))) ;;====================================================================== ;; E X I T H A N D L I N G ;;====================================================================== (define (common:legacy-sync-recommended) (or (args:get-arg "-runtests") |
︙ | ︙ |
Modified dashboard-tests.scm from [2a1074e05f] to [e8603abab6].
︙ | ︙ | |||
156 157 158 159 160 161 162 | ;;====================================================================== ;; Run info panel ;;====================================================================== (define (run-info-panel db keydat testdat runname) (let* ((run-id (db:test-get-run_id testdat)) | | | 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 | ;;====================================================================== ;; Run info panel ;;====================================================================== (define (run-info-panel db keydat testdat runname) (let* ((run-id (db:test-get-run_id testdat)) (rundat (rmt:get-run-info run-id)) (header (db:get-header rundat)) (event_time (db:get-value-by-header (db:get-rows rundat) (db:get-header rundat) "event_time"))) (iup:frame #:title "Megatest Run Info" ; #:expand "YES" (iup:hbox ; #:expand "YES" |
︙ | ︙ | |||
414 415 416 417 418 419 420 | ;;====================================================================== ;; ;;====================================================================== (define (dashboard-tests:examine-test run-id test-id) ;; run-id run-key origtest) (let* ((db-path (db:dbfile-path run-id)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/db/" run-id ".db")) | | | | 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 | ;;====================================================================== ;; ;;====================================================================== (define (dashboard-tests:examine-test run-id test-id) ;; run-id run-key origtest) (let* ((db-path (db:dbfile-path run-id)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/db/" run-id ".db")) (dbstruct #f) ;; (make-dbr:dbstruct path: (db:dbfile-path #f) ;; (configf:lookup *configdat* "setup" "linktree") ;; local: #t)) (testdat (rmt:get-test-info-by-id run-id test-id)) ;; (db:get-test-info-by-id dbstruct run-id test-id)) (db-mod-time 0) ;; (file-modification-time db-path)) (last-update 0) ;; (current-seconds)) (request-update #t)) (if (not testdat) (begin (debug:print 2 *default-log-port* "ERROR: No test data found for test " test-id ", exiting") |
︙ | ︙ |
Modified dashboard.scm from [ef1ffd321d] to [3bb1b86063].
︙ | ︙ | |||
115 116 117 118 119 120 121 | update-mutex updaters updating uidat ;; needs to move to tabdat at some time hide-not-hide-tabs ) | < | 115 116 117 118 119 120 121 122 123 124 125 126 127 128 | update-mutex updaters updating uidat ;; needs to move to tabdat at some time hide-not-hide-tabs ) (define (dboard:commondat-make) (make-dboard:commondat curr-tab-num: 0 tabdats: (make-hash-table) please-update: #t update-mutex: (make-mutex) updaters: (make-hash-table) |
︙ | ︙ | |||
2032 2033 2034 2035 2036 2037 2038 | (debug:catch-and-dump (lambda () (mark-for-update tabdat) (update-search commondat tabdat "test-name" val)) "make-controls"))) (iup:hbox (iup:button "Quit" #:action (lambda (obj) | < | 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 | (debug:catch-and-dump (lambda () (mark-for-update tabdat) (update-search commondat tabdat "test-name" val)) "make-controls"))) (iup:hbox (iup:button "Quit" #:action (lambda (obj) (exit)) #:expand "NO" #:size "40x15") (iup:button "Refresh" #:action (lambda (obj) (mark-for-update tabdat)) #:expand "NO" #:size "40x15") (iup:button "Collapse" #:action (lambda (obj) (debug:catch-and-dump |
︙ | ︙ | |||
2583 2584 2585 2586 2587 2588 2589 | (handle-exceptions exn (begin (debug:print 0 *default-log-port* "WARNING: error in accessing databases in get-youngest-run-db-mod-time: " ((condition-property-accessor 'exn 'message) exn)) (current-seconds)) ;; something went wrong - just print an error and return current-seconds (common:max (map (lambda (filen) (file-modification-time filen)) | | | 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 | (handle-exceptions exn (begin (debug:print 0 *default-log-port* "WARNING: error in accessing databases in get-youngest-run-db-mod-time: " ((condition-property-accessor 'exn 'message) exn)) (current-seconds)) ;; something went wrong - just print an error and return current-seconds (common:max (map (lambda (filen) (file-modification-time filen)) (glob (conc (dboard:tabdat-dbdir tabdat) "/*.db*")))))) (define (dashboard:monitor-changed? commondat tabdat) (let* ((run-update-time (current-seconds)) (monitor-db-path (dboard:tabdat-monitor-db-path tabdat)) (monitor-modtime (if (and monitor-db-path (file-exists? monitor-db-path)) (file-modification-time monitor-db-path) -1))) |
︙ | ︙ | |||
3317 3318 3319 3320 3321 3322 3323 | (dashboard-tests:examine-test run-id test-id) (begin (debug:print 3 *default-log-port* "INFO: tried to open test with invalid run-id,test-id. " (args:get-arg "-test")) (exit 1))))) ;; ((args:get-arg "-guimonitor") ;; (gui-monitor (dboard:tabdat-dblocal tabdat))) (else | | | 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 | (dashboard-tests:examine-test run-id test-id) (begin (debug:print 3 *default-log-port* "INFO: tried to open test with invalid run-id,test-id. " (args:get-arg "-test")) (exit 1))))) ;; ((args:get-arg "-guimonitor") ;; (gui-monitor (dboard:tabdat-dblocal tabdat))) (else (dboard:commondat-uidat-set! commondat (make-dashboard-buttons commondat)) (dboard:commondat-curr-tab-num-set! commondat 0) (dboard:commondat-add-updater commondat (lambda () (dashboard:runs-tab-updater commondat 1)) tab-num: 1) (iup:callback-set! *tim* |
︙ | ︙ |
Modified db.scm from [8a10ffb751] to [3ea07afb90].
︙ | ︙ | |||
184 185 186 187 188 189 190 | (if (not (directory? dbdir))(create-directory dbdir #t))) (if fname (conc dbdir "/" fname) dbdir))) ;; Returns the database location as specified in config file ;; | | | | | 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 | (if (not (directory? dbdir))(create-directory dbdir #t))) (if fname (conc dbdir "/" fname) dbdir))) ;; Returns the database location as specified in config file ;; (define db:get-dbdir common:get-db-tmp-area) ;; (or (configf:lookup *configdat* "setup" "dbdir") ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))) (define (db:set-sync db) (let ((syncprag (configf:lookup *configdat* "setup" "sychronous"))) (sqlite3:execute db (conc "PRAGMA synchronous = " (or syncprag 1) ";")))) ;; open an sql database inside a file lock ;; returns: db existed-prior-to-opening |
︙ | ︙ |