Megatest

;;                    R U N N A M E    A N D   T E S T P A T T
;;======================================================================

;;======================================================================
;; (map print (map car (hash-table->alist (configf:read-config "runconfigs.config" #f #t))))
;;
(define (common:get-runconfig-targets configf) ;; #!key (configf #f))
  (let ((targs       (sort (map car (hash-table->alist configf))





			   string<?))
	(target-patt (args:get-arg "-target")))
    (if target-patt
	(filter (lambda (x)
		  (patt-list-match x target-patt))
		targs)
	targs)))

    

(define (sexpr->string data)
  (with-output-to-string
    (lambda ()(write data))))

(define (string->sexpr instr)
  (handle-exceptions
   exn
   (begin
     (debug:print 0 *default-log-port* "ERROR: string->sexpr bad input \""instr"\"")
     #f)
   (with-input-from-string instr
     (lambda ()(read)))))

)

     
     ;;======================================================================
     ;; Weird special calls that need to run *after* the server has started?
     ;;======================================================================
     
     (if (args:get-arg "-list-targets")
         (if (launch:setup)
             (let* ((rconfdat (configf:read-config (conc *toppath* "/runconfigs.config") #f #f))
		    (targets  (common:get-runconfig-targets rconfdat)))
               ;; (debug:print 1 *default-log-port* "Found "(length targets) " targets")
               (case (string->symbol (or (args:get-arg "-dumpmode") "alist"))
                 ((alist)
                  (for-each (lambda (x)
                              ;; (print "[" x "]"))
                              (print x))
                            targets))

	      (start-main-srv)))
	(start-main-srv))))

;; NB// remote is a rmt:remote struct
;;
(define (rmt:general-open-connection remote apath dbname)
  (let  ((mainconn (rmt:get-connection remote apath (db:run-id->dbname #f))))
    ;; (debug:print 0 *default-log-port* "remote: " remote)
    (if (not mainconn)
	(begin
	  (rmt:open-main-connection remote apath)
	  (thread-sleep! 1)
	  (rmt:general-open-connection remote apath dbname))
	;; we have a connection to main, ask for contact info for dbname
	(let* ((res (rmt:send-receive 'get-server #f `(,apath ,dbname))))
	  ;; (print "rmt:general-open-connection got res="res)
	  res))))
	  

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

;; Defaults to 
;;
(define (rmt:send-receive cmd rid params #!key (attemptnum 1)(area-dat #f))
  (if (not *rmt:remote*)(set! *rmt:remote* (make-rmt:remote)))
  (let* ((apath *toppath*)
	 (conns *rmt:remote*)
	 (dbname (db:run-id->dbname rid)))
    (rmt:send-receive-real conns apath dbname rid cmd params)))

;; db is at apath/.db/dbname, rid is an intermediary solution and will be removed
;; sometime in the future
;;
(define (rmt:send-receive-real remote apath dbname rid cmd params)
  (let* ((conn (rmt:get-connection remote apath dbname)))
    (if conn
	(let* (;; (host    (rmt:conn-ipaddr conn))
	       ;; (port    (rmt:conn-port   conn))
	       (payload (sexpr->string params))
	       (res      (with-input-from-request
			  (rmt:conn->uri conn "api")
			  `((params . ,payload)
			    (cmd    . ,cmd)
			    (key    . "nokey"))
			  read-string)))
	  (if (string? res)
	      (string->sexpr res)
	      res))
	;; no conn yet, start it up
	(begin
	  (rmt:general-open-connection remote apath dbname)
	  (rmt:send-receive-real remote apath dbname rid cmd params)))))

;; db is at apath/.db/dbname, rid is an intermediary solution and will be removed
;; sometime in the future
;;
(define (rmt:send-receive-server-start remote apath dbname)
  (let* ((conn (rmt:get-connection remote apath dbname)))
    (assert conn "FATAL: Unable to connect to db "apath"/"dbname)

 ;; rmt:get-connection
 ;; with-input-from-request
 )

(define *db* (db:setup #f))
(test #f 'server-started (api:execute-requests *db* 'get-server (list *toppath* ".db/1.db")))
(test #f 'server-started (rmt:general-open-connection *rmt:remote* *toppath* ".db/1.db"))
(test #f '("SYSTEM" "RELEASE") (rmt:get-keys))

;; (delete-file* "logs/1.log")
;; (define run-id 1)

;; (test "setup for run" #t (begin (launch:setup)
;;  				(string? (getenv "MT_RUN_AREA_HOME"))))
;;