Overview
| Comment: | Caching extended to couple more calls. Impact seems dramatic. However note that likely not all scenarios for clearing the cache are covered. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.80-servload |
| Files: | files | file ages | folders |
| SHA1: |
4126673c032abe8f9977e6e61d44629e |
| User & Date: | matt on 2023-04-17 23:12:43 |
| Other Links: | branch diff | manifest | tags |
Context
|
2023-04-18
| ||
| 08:31 | Start of moving rollup off the server check-in: 95c5f92eb5 user: matt tags: v1.80-servload | |
|
2023-04-17
| ||
| 23:12 | Caching extended to couple more calls. Impact seems dramatic. However note that likely not all scenarios for clearing the cache are covered. check-in: 4126673c03 user: matt tags: v1.80-servload | |
| 17:28 | cache get-test-info-by-id check-in: 1443998a16 user: matt tags: v1.80-servload | |
Changes
Modified db.scm from [ad327ec6e0] to [78fbf3122c].
| ︙ | ︙ | |||
2313 2314 2315 2316 2317 2318 2319 | ;; ;; speed up for common cases with a little logic ;; ;; NB// Ultimately this will be deprecated in deference to mt:test-set-state-status-by-id ;; ;; NOTE: run-id is not used ;; ;; (define (db:test-set-state-status dbstruct run-id test-id newstate newstatus newcomment) | > | > | 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 |
;; ;; speed up for common cases with a little logic
;; ;; NB// Ultimately this will be deprecated in deference to mt:test-set-state-status-by-id
;;
;; NOTE: run-id is not used
;; ;;
(define (db:test-set-state-status dbstruct run-id test-id newstate newstatus newcomment)
(let* ((hash-key (cons run-id test-id)))
(hash-table-delete! *db:get-test-info-by-id-cache* hash-key)
(hash-table-delete! *db:get-test-state-status-by-id-cache*hash-key))
(db:with-db
dbstruct
run-id #t
(lambda (dbdat db)
(db:test-set-state-status-db db run-id test-id newstate newstatus newcomment))))
(define (db:test-set-state-status-db db run-id test-id newstate newstatus newcomment)
|
| ︙ | ︙ | |||
2449 2450 2451 2452 2453 2454 2455 2456 2457 |
#f
(lambda (dbdat db)
(sqlite3:first-result
db
"SELECT count(id) FROM tests WHERE state in ('LAUNCHED','NOT_STARTED','REMOTEHOSTSTART','RUNNING','KILLREQ') AND run_id=?;")
run-id)))
;; map run-id, testname item-path to test-id
(define (db:get-test-id dbstruct run-id testname item-path)
| > > > > > > | | | | | | | | | | > > | 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 |
#f
(lambda (dbdat db)
(sqlite3:first-result
db
"SELECT count(id) FROM tests WHERE state in ('LAUNCHED','NOT_STARTED','REMOTEHOSTSTART','RUNNING','KILLREQ') AND run_id=?;")
run-id)))
(define *db:get-test-id-cache* (make-hash-table))
;; map run-id, testname item-path to test-id
(define (db:get-test-id dbstruct run-id testname item-path)
(let* ((hash-key (list run-id testname item-path))
(cache-result (hash-table-ref/default *db:get-test-id-cache* hash-key #f)))
(if cache-result
(cdr cache-result)
(let* ((res (db:with-db
dbstruct
run-id
#f
(lambda (dbdat db)
(db:first-result-default
db
"SELECT id FROM tests WHERE testname=? AND item_path=? AND run_id=?;"
#f ;; the default
testname item-path run-id)))))
(if res (hash-table-set! *db:get-test-id-cache* hash-key (cons (current-seconds) res)))
res))))
;; overload the unused attemptnum field for the process id of the runscript or
;; ezsteps step script in progress
;;
(define (db:test-set-top-process-pid dbstruct run-id test-id pid)
(db:with-db
dbstruct
|
| ︙ | ︙ | |||
2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 |
(let* ((run-ids (db:get-all-run-ids mtdb)))
(for-each
(lambda (run-id)
(let ((testrecs (db:get-all-tests-info-by-run-id mtdb run-id)))
(db:prep-megatest.db-adj-test-ids (dbr:dbdat-dbh mtdb) run-id testrecs)))
run-ids)))
;; Get test data using test_id
;;
(define (db:get-test-info-by-id dbstruct run-id test-id)
| > > > > > > | | | | | | | | | | | | | | | > | | | | | 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 |
(let* ((run-ids (db:get-all-run-ids mtdb)))
(for-each
(lambda (run-id)
(let ((testrecs (db:get-all-tests-info-by-run-id mtdb run-id)))
(db:prep-megatest.db-adj-test-ids (dbr:dbdat-dbh mtdb) run-id testrecs)))
run-ids)))
(define *db:get-test-info-by-id-cache* (make-hash-table))
;; Get test data using test_id
;;
(define (db:get-test-info-by-id dbstruct run-id test-id)
(let* ((hash-key (cons run-id test-id))
(cache-result (hash-table-ref/default *db:get-test-info-by-id-cache* hash-key #f)))
(if cache-result
(cdr cache-result)
(db:with-db
dbstruct
run-id
#f
(lambda (dbdat db)
(let ((res #f))
(sqlite3:for-each-row ;; attemptnum added to hold pid of top process (not Megatest) controlling a test
(lambda (id run-id testname state status event-time host cpuload diskfree uname rundir-id item-path run_duration final-logf-id comment short-dir-id attemptnum archived last-update)
;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
(set! res (vector id run-id testname state status event-time host cpuload diskfree uname rundir-id item-path run_duration final-logf-id comment short-dir-id attemptnum archived last-update)))
db
;; (db:get-cache-stmth dbdat db
;; (conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id=? AND run_id=?;"))
(conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id=? AND run_id=?;")
test-id run-id)
(hash-table-set! *db:get-test-info-by-id-cache* hash-key res)
res))))))
(define *db:get-test-state-status-by-id-cache* (make-hash-table))
;; Get test state, status using test_id
;;
(define (db:get-test-state-status-by-id dbstruct run-id test-id)
(let* ((hash-key (cons run-id test-id))
(cache-result (hash-table-ref/default *db:get-test-state-status-by-id-cache* hash-key #f)))
(if cache-result
(cdr cache-result)
(db:with-db
dbstruct
run-id
#f
(lambda (dbdat db)
(let ((res (cons #f #f)))
;; (stmth (db:get-cache-stmth dbdat db "SELECT state,status FROM tests WHERE id=?;")))
(sqlite3:for-each-row ;; attemptnum added to hold pid of top process (not Megatest) controlling a test
(lambda (state status)
(cons state status))
db
"SELECT state,status FROM tests WHERE id=? AND run_id=?;" ;; stmth try not compiling this one - yes, this fixed the bind issue
test-id run-id)
(hash-table-set! *db:get-test-state-status-by-id-cache* hash-key (cons (current-seconds) res))
res))))))
;; Use db:test-get* to access
;; Get test data using test_ids. NB// Only works within a single run!!
;;
(define (db:get-test-info-by-ids dbstruct run-id test-ids)
(db:with-db
|
| ︙ | ︙ | |||
2669 2670 2671 2672 2673 2674 2675 | (db:keep-trying-until-true proc params (- tries 1))) (begin ;; (debug:print-info 0 *default-log-port* "proc never returned true, params="params) (print"db:keep-trying-until-true proc never returned true, proc = " proc " params =" params " tries = " tries) #f))))) (define (db:get-test-info dbstruct run-id test-name item-path) | > > | | | | | | | 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 |
(db:keep-trying-until-true proc params (- tries 1)))
(begin
;; (debug:print-info 0 *default-log-port* "proc never returned true, params="params)
(print"db:keep-trying-until-true proc never returned true, proc = " proc " params =" params " tries = " tries)
#f)))))
(define (db:get-test-info dbstruct run-id test-name item-path)
(let* ((test-id (db:get-test-id dbstruct run-id test-name item-path)))
(db:get-test-info-by-id dbstruct run-id test-id)))
;; (db:with-db
;; dbstruct
;; run-id
;; #f
;; (lambda (dbdat db)
;; (db:get-test-info-db db run-id test-name item-path))))
(define (db:get-test-info-db db run-id test-name item-path)
(let ((res #f))
(sqlite3:for-each-row
(lambda (a . b)
(set! res (apply vector a b)))
db
|
| ︙ | ︙ |