Megatest

Artifact [43c7c98ef5]
Login

Artifact 43c7c98ef5362228eeb909f207e84fdea2a3ed18:


;;======================================================================
;; Copyright 2017, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

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

(declare (unit tcp-transportmod))
(declare (uses debugprint))
(declare (uses commonmod))

(module tcp-transportmod
	*
	
  (import scheme
	  chicken
	  data-structures
	  extras
	  matchable)
  
(import (prefix sqlite3 sqlite3:)
	posix typed-records srfi-18 srfi-1
	srfi-69
	stack
	files
	ports

	commonmod
	;; debugprint
	)

;;======================================================================
;; client
;;======================================================================

;; (define keep-age-param (make-parameter 10)) ;; qif file age, if over move to attic

(defstruct tt
  (area #f)
  (conns (make-hash-table)) ;; dbfname -> conn
  
  )

(define (tt:make-remote areapath)
  (make-tt area: areapath))

(define (tt:handler runremote cmd rid params attemptnum area-dat areapath readonly-mode dbfname)
  ;; NOTE: areapath is passed in and in tt struct. We'll use passed in value for now.
  (let* ((conn (hash-table-ref/default (tt-conns runremote) dbfname #f)))
    (if conn
	;; have connection, call the server
	(let* ((res (tt:send-receive runremote conn cmd rid params)))
	  (cond
	   ((member res '(busy starting))
	    (thread-sleep! 1)
	    (tt:handler  runremote cmd rid params attemptnum area-dat areapath readonly-mode dbfname))
	   (else
	    res)))
	;; no conn yet, find and or start and find a server
	(let* ((server (tt:find-server areapath dbfname)))
	  (if server
	      (let* ((conn (tt:server-connect server)))
		(hash-table-set! (tt-conns runremote) dbfname conn)
		(tt:handler  runremote cmd rid params attemptnum area-dat areapath readonly-mode dbfname))
	      ;; no server, try to start one
	      (begin
		(tt:start-server areapath dbfname)
		(thread-sleep! 1)
		(tt:handler  runremote cmd rid params attemptnum area-dat areapath readonly-mode dbfname)))))))

(define (tt:bid-for-servership run-id)
  #f)

(define (tt:get-current-server run-id)
  #f)

(define (tt:send-receive ttdat conn cmd run-id params)
  #f)

;;======================================================================
;; server
;;======================================================================

(define (tt:sync-dbs ttdat)
  #f)

(define (tt:start-server ttdat)
  #f)

(define (tt:server-connect ttdat)
  #f)

(define (tt:find-server ttdat)
  #f)

(define (tt:shutdown-server ttdat)
  #f)



)