Megatest

Diff
Login

Differences From Artifact [6008614567]:

To Artifact [a8f8013949]:


86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
	(let ((res             (http-transport:client-api-send-receive run-id connection-info cmd jparams)))
	  (http-transport:server-dat-update-last-access connection-info)
	  (if res
	      (db:string->obj res)
	      (let ((new-connection-info (client:setup run-id)))
		(debug:print 0 "WARNING: Communication failed, trying call to http-transport:client-api-send-receive again.")
		(rmt:send-receive cmd run-id params))))
	(let ((max-avg-qry (string->number (or (configf:lookup *configdat* "server" "server-query-threshold") "800"))))
	  (debug:print-info 4 "no server and read-only query, bypassing normal channel")
	  ;; (if (rmt:write-frequency-over-limit? cmd run-id)(server:kind-run run-id))
	  (let ((curr-max (rmt:get-max-query-average)))
	    (if (> (cdr curr-max) max-avg-qry)
		(begin
		  (debug:print-info 3 "Max average query, " (inexact->exact (round (cdr curr-max))) "ms (" (car curr-max) ") exceeds " max-avg-qry ", try starting server ...")
		  (server:kind-run run-id))))







|







86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
	(let ((res             (http-transport:client-api-send-receive run-id connection-info cmd jparams)))
	  (http-transport:server-dat-update-last-access connection-info)
	  (if res
	      (db:string->obj res)
	      (let ((new-connection-info (client:setup run-id)))
		(debug:print 0 "WARNING: Communication failed, trying call to http-transport:client-api-send-receive again.")
		(rmt:send-receive cmd run-id params))))
	(let ((max-avg-qry (string->number (or (configf:lookup *configdat* "server" "server-query-threshold") "-1"))))
	  (debug:print-info 4 "no server and read-only query, bypassing normal channel")
	  ;; (if (rmt:write-frequency-over-limit? cmd run-id)(server:kind-run run-id))
	  (let ((curr-max (rmt:get-max-query-average)))
	    (if (> (cdr curr-max) max-avg-qry)
		(begin
		  (debug:print-info 3 "Max average query, " (inexact->exact (round (cdr curr-max))) "ms (" (car curr-max) ") exceeds " max-avg-qry ", try starting server ...")
		  (server:kind-run run-id))))
166
167
168
169
170
171
172

173
174
175
176
177

178
179
180
181
182
183
184
185
	   (duration      (- (current-milliseconds) start)))
      (rmt:update-db-stats cmd params duration)
      ;; mark this run as dirty if this was a write
      (if (not (member cmd api:read-only-queries))
	  (let ((start-time (current-seconds)))
	    (mutex-lock! *db-multi-sync-mutex*)
	    (let ((last-sync (hash-table-ref/default *db-local-sync* run-id 0)))

	      (if (and (> (- start-time last-sync) 5) ;; every five seconds
		       (common:db-access-allowed?))
		  (begin
		    ;; MOVE THIS TO A THREAD?
		    (db:multi-db-sync (list run-id) 'new2old)

		    (debug:print-info 0 "Sync of newdb to olddb for run-id " run-id " completed in " (- (current-seconds) start-time) " seconds")
		    (hash-table-set! *db-local-sync* run-id start-time))))
	    (mutex-unlock! *db-multi-sync-mutex*)))
      res)))

(define (rmt:send-receive-no-auto-client-setup connection-info cmd run-id params)
  (let* ((run-id   (if run-id run-id 0))
	 (jparams         (db:obj->string params)) ;; (rmt:dat->json-str params))







>
|
|



>
|







166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
	   (duration      (- (current-milliseconds) start)))
      (rmt:update-db-stats cmd params duration)
      ;; mark this run as dirty if this was a write
      (if (not (member cmd api:read-only-queries))
	  (let ((start-time (current-seconds)))
	    (mutex-lock! *db-multi-sync-mutex*)
	    (let ((last-sync (hash-table-ref/default *db-local-sync* run-id 0)))
	      (if ;; (and 
		   (> (- start-time last-sync) 5) ;; every five seconds
		  ;;      (common:db-access-allowed?))
		  (begin
		    ;; MOVE THIS TO A THREAD?
		    (db:multi-db-sync (list run-id) 'new2old)
		    (if (common:low-noise-print 30 "sync new to old")
			(debug:print-info 0 "Sync of newdb to olddb for run-id " run-id " completed in " (- (current-seconds) start-time) " seconds"))
		    (hash-table-set! *db-local-sync* run-id start-time))))
	    (mutex-unlock! *db-multi-sync-mutex*)))
      res)))

(define (rmt:send-receive-no-auto-client-setup connection-info cmd run-id params)
  (let* ((run-id   (if run-id run-id 0))
	 (jparams         (db:obj->string params)) ;; (rmt:dat->json-str params))