Megatest

Diff
Login

Differences From Artifact [1094d13d5a]:

To Artifact [41ba4d4320]:


63
64
65
66
67
68
69
70
71
72


73
74
75
76

77

78
79
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
63
64
65
66
67
68
69



70
71

72
73
74
75

76
77
78
79
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







-
-
-
+
+
-



+
-
+














-
-
+
+
+
+
+



-
+







	 (connection-info (let ((cinfo (hash-table-ref/default *runremote* run-id #f)))
			    (if cinfo
				cinfo
				;; if read only query and server not already running
				;; bypass starting the server. 
				;;
				;; NB// can cache the answer for server running for 10 seconds ...
				;;
				(if (and (not (rmt:write-frequency-over-limit? cmd run-id))
					 (not (open-run-close tasks:server-running-or-starting? tasks:open-db run-id)))
				;;  ;; (and (not (rmt:write-frequency-over-limit? cmd run-id))
				(if (open-run-close tasks:server-running-or-starting? tasks:open-db run-id)
				    #f
				    (let ((res (client:setup run-id)))
				      (if res 
					  (hash-table-ref/default *runremote* run-id #f) ;; client:setup filled this in (hopefully)
					  #f))
					  #f))))))
				    #f))))
	 (jparams         (db:obj->string params)))
    (if connection-info
	(let ((res             (http-transport:client-api-send-receive run-id connection-info cmd jparams)))
	  (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))))
	(begin
	  (debug:print-info 4 "no server and read-only query, bypassing normal channel")
	  (rmt:open-qry-close-locally cmd run-id params)))))

(define (rmt:open-qry-close-locally cmd run-id params)
  (let* ((dbdir (conc    (configf:lookup *configdat* "setup" "linktree") "/.db"))
	 (dbstruct-local (make-dbr:dbstruct path:  dbdir
					    local: #t))
	 (dbstruct-local (if *megatest-db*
			     *megatest-db*
			     (let ((db (make-dbr:dbstruct path:  dbdir local: #t)))
			       (set! *megatest-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:close-all dbstruct-local)
    ;; (db:close-all dbstruct-local)
    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