Overview
Comment: | Added additional stats for non-transaction read/writes to db |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | newdashboard |
Files: | files | file ages | folders |
SHA1: |
ae23a0e4147c6fdf8fc9e3e431e5bbeb |
User & Date: | mrwellan on 2013-03-19 17:07:48 |
Other Links: | branch diff | manifest | tags |
Context
2013-03-19
| ||
17:08 | Merged newdashboard branch to development check-in: 8aed4ce36c user: mrwellan tags: development | |
17:07 | Added additional stats for non-transaction read/writes to db Closed-Leaf check-in: ae23a0e414 user: mrwellan tags: newdashboard | |
14:23 | Switched tests data to minimal amount needed for runs display check-in: 1b7e157405 user: mrwellan tags: newdashboard | |
Changes
Modified db.scm from [2542b667b5] to [2fe152a7f0].
︙ | ︙ | |||
751 752 753 754 755 756 757 | res)) ;; get a useful subset of the tests data (used in dashboard ;; use db:mintests-get-{id ,run_id,testname ...} (define (db:get-tests-for-runs-mindata db run-ids testpatt states status) (db:get-tests-for-runs db run-ids testpatt states status qryvals: "id,run_id,testname,state,status,event_time,item_path")) | < | 751 752 753 754 755 756 757 758 759 760 761 762 763 764 | res)) ;; get a useful subset of the tests data (used in dashboard ;; use db:mintests-get-{id ,run_id,testname ...} (define (db:get-tests-for-runs-mindata db run-ids testpatt states status) (db:get-tests-for-runs db run-ids testpatt states status qryvals: "id,run_id,testname,state,status,event_time,item_path")) ;; NB // This is get tests for "runs" (note the plural!!) ;; ;; states and statuses are lists, turn them into ("PASS","FAIL"...) and use NOT IN ;; i.e. these lists define what to NOT show. ;; states and statuses are required to be lists, empty is ok ;; not-in #t = above behaviour, #f = must match ;; run-ids is a list of run-ids or a single number |
︙ | ︙ | |||
1361 1362 1363 1364 1365 1366 1367 | (if (> cache-size *max-cache-size*) (set! *max-cache-size* cache-size))) #t) #f))) (define *db:process-queue-mutex* (make-mutex)) | | | > > | 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 | (if (> cache-size *max-cache-size*) (set! *max-cache-size* cache-size))) #t) #f))) (define *db:process-queue-mutex* (make-mutex)) (define *number-of-writes* 0) (define *writes-total-delay* 0) (define *total-non-write-delay* 0) (define *number-non-write-queries* 0) ;; The queue is a list of vectors where the zeroth slot indicates the type of query to ;; apply and the second slot is the time of the query and the third entry is a list of ;; values to be applied ;; (define (db:queue-write-and-wait db qry-sig query params) (let ((queue-len 0) |
︙ | ︙ | |||
1423 1424 1425 1426 1427 1428 1429 | (else (apply sqlite3:execute db query params) #t)))) (debug:print-info 7 "Received " response " from wrapped write") (server:reply return-address qry-sig response response)) ;; otherwise if appropriate flush the queue (this is a read or complex query) (begin | < < < < < > | | | > > > > > > | | | | | > > > | | | | | | | | | | | | | | | | | | | | | | | | | | | | 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 | (else (apply sqlite3:execute db query params) #t)))) (debug:print-info 7 "Received " response " from wrapped write") (server:reply return-address qry-sig response response)) ;; otherwise if appropriate flush the queue (this is a read or complex query) (begin (cond ((member stmt-key db:special-queries) (let ((starttime (current-milliseconds))) (debug:print-info 11 "Handling special statement " stmt-key) (case stmt-key ((immediate) ;; This is a read or mixed read-write query, must clear the cache (case *transport-type* ((http) (mutex-lock! *db:process-queue-mutex*) (db:process-cached-writes db) (mutex-unlock! *db:process-queue-mutex*))) (let* ((proc (car params)) (remparams (cdr params)) ;; we are being handed a procedure so call it ;; (debug:print-info 11 "Running (apply " proc " " remparams ")") (result (server:reply return-address qry-sig #t (apply proc remparams)))) (set! *total-non-write-delay* (+ *total-non-write-delay* (- (current-milliseconds) starttime))) (set! *number-non-write-queries* (+ *number-non-write-queries* 1)) result)) ((login) (if (< (length params) 3) ;; should get toppath, version and signature (server:reply return-address qry-sig '(#f "login failed due to missing params")) ;; missing params (let ((calling-path (car params)) (calling-vers (cadr params)) (client-key (caddr params))) (if (and (equal? calling-path *toppath*) (equal? megatest-version calling-vers)) (begin (hash-table-set! *logged-in-clients* client-key (current-seconds)) (server:reply return-address qry-sig #t '(#t "successful login"))) ;; path matches - pass! Should vet the caller at this time ... (server:reply return-address qry-sig #f (list #f (conc "Login failed due to mismatch paths: " calling-path ", " *toppath*))))))) ((flush sync) (server:reply return-address qry-sig #t 1)) ;; (length data))) ((set-verbosity) (set! *verbosity* (car params)) (server:reply return-address qry-sig #t '(#t *verbosity*))) ((killserver) (debug:print 0 "WARNING: Server going down in 15 seconds by user request!") (open-run-close tasks:server-deregister tasks:open-db (car *runremote*) pullport: (cadr *runremote*)) (thread-start! (make-thread (lambda ()(thread-sleep! 15)(exit)))) (server:reply return-address qry-sig #t '(#t "exit process started"))) (else ;; not a command, i.e. is a query (debug:print 0 "ERROR: Unrecognised query/command " stmt-key) (server:reply return-address qry-sig #f 'failed))))) (else (debug:print-info 11 "Executing " stmt-key " for " params) (apply sqlite3:execute (hash-table-ref queries stmt-key) params) (server:reply return-address qry-sig #t #t))))))) (define (db:test-get-records-for-index-file db run-id test-name) (let ((res '())) |
︙ | ︙ |
Modified http-transport.scm from [9e3e9e2469] to [ee09f9de43].
︙ | ︙ | |||
105 106 107 108 109 110 111 | ;; (mutex-unlock! *db:process-queue-mutex*) (debug:print-info 11 "Return value from db:process-queue-item is " res) (send-response body: (conc "<head>ctrl data</head>\n<body>" res "</body>") headers: '((content-type text/plain))))) (else (continue)))))))) | | < < | 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 | ;; (mutex-unlock! *db:process-queue-mutex*) (debug:print-info 11 "Return value from db:process-queue-item is " res) (send-response body: (conc "<head>ctrl data</head>\n<body>" res "</body>") headers: '((content-type text/plain))))) (else (continue)))))))) (http-transport:try-start-server ipaddrstr start-port))) ;; This is recursively run by http-transport:run until sucessful ;; (define (http-transport:try-start-server ipaddrstr portnum) (handle-exceptions exn (begin |
︙ | ︙ | |||
250 251 252 253 254 255 256 | (debug:print-info 0 "Starting to shutdown the server.") ;; need to delete only *my* server entry (future use) (set! *time-to-exit* #t) (tasks:server-deregister-self tdb (get-host-name)) (thread-sleep! 1) (debug:print-info 0 "Max cached queries was " *max-cache-size*) (debug:print-info 0 "Number of cached writes " *number-of-writes*) | | > > > > > > > > > > > > | 248 249 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 | (debug:print-info 0 "Starting to shutdown the server.") ;; need to delete only *my* server entry (future use) (set! *time-to-exit* #t) (tasks:server-deregister-self tdb (get-host-name)) (thread-sleep! 1) (debug:print-info 0 "Max cached queries was " *max-cache-size*) (debug:print-info 0 "Number of cached writes " *number-of-writes*) (debug:print-info 0 "Average cached write time " (if (eq? *number-of-writes* 0) "n/a (no writes)" (/ *writes-total-delay* *number-of-writes*)) " ms") (debug:print-info 0 "Number non-cached queries " *number-non-write-queries*) (debug:print-info 0 "Average non-cached time " (if (eq? *number-non-write-queries* 0) "n/a (no queries)" (/ *total-non-write-delay* *number-non-write-queries*)) " ms") (debug:print-info 0 "Server shutdown complete. Exiting") (exit))))))) ;; all routes though here end in exit ... (define (http-transport:launch) (if (not *toppath*) (if (not (setup-for-run)) |
︙ | ︙ |