Overview
Comment: | Fixed runs cleanup where not constrained by run_id. Added missing mutex-unlock before recursively calling homehost. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.62-no-rpc |
Files: | files | file ages | folders |
SHA1: |
8956d8d87378f1e5fed7b4d5e8f8e803 |
User & Date: | matt on 2016-11-27 13:08:04 |
Other Links: | branch diff | manifest | tags |
Context
2016-11-27
| ||
19:16 | misnamed table in query, steps => test_steps check-in: 2edc3f05a8 user: matt tags: v1.62-no-rpc | |
13:08 | Fixed runs cleanup where not constrained by run_id. Added missing mutex-unlock before recursively calling homehost. check-in: 8956d8d873 user: matt tags: v1.62-no-rpc | |
11:58 | Run launch:setup in launch:execute - needed now due to refactoring. check-in: b19499a3eb user: matt tags: v1.62-no-rpc | |
Changes
Modified common.scm from [046ea6668a] to [ba4cec2667].
︙ | ︙ | |||
836 837 838 839 840 841 842 | (if (file-exists? hhf) (with-input-from-file hhf read-line) (if (file-write-access? *toppath*) (begin (with-output-to-file hhf (lambda () (print bestadrs))) | > > | | 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 | (if (file-exists? hhf) (with-input-from-file hhf read-line) (if (file-write-access? *toppath*) (begin (with-output-to-file hhf (lambda () (print bestadrs))) (begin (mutex-unlock! *homehost-mutex*) (car (common:get-homehost)))) #f))))) (at-home (or (equal? homehost currhost) (equal? homehost bestadrs)))) (set! *home-host* (cons homehost at-home)) (mutex-unlock! *homehost-mutex*) *home-host*)))) |
︙ | ︙ |
Modified db.scm from [778d4cf187] to [08f18b2262].
︙ | ︙ | |||
277 278 279 280 281 282 283 | ;; ;; called in http-transport and replicated in rmt.scm for *local* access. ;; (define (db:setup #!key (areapath #f)) (or *dbstruct-db* (if (common:on-homehost?) (let* ((dbstruct (make-dbr:dbstruct))) | | | | 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 | ;; ;; called in http-transport and replicated in rmt.scm for *local* access. ;; (define (db:setup #!key (areapath #f)) (or *dbstruct-db* (if (common:on-homehost?) (let* ((dbstruct (make-dbr:dbstruct))) (db:open-db dbstruct areapath: areapath) (set! *dbstruct-db* dbstruct) dbstruct) (begin (debug:print 0 *default-log-port* "ERROR: attempt to open database when not on homehost. Exiting. Homehost: " (common:get-homehost)) (exit 1))))) ;; Open the classic megatest.db file (defaults to open in toppath) ;; ;; NOTE: returns a dbdat not a dbstruct! ;; (define (db:open-megatest-db #!key (path #f)(name #f)) |
︙ | ︙ | |||
2118 2119 2120 2121 2122 2123 2124 | (define (db:delete-run dbstruct run-id) ;; First set any related tests to DELETED (let* ((rdbdat (db:get-db dbstruct run-id)) (rdb (db:dbdat-get-db rdbdat)) (dbdat (db:get-db dbstruct #f)) (db (db:dbdat-get-db dbdat))) ;; (db:delay-if-busy rdbdat) | | > > | | > | | | 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 | (define (db:delete-run dbstruct run-id) ;; First set any related tests to DELETED (let* ((rdbdat (db:get-db dbstruct run-id)) (rdb (db:dbdat-get-db rdbdat)) (dbdat (db:get-db dbstruct #f)) (db (db:dbdat-get-db dbdat))) ;; (db:delay-if-busy rdbdat) (sqlite3:with-transaction db (lambda () (sqlite3:execute rdb "DELETE FROM test_steps WHERE test_id IN (SELECT id FROM tests WHERE run_id=?);" run-id) (sqlite3:execute rdb "DELETE FROM test_data WHERE test_id IN (SELECT id FROM tests WHERE run_id=?);" run-id) (sqlite3:execute rdb "UPDATE tests SET state='DELETED',comment='' WHERE run_id=?;" run-id) ;; (db:delay-if-busy dbdat) (sqlite3:execute db "UPDATE runs SET state='deleted',comment='' WHERE id=?;" run-id))))) (define (db:update-run-event_time dbstruct run-id) (db:with-db dbstruct #f #t (lambda (db) |
︙ | ︙ | |||
2412 2413 2414 2415 2416 2417 2418 | (db:general-call dbdat 'delete-test-step-records (list test-id)) ;; (db:delay-if-busy) (db:general-call dbdat 'delete-test-data-records (list test-id)) (sqlite3:execute db "UPDATE tests SET state='DELETED',status='n/a',comment='' WHERE id=?;" test-id))) ;; (define (db:delete-old-deleted-test-records dbstruct) | | < < | | < > | | > > > > > | < | 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 2435 2436 2437 2438 2439 2440 2441 | (db:general-call dbdat 'delete-test-step-records (list test-id)) ;; (db:delay-if-busy) (db:general-call dbdat 'delete-test-data-records (list test-id)) (sqlite3:execute db "UPDATE tests SET state='DELETED',status='n/a',comment='' WHERE id=?;" test-id))) ;; (define (db:delete-old-deleted-test-records dbstruct) (let (;; (run-ids (db:get-all-run-ids dbstruct)) (targtime (- (current-seconds)(* 30 24 60 60)))) ;; one month in the past (db:with-db dbstruct 0 #t (lambda (db) (sqlite3:with-transaction db (lambda () (sqlite3:execute db "DELETE FROM steps WHERE test_id IN (SELECT id FROM tests WHERE state='DELETED' AND event_time<?);" targtime) (sqlite3:execute db "DELETE FROM test_data WHERE test_id IN (SELECT id FROM tests WHERE state='DELETED' AND event_time<?);" targtime) (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. NB// See new but not yet used "faster" version below ;; ;; AND NOT (item_path='' AND testname in (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));"))) ;; (debug:print 0 *default-log-port* "QRY: " qry) |
︙ | ︙ |
Modified runs.scm from [66becad1c7] to [ebf1e29df4].
︙ | ︙ | |||
1667 1668 1669 1670 1671 1672 1673 | (lasttpath "/does/not/exist/I/hope") (worker-thread #f)) (debug:print-info 4 *default-log-port* "runs:operate-on run=" run ", header=" header) (if (not (null? tests)) (begin (case action ((remove-runs) | | | 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 | (lasttpath "/does/not/exist/I/hope") (worker-thread #f)) (debug:print-info 4 *default-log-port* "runs:operate-on run=" run ", header=" header) (if (not (null? tests)) (begin (case action ((remove-runs) ;; (if (tasks:need-server run-id)(tasks:start-and-wait-for-server tdbdat run-id 10)) ;; seek and kill in flight -runtests with % as testpatt here ;; (if (equal? testpatt "%") (tasks:kill-runner target run-name testpatt) ;; (debug:print 0 *default-log-port* "not attempting to kill any run launcher processes as testpatt is " testpatt)) (debug:print 1 *default-log-port* "Removing tests for run: " runkey " " (db:get-value-by-header run header "runname"))) ((set-state-status) (if (tasks:need-server run-id)(tasks:start-and-wait-for-server tdbdat run-id 10)) |
︙ | ︙ |