Overview
Comment: | Have DELETED records removed when a run is completely removed. Added trigger for cleaning cache on getting test info |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | test-specific-db |
Files: | files | file ages | folders |
SHA1: |
44600fe1e60e724ff531123fe6853a5a |
User & Date: | matt on 2012-09-26 22:41:17 |
Other Links: | branch diff | manifest | tags |
Context
2012-09-27
| ||
08:52 | Moved minutes monitoring from megatest.db to testdat.db check-in: 4f517c5576 user: matt tags: test-specific-db | |
2012-09-26
| ||
22:41 | Have DELETED records removed when a run is completely removed. Added trigger for cleaning cache on getting test info check-in: 44600fe1e6 user: matt tags: test-specific-db | |
22:01 | Changed throttle to be a multiple to avoid divide by zero and make bigger equal more throttle. check-in: 71272ebd0c user: matt tags: test-specific-db | |
Changes
Modified db.scm from [ab37435701] to [4816e99b5f].
︙ | ︙ | |||
492 493 494 495 496 497 498 | (let ((finalres (vector header res))) (hash-table-set! *run-info-cache* run-id finalres) finalres)))) (define (db:set-comment-for-run db run-id comment) (sqlite3:execute db "UPDATE runs SET comment=? WHERE id=?;" comment run-id)) | | | 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 | (let ((finalres (vector header res))) (hash-table-set! *run-info-cache* run-id finalres) finalres)))) (define (db:set-comment-for-run db run-id comment) (sqlite3:execute db "UPDATE runs SET comment=? WHERE id=?;" comment run-id)) ;; does not (obviously!) removed dependent data. But why not!!? (define (db:delete-run db run-id) (sqlite3:execute db "DELETE FROM runs WHERE id=?;" run-id)) (define (db:update-run-event_time db run-id) (sqlite3:execute db "UPDATE runs SET event_time=strftime('%s','now') WHERE id=?;" run-id)) (define (db:lock/unlock-run db run-id lock unlock user) |
︙ | ︙ | |||
631 632 633 634 635 636 637 | (if tdb (begin (sqlite3:execute tdb "DELETE FROM test_steps;") (sqlite3:execute tdb "DELETE FROM test_data;") (sqlite3:finalize! tdb))))) ;; | | > > | > > > | | 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 | (if tdb (begin (sqlite3:execute tdb "DELETE FROM test_steps;") (sqlite3:execute tdb "DELETE FROM test_data;") (sqlite3:finalize! tdb))))) ;; (define (db:delete-test-records db tdb test-id #!key (force #f)) (if tdb (begin (sqlite3:execute tdb "DELETE FROM test_steps;") (sqlite3:execute tdb "DELETE FROM test_data;"))) ;; (sqlite3:execute db "DELETE FROM tests WHERE id=?;" test-id)) (if db (begin (sqlite3:execute db "DELETE FROM test_steps WHERE test_id=?;" test-id) (sqlite3:execute db "DELETE FROM test_data WHERE test_id=?;" test-id) (if force (sqlite3:execute db "DELETE FROM tests WHERE id=?;" test-id) (sqlite3:execute db "UPDATE tests SET state='DELETED',status='n/a' WHERE id=?;" test-id))))) (define (db:delete-tests-for-run db run-id) (sqlite3:execute db "DELETE FROM tests WHERE run_id=?;" run-id)) (define (db:delete-old-deleted-test-records db) (let ((targtime (- (current-seconds)(* 30 24 60 60)))) ;; one month in the past (sqlite3:execute db "DELETE FROM tests WHERE state='DELETED' AND event_time<?;" targtime))) ;; set tests with state currstate and status currstatus to newstate and newstatus ;; use currstate = #f and or currstatus = #f to apply to any state or status respectively ;; WARNING: SQL injection risk (define (db:set-tests-state-status db run-id testnames currstate currstatus newstate newstatus) (for-each (lambda (testname) (let ((qry (conc "UPDATE tests SET state=?,status=? WHERE " |
︙ | ︙ | |||
775 776 777 778 779 780 781 782 783 784 785 786 787 | ;; if the test db is not found what to do? ;; 1. set state to DELETED ;; 2. set status to n/a (begin (db:test-set-state! res "NOT_STARTED") (db:test-set-status! res "n/a"))))) ;; Get test data using test_id (define (db:get-test-info-cached-by-id db test-id) (if (not test-id) (begin (debug:print 4 "INFO: db:get-test-info-by-id called with test-id=" test-id) #f) | > > > > > > > > > > > | | 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 | ;; if the test db is not found what to do? ;; 1. set state to DELETED ;; 2. set status to n/a (begin (db:test-set-state! res "NOT_STARTED") (db:test-set-status! res "n/a"))))) (define *last-test-cache-delete* (current-seconds)) ;; Get test data using test_id (define (db:get-test-info-cached-by-id db test-id) ;; is all this crap really worth it? I somehow doubt it. (let* ((last-delete-str (db:get-var db "DELETED_TESTS")) (last-delete (if (string? last-delete-str)(string->number last-delete-str) #f))) (if (and last-delete (> last-delete *last-test-cache-delete*)) (begin (set! *test-info* (make-hash-table)) (set! *test-id-cache* (make-hash-table)) (set! *last-test-cache-delete* last-delete) (debug:print 4 "INFO: Clearing test data cache")))) (if (not test-id) (begin (debug:print 4 "INFO: db:get-test-info-by-id called with test-id=" test-id) #f) (let* ((res (hash-table-ref/default *test-info* test-id #f))) (if res (db:patch-tdb-data-into-test-info db test-id res) ;; if no cached value then full read and write to cache (begin (sqlite3:for-each-row (lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment) ;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 |
︙ | ︙ |
Modified runs.scm from [f76c63e812] to [ac403afd49].
︙ | ︙ | |||
724 725 726 727 728 729 730 | ((set-state-status) (debug:print 2 "INFO: new state " (car state-status) ", new status " (cadr state-status)) (open-run-close db:test-set-state-status-by-id db (db:test-get-id test) (car state-status)(cadr state-status) #f))))) tests))) ;; remove the run if zero tests remain (if (eq? action 'remove-runs) | | | > > | 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 | ((set-state-status) (debug:print 2 "INFO: new state " (car state-status) ", new status " (cadr state-status)) (open-run-close db:test-set-state-status-by-id db (db:test-get-id test) (car state-status)(cadr state-status) #f))))) tests))) ;; remove the run if zero tests remain (if (eq? action 'remove-runs) (let ((remtests (db:get-tests-for-run db (db:get-value-by-header run header "id") #f #f '("DELETED") '("n/a") not-in: #t))) (if (null? remtests) ;; no more tests remaining (let* ((dparts (string-split lasttpath "/")) (runpath (conc "/" (string-intersperse (take dparts (- (length dparts) 1)) "/")))) (debug:print 1 "Removing run: " runkey " " (db:get-value-by-header run header "runname") " and related record") (db:delete-run db run-id) ;; This is a pretty good place to purge old DELETED tests (db:delete-tests-for-run db run-id) (db:delete-old-deleted-test-records db) (db:set-var db "DELETED_TESTS" (current-seconds)) ;; need to figure out the path to the run dir and remove it if empty ;; (if (null? (glob (conc runpath "/*"))) ;; (begin ;; (debug:print 1 "Removing run dir " runpath) ;; (system (conc "rmdir -p " runpath)))) ))))) )) |
︙ | ︙ |