Megatest

Check-in [b14a3e05be]
Login
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: b14a3e05be401559148e290702203f18168b99a9
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

3354
3355
3356
3357
3358





3359
3360
3361
3362
3363
3364
3365
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 ((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
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

794
795





796
797
798
799





800
801
802
803
804


805
806

807
808

809
810
811
812
813
814
815
816



817
818

819
820
821
822




823
824
825
826
827
828
829
830
831
832
833
834
835
836


837
838
839
840








841
842
843
844
845
846







847
848
849
850
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
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
	  (for-each
	   (lambda (run-id)
          (map
           (lambda (th)
             (thread-join! th))
           (map
            (lambda (run-id)
	     (debug:print 0 *default-log-port* "Processing run " (if (eq? run-id 0) " main.db " run-id) ", " count " of " total)
	     (set! count (+ count 1))
	     (let* ((fromdb (if toppath (make-dbr:dbstruct path: toppath local: #t) #f))
		    (frundb (db:dbdat-get-db (db:get-db fromdb 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))))
	       ;; (db:delay-if-busy frundb)
	       ;; (db:delay-if-busy mtdb)
	       ;; (db:clean-up frundb)
	       (if (eq? run-id 0)
		   (let ((maindb  (db:dbdat-get-db (db:get-db fromdb #f))))
                    (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)))
                          (db:patch-schema-maindb run-id maindb))
		     ;; 
		     ;; Feb 18, 2016: add field last_update to runs table
                        (db:patch-schema-rundb run-id frundb)))
		     ;;
		     ;; 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"))
                  (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))
		      (sqlite3:execute
		       maindb
          ;; Then sync and fix db's
		       "ALTER TABLE runs ADD COLUMN last_update INTEGER DEFAULT 0"))
		     ;; these schema changes don't need exception handling
		     (sqlite3:execute
		      maindb
          (set! count 0)
          (process-fork
           (lambda ()
             (map
		      "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
              (lambda (th)
                (thread-join! th))
                             FOR EACH ROW
                               BEGIN 
                                 UPDATE run_stats SET last_update=(strftime('%s','now'))
                                   WHERE id=old.id;
              (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)
                               END;")
		     )
		   (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))
                           (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)))))
		     ;;
		     ;; Feb 18, 2016: add field last_update to tests, test_steps and test_data
		     ;;
		     ;; remove this some time after September 2016 (added in version v1.6031
		     ;;
		     (for-each
                     (set! count (+ count 1))
		      (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")
                     (debug:print 0 *default-log-port* "Finished clean up of "
			     (db:general-sqlite-error-dump exn "alter table " table-name " ..." #f "none"))
			 (sqlite3:execute
			  frundb
                                  (if (eq? run-id 0)
			  (conc "ALTER TABLE " table-name " ADD COLUMN last_update INTEGER DEFAULT 0")))
			(sqlite3:execute
			 frundb
			 (conc "DROP TRIGGER IF EXISTS update_" table-name "_trigger;"))
                                      " main.db " (conc run-id ".db")) ", " count " of " total)))))
			(sqlite3:execute
			 frundb
               all-run-ids))))
			 (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"))))))
	   all-run-ids)
	  ;; removed deleted runs
          ;; 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)))))