Megatest

Check-in [79d2c0eca7]
Login
Overview
Comment:Increase threshold to 1 sec before running sync as separate process. Every hour do a full sync to ensure no data gets dropped. Added simple usage logger
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.64
Files: files | file ages | folders
SHA1: 79d2c0eca73a807c76ba9502dd2d61d354f07cd3
User & Date: matt on 2017-07-13 23:14:34
Other Links: branch diff | manifest | tags
Context
2017-07-14
10:19
Added mechanism for tracking calls to megatest. Fixed undefined variable. Backoff sync rate when system load is high. Run external sync only if internal sync is taking more than 4 seconds. check-in: 5852022e7d user: mrwellan tags: v1.64, v1.6425
2017-07-13
23:14
Increase threshold to 1 sec before running sync as separate process. Every hour do a full sync to ensure no data gets dropped. Added simple usage logger check-in: 79d2c0eca7 user: matt tags: v1.64
07:38
Disabled run/remove lock using no-sync. It slows down things way too much and it seems the locking didn't help anything check-in: 15a030a849 user: matt tags: v1.64, v1.6425
Changes

Modified db.scm from [7264118fc3] to [5cc0abc545].

1046
1047
1048
1049
1050
1051
1052



1053
1054




1055


1056
1057
1058
1059

1060
1061


1062
1063
1064
1065
1066
1067
1068
1069
	 (tmpdb       (db:get-db dbstruct))
	 (refndb      (dbr:dbstruct-refndb dbstruct)))
    (db:sync-tables (db:sync-all-tables-list dbstruct) last-update tmpdb refndb mtdb)))

;;;; run-ids
;;    if #f use *db-local-sync* : or 'local-sync-flags
;;    if #t use timestamps      : or 'timestamps



(define (db:sync-to-megatest.db dbstruct #!key (no-sync-db #f)) 
  (let* ((start-time         (current-seconds))




	 (last-update        (if no-sync-db


				 (db:no-sync-get/default no-sync-db "LAST_UPDATE" 0)
				 0)) ;; (or (db:get-var dbstruct "LAST_UPDATE") 0))
	 (sync-needed        (> (- start-time last-update) 6))
	 (res                (if sync-needed ;; don't sync if a sync already occurred in the past 6 seconds

				 (begin
				   (if no-sync-db


				       (db:no-sync-set no-sync-db "LAST_UPDATE" start-time))
				   (db:tmp->megatest.db-sync dbstruct last-update))
				 0))
	 (sync-time           (- (current-seconds) start-time)))
      (debug:print-info 3 *default-log-port* "Sync of newdb to olddb completed in " sync-time " seconds pid="(current-process-id))
      (if (common:low-noise-print 30 "sync new to old")
          (if sync-needed
              (debug:print-info 0 *default-log-port* "Sync of " res " records from newdb to olddb completed in " sync-time " seconds pid="(current-process-id))







>
>
>


>
>
>
>
|
>
>
|
|

|
>


>
>
|







1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
	 (tmpdb       (db:get-db dbstruct))
	 (refndb      (dbr:dbstruct-refndb dbstruct)))
    (db:sync-tables (db:sync-all-tables-list dbstruct) last-update tmpdb refndb mtdb)))

;;;; run-ids
;;    if #f use *db-local-sync* : or 'local-sync-flags
;;    if #t use timestamps      : or 'timestamps
;;
;;  NB// no-sync-db is the db handle, not a flag!
;;
(define (db:sync-to-megatest.db dbstruct #!key (no-sync-db #f)) 
  (let* ((start-time         (current-seconds))
	 (last-full-update   (if no-sync-db
				 (db:no-sync-get/default no-sync-db "LAST_FULL_UPDATE" 0)
				 0))
	 (full-sync-needed   (> (- start-time last-full-update) 3600)) ;; every hour do a full sync
	 (last-update        (if full-sync-needed
				 0
				 (if no-sync-db
				     (db:no-sync-get/default no-sync-db "LAST_UPDATE" 0)
				     0))) ;; (or (db:get-var dbstruct "LAST_UPDATE") 0))
	 (sync-needed        (> (- start-time last-update) 6))
	 (res                (if (or sync-needed ;; don't sync if a sync already occurred in the past 6 seconds
				     full-sync-needed)
				 (begin
				   (if no-sync-db
				       (begin
					 (if full-sync-needed (db:no-sync-set no-sync-db "LAST_FULL_UPDATE" start-time))
					 (db:no-sync-set no-sync-db "LAST_UPDATE" start-time)))
				   (db:tmp->megatest.db-sync dbstruct last-update))
				 0))
	 (sync-time           (- (current-seconds) start-time)))
      (debug:print-info 3 *default-log-port* "Sync of newdb to olddb completed in " sync-time " seconds pid="(current-process-id))
      (if (common:low-noise-print 30 "sync new to old")
          (if sync-needed
              (debug:print-info 0 *default-log-port* "Sync of " res " records from newdb to olddb completed in " sync-time " seconds pid="(current-process-id))

Modified megatest.scm from [9ee9132d3c] to [fcd98f357f].

51
52
53
54
55
56
57




58
59
60















61
62
63
64
65
66
67

(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "megatest-fossil-hash.scm")





(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.megatestrc")))
  (if (common:file-exists? debugcontrolf)
      (load debugcontrolf)))
















;; Disabled help items
;;  -rollup                 : (currently disabled) fill run (set by :runname)  with latest test(s)
;;                            from prior runs with same keys
;;  -daemonize              : fork into background and disconnect from stdin/out

(define help (conc "







>
>
>
>



>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86

(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "megatest-fossil-hash.scm")

(define *usage-log-file* #f) ;; put path to file for logging usage in this var in the ~/.megatestrc file

;; load the ~/.megatestrc file, put (use trace)(trace-call-sites #t)(trace function-you-want-to-trace) in this file
;;
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.megatestrc")))
  (if (common:file-exists? debugcontrolf)
      (load debugcontrolf)))

;; usage logging, careful with this, it is not designed to deal with all real world challenges!
;;
(if (and (common:file-exists? *usage-log-file*)
	   (file-write-access? *usage-log-file*))
      (with-output-to-file
	  *usage-log-file*
	(lambda ()
	  (print
	   (time->string
	    (seconds->local-time (current-seconds))
	    "%Yww%V.%w %H:%M:%S") " "
	    (current-directory) " "
	    "\"" (string-intersperse (argv) " ") "\""))
	#:append))

;; Disabled help items
;;  -rollup                 : (currently disabled) fill run (set by :runname)  with latest test(s)
;;                            from prior runs with same keys
;;  -daemonize              : fork into background and disconnect from stdin/out

(define help (conc "

Modified server.scm from [cd5b86d727] to [ee8415115d].

500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
	      ;; (if recently-synced (debug:print-info 0 *default-log-port* "Skipping sync due to recently-synced flag=" recently-synced))
	      ;; (debug:print-info 0 *default-log-port* "need-sync: " need-sync " sync-in-progress: " sync-in-progress " should-sync: " should-sync " will-sync: " will-sync)
	      (if will-sync (set! *db-sync-in-progress* #t))
	      (mutex-unlock! *db-multi-sync-mutex*)
	      (if will-sync
                  (let ((sync-start (current-milliseconds)))
		    (with-output-to-file start-file (lambda ()(print (current-process-id))))

		    ;; put lock here
		    
                    (if (< sync-duration 300)
                        (let ((res        (db:sync-to-megatest.db dbstruct no-sync-db: no-sync-db))) ;; did we sync any data? If so need to set the db touched flag to keep the server alive
                          (set! sync-duration (- (current-milliseconds) sync-start))
                          (if (> res 0) ;; some records were transferred, keep the db alive
                              (begin
                                (mutex-lock! *heartbeat-mutex*)
                                (set! *db-last-access* (current-seconds))
                                (mutex-unlock! *heartbeat-mutex*)







|


|







500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
	      ;; (if recently-synced (debug:print-info 0 *default-log-port* "Skipping sync due to recently-synced flag=" recently-synced))
	      ;; (debug:print-info 0 *default-log-port* "need-sync: " need-sync " sync-in-progress: " sync-in-progress " should-sync: " should-sync " will-sync: " will-sync)
	      (if will-sync (set! *db-sync-in-progress* #t))
	      (mutex-unlock! *db-multi-sync-mutex*)
	      (if will-sync
                  (let ((sync-start (current-milliseconds)))
		    (with-output-to-file start-file (lambda ()(print (current-process-id))))
		    
		    ;; put lock here
		    
                    (if (< sync-duration 1000) ;; NOTE: db:sync-to-megatest.db keeps track of time of last sync and syncs incrementally
                        (let ((res        (db:sync-to-megatest.db dbstruct no-sync-db: no-sync-db))) ;; did we sync any data? If so need to set the db touched flag to keep the server alive
                          (set! sync-duration (- (current-milliseconds) sync-start))
                          (if (> res 0) ;; some records were transferred, keep the db alive
                              (begin
                                (mutex-lock! *heartbeat-mutex*)
                                (set! *db-last-access* (current-seconds))
                                (mutex-unlock! *heartbeat-mutex*)