Megatest

Check-in [3c92aeb733]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Added backoff mechanism to newdashboard for when db is overloaded
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | newdashboard
Files: files | file ages | folders
SHA1: 3c92aeb7336eec8a383929326b7daa390ea4c081
User & Date: matt on 2013-03-19 00:27:18
Other Links: branch diff | manifest | tags
Context
2013-03-19
00:40
Set test state/status correctly in cells check-in: 071ef5c14d user: matt tags: newdashboard
00:27
Added backoff mechanism to newdashboard for when db is overloaded check-in: 3c92aeb733 user: matt tags: newdashboard
2013-03-17
12:27
Added display of test/items and added blanket redraw check-in: f88f218773 user: matt tags: newdashboard
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified newdashboard.scm from [4dd7f06139] to [ef74c32f12].

︙
478
479
480
481
482
483
484
485


486
487
488
489




490
491





492
493
494

478
479
480
481
482
483
484

485
486
487
488
489
490
491
492
493
494


495
496
497
498
499
500
501
502








-
+
+




+
+
+
+
-
-
+
+
+
+
+




(define (newdashboard)
  (let* ((data     (make-hash-table))
	 (keys     (cdb:remote-run db:get-keys #f))
	 (runname  "%")
	 (testpatt "%")
	 (keypatts (map (lambda (k)(list (vector-ref k 0) "%")) keys))
	 (states   '())
	 (statuses '()))
	 (statuses '())
	 (nextmintime (current-milliseconds)))
    (iup:show (main-panel))
    (iup:callback-set! *tim*
		       "ACTION_CB"
		       (lambda (x)
			 ;; Want to dedicate no more than 50% of the time to this so skip if
			 ;; 2x delta time has not passed since last query
			 (if (< nextmintime (current-milliseconds))
			     (let* ((starttime (current-milliseconds))
			 (let ((changes (run-update keys data runname keypatts testpatt states statuses 'full)))
			   (debug:print 0 "CHANGE(S): " (car changes) "..."))))))
				    (changes   (run-update keys data runname keypatts testpatt states statuses 'full))
				    (endtime   (current-milliseconds)))
			       (set! nextmintime (+ endtime (* 2 (- endtime starttime))))
			       (debug:print 11 "CHANGE(S): " (car changes) "..."))
			     (debug:print-info 11 "Server overloaded"))))))

(newdashboard)    
(iup:main-loop)

Modified synchash.scm from [4f4ef7e335] to [3bf68b1569].

︙
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98






99
100
101
102
103
104
105

81
82
83
84
85
86
87

88
89
90
91






92
93
94
95
96
97
98
99
100
101
102
103
104








-




-
-
-
-
-
-
+
+
+
+
+
+








     newdat)
    (for-each
     (lambda (id)
       (hash-table-delete! myhash id))
     removs)
    (list newdat removs))) ;; synchash))


(define *synchashes* (make-hash-table))

(define (synchash:server-get db proc synckey keynum . params)
  ;; (debug:print-info 2 "synckey: " synckey ", keynum: " keynum ", params: " params)
  (let* ((synchash (hash-table-ref/default *synchashes* synckey #f))
	 (newdat   (apply (case proc
			    ((db:get-runs) db:get-runs)
			    ((db:get-tests-for-runs) db:get-tests-for-runs)
			    (else print))
			  db params))
  (let* ((synchash  (hash-table-ref/default *synchashes* synckey #f))
	 (newdat    (apply (case proc
			     ((db:get-runs) db:get-runs)
			     ((db:get-tests-for-runs) db:get-tests-for-runs)
			     (else print))
			   db params))
	 (postdat  #f)
	 (make-indexed (lambda (x)
			 (list (vector-ref x keynum) x))))
    ;; Now process newdat based on the query type
    (set! postdat (case proc
		    ((db:get-runs)
		     ;; (debug:print-info 2 "Get runs call")
︙

This page was generated in about 0.113s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00