Megatest

(declare (uses itemsmod))
(declare (uses ulex))

(module rmtmod
	*
	
(import scheme chicken data-structures extras)
(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18 srfi-69 format ports srfi-1 matchable
	s11n)

(import (prefix ulex ulex:))

(import commonmod)
(import itemsmod)
(import apimod)
(import dbmod)



;;
;; THESE ARE ALL CALLED ON THE CLIENT SIDE!!!
;;

;; generate entries for ~/.megatestrc with the following
;;
;;  grep define ../rmt.scm | grep rmt: |perl -pi -e 's/\(define\s+\((\S+)\W.*$/\1/'|sort -u

			#f)))
	  (if cinfo
	      cinfo
	      (if (server:check-if-running areapath)
		  (client:setup areapath)
		  #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 common:get-full-version)  ;; override ping with get-full-version
    (ulex:register-handler udata 'login common: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 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)))

#;(rmt:open-qry-close-locally cmd 0 params)

;;   
;; ;; #;(common:telemetry-log (conc "rmt:"(->string cmd))
;; ;; #;(define (rmt:send-receive cmd rid params #!key (attemptnum 1)(area-dat #f)) ;; start attemptnum at 1 so the modulo below works as expected
;; ;; 
;; ;; #;(common:telemetry-log (conc "rmt:"(->string cmd))
;; ;; payload: `((rid . ,rid)
;; ;; (params . ,params)))

;; 
;;      ;; not on homehost, do server query
;;      (else (extras-case-11 *default-log-port* runremote cmd params attemptnum rid)))))

;; bunch of small functions factored out of send-receive to make debug easier
;;

;;(define (extras-case-11 *default-log-port* runremote cmd params attemptnum rid)
;;  ;; (mutex-unlock! *rmt-mutex*)
;;  (debug:print-info 12 *default-log-port* "rmt:send-receive, case  9")
;;  ;; (mutex-lock! *rmt-mutex*)
;;  (let* ((conninfo (remote-conndat runremote))
;;	 (dat      (case (remote-transport runremote)
;;		     ((http) (condition-case ;; handling here has
;;					     ;; caused a lot of
;;					     ;; problems. However it
;;					     ;; is needed to deal with
;;					     ;; attemtped
;;					     ;; communication to
;;					     ;; servers that have gone
;;					     ;; away
;;				 #;(http-transport:client-api-send-receive 0 conninfo cmd params)
;;			      ((commfail)(vector #f "communications fail"))
;;			      ((exn)(vector #f "other fail" (print-call-chain)))))
;;		     (else
;;		      (debug:print 0 *default-log-port* "ERROR: transport " (remote-transport runremote) " not supported")
;;		      (exit))))
;;	 (success  (if (vector? dat) (vector-ref dat 0) #f))
;;	 (res      (if (vector? dat) (vector-ref dat 1) #f)))
;;    (if (and (vector? conninfo) (< 5 (vector-length conninfo)))
;;	#t #;(http-transport:server-dat-update-last-access conninfo) ;; refresh access time
;;	(begin
;;	  (debug:print 0 *default-log-port* "INFO: Should not get here! conninfo=" conninfo)
;;	  (set! conninfo #f)
;;	  (remote-conndat-set! *runremote* #f) ;; NOTE: *runremote* is global copy of runremote. Purpose: factor out global.
;;	  #;(http-transport:close-connections  area-dat: runremote)))
;;    (debug:print-info 13 *default-log-port* "rmt:send-receive, case  9. conninfo=" conninfo " dat=" dat " runremote = " runremote)
;;    (mutex-unlock! *rmt-mutex*)
;;    (if success ;; success only tells us that the transport was
;;	;; successful, have to examine the data to see if
;;	;; there was a detected issue at the other end
;;	(extras-transport-succeded *default-log-port* *rmt-mutex* attemptnum runremote res params rid cmd)
;;	(extras-transport-failed *default-log-port* *rmt-mutex* attemptnum runremote cmd rid params)
;;	)))

;; (define (rmt:update-db-stats run-id rawcmd params duration)
;;   (mutex-lock! *db-stats-mutex*)
;;   (handle-exceptions
;;    exn
;;    (begin
;;      (debug:print 0 *default-log-port* "WARNING: stats collection failed in update-db-stats")