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
	 (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)))
				    #f
				    (let ((res (client:setup run-id)))
				      (if res 
					  (hash-table-ref/default *runremote* run-id #f) ;; client:setup filled this in (hopefully)

					  #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))


	 (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)
    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







<
|
|
<



>
|














|
>
|
>
>



|







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 ...

				;;  ;; (and (not (rmt:write-frequency-over-limit? cmd run-id))
				(if (open-run-close tasks:server-running-or-starting? tasks:open-db run-id)

				    (let ((res (client:setup run-id)))
				      (if res 
					  (hash-table-ref/default *runremote* run-id #f) ;; client:setup filled this in (hopefully)
					  #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 (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)
    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