;;;; remote-mailbox-test.scm

; should run multiple senders
;
; doesn't have good shutdown of socket
;
;X should have a better way to terminate the tcp-server loop
; - close the port

(use srfi-1 posix srfi-18)
(use remote-mailbox-client remote-mailbox-server remote-mailbox-adapter mailbox miscmacros)

(define-constant NUM-MSG 5)
(define-constant RCV-NAM "Wong Foo")
(define MB-NAM 'wong-foo)

(define (sender)
  (print "* Sending " NUM-MSG " messages")
	(let ((rmb (remote-mailbox MB-NAM)))
		(dotimes (n NUM-MSG)
		              ;a message can be any object
		  (let ((msg (vector 'message `(recipient ,RCV-NAM) `(id ,n))))
        (printf "Sending ~S to ~S~%" msg MB-NAM)
        (remote-mailbox-send! rmb msg) )
			; Semblance of computation
			(thread-sleep! 1) #;(repeat 10000) )
		#;(close-output-port (serializer-output))
		(begin (print "Send quit") (remote-mailbox-send! rmb 'quit)) ) )

(define (receiver)

  (define (server)
    (let ((rmbs (make-remote-mailbox-server #:debug RCV-NAM)))
      (values rmbs (remote-mailbox-server-start! rmbs)) ) )

  (let-values (((rmbs thrd) (server)))
    (print "* Receiving messages until 'quit")
    (let loop ()
      (let ((msg (mailbox-receive! (local-mailbox/server rmbs MB-NAM))))
        (printf "Received ~S from ~S~%" msg MB-NAM)
        (unless (eq? 'quit msg) (loop) )
        #;(loop) ) )
    #;(thread-terminate! thrd)
    #;(handle-exceptions ex
        (print "Performed \"hard\" termination of server thread")
      (thread-join! thrd) )
    (print "stopping...") (remote-mailbox-server-stop! rmbs) ) )

#;
(define (receiver)
  (print "* Receiving messages until 'quit")
  (let loop ()
    (let ((msg (mailbox-receive! (local-mailbox MB-NAM RCV-NAM))))
      (printf "Received ~S from ~S~%" msg MB-NAM)
      (unless (eq? 'quit msg)
        (loop) ) ) )
  (thread-terminate! (local-mailbox-thread))
  (handle-exceptions ex
      (print "Performed \"hard\" termination of server thread")
    (thread-join! (local-mailbox-thread)) ) )

(define operation
	(let ((args (command-line-arguments)))
		(and
		  (pair? args)
      (string->symbol (car args))) ) )

(if operation
    (case operation
      ((sender) (sender))
      ((receiver) (receiver))
      (else
        (error 'remote-mailbox-test "Unrecognized operation: " operation) ) )
    ;; The "server" MUST be started before the client!
    (let ((cmd (first (argv))))
      (print "Running Receiver: " cmd)
      (process-run cmd `("receiver"))
      (sleep 1) ;needed when this process is the sender
      (print "Running Sender: " cmd)
      #;(process-execute cmd `("sender"))
      (sender) ) )