Megatest

Diff
Login

Differences From Artifact [4cb886426c]:

To Artifact [9f1fa5ad0d]:


80
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
80
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
106
107
108


109
110
111
112
113
114
115
116
117
118







+
+
+
+
+
+
+
+
+
+
+







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







		(debug:print 0 "WARNING: Communication failed, trying call to http-transport:client-api-send-receive again.")
		(rmt:send-receive cmd run-id params))))
	(begin
	  (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))
	  (rmt:open-qry-close-locally cmd run-id params)))))

(define (rmt:update-db-stats cmd duration)
  (mutex-lock! *db-stats-mutex*)
  (let ((stat-vec (hash-table-ref/default *db-stats* cmd #f)))
    (if (not stat-vec)
	(let ((newvec (vector 0 0)))
	  (hash-table-set! *db-stats* cmd newvec)
	  (set! stat-vec newvec)))
    (vector-set! stat-vec 0 (+ (vector-ref stat-vec 0) 1))
    (vector-set! stat-vec 1 (+ (vector-ref stat-vec 1) duration)))
  (mutex-unlock! *db-stats-mutex*))
	  
(define (rmt:open-qry-close-locally cmd run-id params)
  (let* ((dbdir (conc    (configf:lookup *configdat* "setup" "linktree") "/.db"))
	 (dbstruct-local (if *dbstruct-db*
			     *dbstruct-db*
			     (let ((db (make-dbr:dbstruct path:  dbdir local: #t)))
			       (set! *dbstruct-db* db)
			       db)))
	 (db-file-path   (db:dbfile-path 0))
	 ;; (read-only      (not (file-read-access? db-file-path)))
	 (res            (api:execute-requests dbstruct-local (symbol->string cmd) params)))
	 (db-file-path   (db:dbfile-path 0)))
    ;; (read-only      (not (file-read-access? db-file-path)))
    (let* ((start         (current-milliseconds))
	   (res           (api:execute-requests dbstruct-local (symbol->string cmd) params))
    ;; (db:close-all dbstruct-local)
    res))
	   (duration      (- (current-milliseconds) start)))
      (rmt:update-db-stats cmd duration)
      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))
	 (res (http-transport:client-api-send-receive run-id connection-info cmd jparams)))
    (if res
	(db:string->obj res)