Overview
| Comment: | Require always the db-cleanup on version change, split cleanup-db into two phases, first migrate schema then check dbs. Check db is forked into background |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.62 |
| Files: | files | file ages | folders |
| SHA1: |
b14a3e05be401559148e290702203f18 |
| User & Date: | mrwellan on 2016-10-13 14:58:29 |
| Other Links: | branch diff | manifest | tags |
Context
|
2016-10-14
| ||
| 08:40 | Merged db branch from node e2c9 into v1.62 check-in: 0a5c3b4b3b user: mrwellan tags: v1.62 | |
|
2016-10-13
| ||
| 15:43 | Removed comments Closed-Leaf check-in: 228f6a3556 user: ritikaag tags: db | |
| 14:58 | Require always the db-cleanup on version change, split cleanup-db into two phases, first migrate schema then check dbs. Check db is forked into background check-in: b14a3e05be user: mrwellan tags: v1.62 | |
| 11:28 | Fixed extraneous calls to tree updater check-in: 7d1432b447 user: mrwellan tags: v1.62 | |
Changes
Modified dashboard.scm from [37c4897977] to [d35694a8bc].
| ︙ | ︙ | |||
3347 3348 3349 3350 3351 3352 3353 |
;;======================================================================
(define (main)
(let ((mtdb-path (conc *toppath* "/megatest.db"))) ;;
(if (and (file-exists? mtdb-path)
(file-write-access? mtdb-path))
(if (not (args:get-arg "-skip-version-check"))
| > | | | | | | 3347 3348 3349 3350 3351 3352 3353 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 |
;;======================================================================
(define (main)
(let ((mtdb-path (conc *toppath* "/megatest.db"))) ;;
(if (and (file-exists? mtdb-path)
(file-write-access? mtdb-path))
(if (not (args:get-arg "-skip-version-check"))
(common:exit-on-version-changed)))
;; (let ((th1 (make-thread common:exit-on-version-changed)))
;; (thread-start! th1)
;; (if (> megatest-version (common:get-last-run-version-number))
;; (debug:print-info 0 *default-log-port* "Version bump detected, blocking until db sync complete")
;; (thread-join! th1)))))
(let* ((commondat (dboard:commondat-make)))
;; Move this stuff to db.scm? I'm not sure that is the right thing to do...
(cond
((args:get-arg "-test") ;; run-id,test-id
(let* ((dat (let ((d (map string->number (string-split (args:get-arg "-test") ","))))
(if (> (length d) 1)
d
|
| ︙ | ︙ |
Modified db.scm from [84abbe1c4a] to [67b7a55241].
| ︙ | ︙ | |||
716 717 718 719 720 721 722 723 724 725 726 727 728 729 |
(set! tot-count (+ tot-count count))
(if (> count 0)
(if should-print (debug:print 0 *default-log-port* (format #f " ~10a ~5a" tblname count))))))
(sort (hash-table->alist numrecs)(lambda (a b)(> (cdr a)(cdr b))))))
tot-count)))
(mutex-unlock! *db-sync-mutex*)))
;; options:
;;
;; 'killservers - kills all servers
;; 'dejunk - removes junk records
;; 'adj-testids - move test-ids into correct ranges
;; 'old2new - sync megatest.db records to .db/{main,1,2 ...}.db
;; 'new2old - sync .db/{main,1,2,3 ...}.db to megatest.db
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 716 717 718 719 720 721 722 723 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 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 |
(set! tot-count (+ tot-count count))
(if (> count 0)
(if should-print (debug:print 0 *default-log-port* (format #f " ~10a ~5a" tblname count))))))
(sort (hash-table->alist numrecs)(lambda (a b)(> (cdr a)(cdr b))))))
tot-count)))
(mutex-unlock! *db-sync-mutex*)))
(define (db:patch-schema-rundb run-id frundb)
;;
;; remove this some time after September 2016 (added in version v1.6031
;;
(for-each
(lambda (table-name)
(handle-exceptions
exn
(if (string-match ".*duplicate.*" ((condition-property-accessor 'exn 'message) exn))
(debug:print 0 *default-log-port* "Column last_update already added to " table-name " table")
(db:general-sqlite-error-dump exn "alter table " table-name " ..." #f "none"))
(sqlite3:execute
frundb
(conc "ALTER TABLE " table-name " ADD COLUMN last_update INTEGER DEFAULT 0")))
(sqlite3:execute
frundb
(conc "DROP TRIGGER IF EXISTS update_" table-name "_trigger;"))
(sqlite3:execute
frundb
(conc "CREATE TRIGGER IF NOT EXISTS update_" table-name "_trigger AFTER UPDATE ON " table-name "
FOR EACH ROW
BEGIN
UPDATE " table-name " SET last_update=(strftime('%s','now'))
WHERE id=old.id;
END;"))
)
'("tests" "test_steps" "test_data")))
(define (db:patch-schema-maindb run-id maindb)
;;
;; remove all these some time after september 2016 (added in v1.6031
;;
(handle-exceptions
exn
(if (string-match ".*duplicate.*" ((condition-property-accessor 'exn 'message) exn))
(debug:print 0 *default-log-port* "Column last_update already added to runs table")
(db:general-sqlite-error-dump exn "alter table runs ..." run-id "none"))
(sqlite3:execute
maindb
"ALTER TABLE runs ADD COLUMN last_update INTEGER DEFAULT 0"))
;; these schema changes don't need exception handling
(sqlite3:execute
maindb
"CREATE TRIGGER IF NOT EXISTS update_runs_trigger AFTER UPDATE ON runs
FOR EACH ROW
BEGIN
UPDATE runs SET last_update=(strftime('%s','now'))
WHERE id=old.id;
END;")
(sqlite3:execute maindb "CREATE TABLE IF NOT EXISTS run_stats (
id INTEGER PRIMARY KEY,
run_id INTEGER,
state TEXT,
status TEXT,
count INTEGER,
last_update INTEGER DEFAULT (strftime('%s','now')))")
(sqlite3:execute maindb "CREATE TRIGGER IF NOT EXISTS update_run_stats_trigger AFTER UPDATE ON run_stats
FOR EACH ROW
BEGIN
UPDATE run_stats SET last_update=(strftime('%s','now'))
WHERE id=old.id;
END;"))
;; options:
;;
;; 'killservers - kills all servers
;; 'dejunk - removes junk records
;; 'adj-testids - move test-ids into correct ranges
;; 'old2new - sync megatest.db records to .db/{main,1,2 ...}.db
;; 'new2old - sync .db/{main,1,2,3 ...}.db to megatest.db
|
| ︙ | ︙ | |||
787 788 789 790 791 792 793 |
(if (member 'new2old options)
(let* ((maindb (make-dbr:dbstruct path: toppath local: #t))
(src-run-ids (if run-ids run-ids (db:get-all-run-ids (db:dbdat-get-db (db:get-db maindb 0)))))
(all-run-ids (sort (delete-duplicates (cons 0 src-run-ids)) <))
(count 1)
(total (length all-run-ids))
(dead-runs '()))
| > | > > > | < > > | | | < < < | | < | < | < < < < < < > | | < | < < | > > | < < < < < < < < < < < < | | < < > > | > > > > | < < > > > | | | | < < < < < | < < < < | < < | < < < | < | < < < < < < | < < | | 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 |
(if (member 'new2old options)
(let* ((maindb (make-dbr:dbstruct path: toppath local: #t))
(src-run-ids (if run-ids run-ids (db:get-all-run-ids (db:dbdat-get-db (db:get-db maindb 0)))))
(all-run-ids (sort (delete-duplicates (cons 0 src-run-ids)) <))
(count 1)
(total (length all-run-ids))
(dead-runs '()))
;; first fix schema if needed
(map
(lambda (th)
(thread-join! th))
(map
(lambda (run-id)
(thread-start!
(make-thread
(lambda ()
(let* ((fromdb (if toppath (make-dbr:dbstruct path: toppath local: #t) #f))
(frundb (db:dbdat-get-db (db:get-db fromdb run-id))))
(if (eq? run-id 0)
(let ((maindb (db:dbdat-get-db (db:get-db fromdb #f))))
(db:patch-schema-maindb run-id maindb))
(db:patch-schema-rundb run-id frundb)))
(set! count (+ count 1))
(debug:print 0 *default-log-port* "Finished patching schema for " (if (eq? run-id 0) " main.db " (conc run-id ".db")) ", " count " of " total)))))
all-run-ids))
;; Then sync and fix db's
(set! count 0)
(process-fork
(lambda ()
(map
(lambda (th)
(thread-join! th))
(map
(lambda (run-id)
(thread-start!
(make-thread
(lambda ()
(let* ((fromdb (if toppath (make-dbr:dbstruct path: toppath local: #t) #f))
(frundb (db:dbdat-get-db (db:get-db fromdb run-id))))
(if (eq? run-id 0)
(let ((maindb (db:dbdat-get-db (db:get-db fromdb #f))))
(db:sync-tables (db:sync-main-list dbstruct) (db:get-db fromdb #f) mtdb)
(set! dead-runs (db:clean-up-maindb (db:get-db fromdb #f))))
(begin
;; NB// must sync first to ensure deleted tests get marked as such in megatest.db
(db:sync-tables db:sync-tests-only (db:get-db fromdb run-id) mtdb)
(db:clean-up-rundb (db:get-db fromdb run-id)))))
(set! count (+ count 1))
(debug:print 0 *default-log-port* "Finished clean up of "
(if (eq? run-id 0)
" main.db " (conc run-id ".db")) ", " count " of " total)))))
all-run-ids))))
;; removed deleted runs
(let ((dbdir (tasks:get-task-db-path)))
(for-each (lambda (run-id)
(let ((fullname (conc dbdir "/" run-id ".db")))
(if (file-exists? fullname)
(begin
(debug:print 0 *default-log-port* "Removing database file for deleted run " fullname)
(delete-file fullname)))))
|
| ︙ | ︙ |