Megatest

Diff
Login

Differences From Artifact [4f89f84546]:

To Artifact [9242f5462c]:


17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80


81
82
83
84
85
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

(declare (unit rmtmod))
(declare (uses commonmod))
(declare (uses apimod))
;; (declare (uses apimod.import))
(declare (uses ulex))

;; (include "ulex/ulex.scm")

(module rmtmod
	*
	
(import scheme chicken data-structures extras)
(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18)
(import (prefix commonmod cmod:))
(import apimod)
(import (prefix ulex ulex:))

(defstruct alldat
  (areapath #f)
  (ulexdat  #f)
  )

;;======================================================================
;; return the handle struct for sending queries to a specific database
;;  - initializes the connection object if this is the first access
;;    - finds the "captain" and asks who to talk to for the given dbfname
;;    - establishes the connection to the current dbowner
;;
#;(define (rmt:connect alldat dbfname dbtype)
  (let* ((ulexdat    (or (alldat-ulexdat alldat)
			 (rmt:setup-ulex alldat))))
    (ulex:connect ulexdat dbfname dbtype)))

;; setup the remote calls
#;(define (rmt:setup-ulex alldat)
  (let* ((udata (ulex:setup))) ;; establish connection to ulex
    (alldat-ulexdat-set! alldat udata)
    ;; register all needed procs
    (ulex:register-handler udata 'ping cmod:get-full-version)  ;; override ping with get-full-version
    (ulex:register-handler udata 'login cmod:get-full-version) ;; force setup of the connection
    (ulex:register-handler udata 'execute api:execute-requests)
    udata))

;; set up a connection to the current owner of the dbfile associated with rid
;; then send the query to that dbfile owner and wait for a response.
;;
#;(define (rmt:send-receive alldat cmd rid params #!key (attemptnum 1)(area-dat #f)) ;; start attemptnum at 1 so the modulo below works as expected
  (let* (;; (alldat   *alldat*)
	 (areapath (alldat-areapath alldat))
	 (dbtype   (if (or (not rid)(< rid 1)) ;; this is the criteria for "main.db"
		       "main" "runs"))
	 (dbfname  (if (equal? dbtype "main")
		       "main.db"
		       (conc rid ".db")))
	 (dbfile   (conc areapath "/.db/" dbfname))
	 (ulexconn (rmt:connect alldat dbfname dbtype))  ;; ulexconn is our new *runremote*, it is a dbowner struct < pdat lastrefresh >
	 (udata    (alldat-ulexdat alldat)))
    	(ulex:remote-request udata ulexconn 'immediate dbfile 'execute rid params)))
    ;; need to call this on the other side 
    ;; (api:execute-requests dbstruct-local (vector (symbol->string cmd) params))))


    
    #;(with-input-from-string
	(ulex:remote-request udata ulexconn 'immediate dbfile 'execute rid (with-output-to-string (lambda ()(serialize params))))
       (lambda ()(deserialize)))
)







<
|
<
<






|
|
|






<
<
<
<
<
<
|
<
<
<
|
|
<
<
<
<
<
<
<
<
|
<
<
<
<
|
<
<
|
<
|
<
<
|
<
|
<
<
>
>
|
<
<
<

17
18
19
20
21
22
23

24


25
26
27
28
29
30
31
32
33
34
35
36
37
38
39






40



41
42








43




44


45

46


47

48


49
50
51



52
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

(declare (unit rmtmod))
(declare (uses commonmod))
(declare (uses apimod))

(declare (uses dbmod))



(module rmtmod
	*
	
(import scheme chicken data-structures extras)
(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18)
(import commonmod)
(import dbmod)
(import apimod)

(defstruct alldat
  (areapath #f)
  (ulexdat  #f)
  )







(define (rmtmod:calc-ro-mode runremote *toppath*)



  (if (and runremote
	   (remote-ro-mode-checked runremote))








      (remote-ro-mode runremote)




      (let* ((ro-mode (not (db:writeable *toppath* "megatest.db"))))


	(if runremote

	    (begin


	      (remote-ro-mode-set! runremote ro-mode)

	      (remote-ro-mode-checked-set! runremote #t)


	      ro-mode)
	    ro-mode))))




)