Megatest

;;======================================================================
;; serialization
;;   NOTE: I've had problems with read/write and s11n serialize, deserialize
;;         thus the inefficient method here
;;======================================================================

(define serializing-method (make-parameter 'complex))


;; NOTE: Can remove the regex and base64 encoding for zmq
(define (obj->string obj)
  (case (serializing-method)
    ((complex)
     (string-substitute
      (regexp "=") "_"

;; run-listener does all the work of starting a listener in a thread
;; it then returns control
;;
(define (run-listener handler-proc #!optional (port-suggestion 4242))
  (let* ((uconn (make-udat)))
    (udat-work-proc-set! uconn handler-proc)
    (if (setup-listener uconn port-suggestion)
	(let* ((orig-in  (current-input-port))
	       (orig-out (current-output-port)))
	  ((make-tcp-server
	    (udat-socket uconn)
	    (lambda ()
	      (let* ((rdat
		      (string->obj (read))
		      ;; (read in)
		      ;; (deserialize)
		      ) 
		     (resp (let ((tcp-in  (current-input-port))
				 (tcp-out (current-output-port)))
			     (current-input-port orig-in)
			     (current-output-port orig-out)
			     (let ((res (do-work uconn rdat)))
			       (current-input-port tcp-in)
			       (current-output-port tcp-out)
			       res))))
		(write (obj->string resp))
		;; (serialize resp)
		;; (write resp out)
		)))))
	(assert #f "ERROR: run-listener called without proper setup."))))

(define (wait-and-close uconn)
  (thread-join! (udat-cmd-thread uconn))
  (tcp-close (udat-socket uconn)))

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

	 (my-host-port (and udata (udat-host-port udata)))          ;; remote will return to this
	 (isme         (equal? host-port my-host-port)) ;; calling myself?
	 ;; dat is a self-contained work block that can be sent or handled locally
	 (dat          (list my-host-port 'qrykey cmd params #;(cons (current-seconds)(current-milliseconds)))))
    (cond
     (isme (do-work udata dat)) ;; no transmission needed
     (else
      ;; (handle-exceptions ;; TODO - MAKE THIS EXCEPTION CMD SPECIFIC?
      ;;  exn
      ;;  (begin
      ;;    (print "ULEX send-receive: exn="exn)
      ;;    (message exn))
      ;;  (begin
	 ;; (mutex-lock! *send-mutex*) ;; DOESN'T SEEM TO HELP
	 (let-values (((inp oup)(tcp-connect host port)))
	   (let ((res (if (and inp oup)
			  (begin
			    (write (obj->string dat) oup)
			    ;; (write dat oup)
			    ;; (serialize dat oup)
			    (close-output-port oup)
			    (string->obj (read inp))
			    ;; (read inp)
			    ;; (deserialize inp)
			    )
			  (begin
			    (print "ERROR: send called but no receiver has been setup. Please call setup first!")
			    #f))))
	     ;; (close-output-port oup)
	     (close-input-port inp)
	     ;; (mutex-unlock! *send-mutex*) ;; DOESN'T SEEM TO HELP
	     res))))));; )) ;; res will always be 'ack unless return-method is direct

;;======================================================================
;; work queues - this is all happening on the listener side
;;======================================================================

;; move the logic to return the result somewhere else?
;;
(define (do-work uconn rdat)

  ;; put this following into a do-work procedure
  (match rdat
     ((rem-host-port qrykey cmd params)
      (case cmd
	((ping) 'ping-ack) ;; bypass calling the proc
	(else
	 (let* ((proc       (udat-work-proc uconn))
		(start-time (current-milliseconds))
		(result     (with-output-to-port (current-error-port)
			      (lambda ()
				(proc rem-host-port qrykey cmd params))))
		(end-time   (current-milliseconds))
		(run-time   (- end-time start-time)))
	   result))))
     (else
      (print "ERROR: rdat "rdat", did not match rem-host-port qrykey cmd params"))))

;;======================================================================
;; misc utils
;;======================================================================

(define (pp-uconn uconn)
  (pp (udat->alist uconn)))