Megatest

all : a b ulex-test

ulex-test : ulex-test.scm ../ulex/ulex.scm
	csc ulex-test.scm

a : a.scm ../ulex/ulex.scm
	csc a.scm 

b : b.scm ../ulex/ulex.scm
	csc b.scm 

test : ulex-test
	for x in $$(seq 9);do export NBFAKE_LOG=NBFAKE_$$x;sleep 1;nbfake ./ulex-test run 828$$x;echo $$cmd;$$cmd;done

clean :
	rm -f ulex-test .runners/* NBFAKE*

    ;;(close-database db)
    )))
#t))
"receive"))
(th2 (make-thread (lambda () 
         (print "Jeff is here")  
         (let loop ((entries 0))  
         (thread-sleep! 0.8)
         (print "Preparding to send entries" entries)
         (handle-exceptions exn (begin (print "Had an issue: " (message exn))(thread-sleep! 10)) 
         (define-values (i o) (tcp-connect "localhost" 6504))
         (serialize (list "localhost:6505" "from-server-one") o)
         (print (read-line i))
         (close-input-port i)
         (close-output-port o))

    ;;(close-database db)
    )))
#t))
"receive"))
(th2 (make-thread (lambda () 
         (print "Jeff is here")  
         (let loop ((entries 0))  
         (thread-sleep! 0.8)
         (print "Preparding to send entries" entries)
         (handle-exceptions exn (begin (print "Had an issue: " (message exn))(thread-sleep! 10)) 
         (define-values (i o) (tcp-connect "localhost" 6505))
         (serialize (list "localhost:6505" "from-server-two") o)
         (print (read-line i))
         (close-input-port i)
         (close-output-port o))
         (loop (+ entries 1)))) "send"))
(th3 (make-thread (lambda ()
         (print "In mailbox thread")
         (let loop2 ((entries2 0))
           (print "Processing: " (mailbox-receive! work-mailbox))
           (mailbox-send! notify-mailbox (list 'ack))
           (thread-sleep! 0.5)
         (loop2 1))) "processing"))
(th4 (make-thread (lambda ()
         (print "In notify-mailbox thread")
         (let loop3 ((entries3 0))
           (print "Notifying: " (mailbox-receive! notify-mailbox))
           (handle-exceptions exn (begin (print "Had an issue: " (message exn))(thread-sleep! 10)) 
           (define-values (i o) (tcp-connect "localhost" 6505))

(define help "Usage: ulex-test COMMAND
  where COMMAND is one of:
    run host:port  : start test server - start several in same dir
")

(define (call uconn msg addr)
  (print "Sent: "msg" to " addr ", received: "
	 (send-receive uconn addr 'hello msg)))

;; start    => hello 0
;; hello 0  => hello 1
;; hello 1  => hello 2
;;  ...
;; hello 11 => 'done
;;
(define (process-message mesg)
  (print "In process-message")
  (let ((parts (string-split mesg)))
    (match
     parts
     ((msg c)
      (let ((count (string->number c)))
	(if (> count 10)
	    'done

	      (delete-file* rfile)
	      (sleep 1)
	      (exit))
	    (if (null? entries)
		(loop (glob ".runners/*"))
		(let* ((entry (car entries))
		       (destaddr (with-input-from-file entry read-line)))
		  (call uconn (conc "hello-from-"myport"to-"destaddr) (conc "localhost:" destaddr))
		  ;; (thread-sleep! 0.025)
		  (loop (cdr entries))))))))
   ((cmd)(print "ERROR: command "cmd", not recognised.\n\n"help))
   (else
    (print help))))

) ;; end module

(import ulex-test)
(main)

     work-method   ;; parameter; 'threads, 'mailbox, 'limited, 'direct
     return-method ;; parameter; 'mailbox, 'polling, 'direct
     )

(import scheme
	chicken.base
	chicken.file
	chicken.io
	chicken.time
	chicken.condition
	chicken.string
	chicken.sort
	chicken.pretty-print
	
	address-info
	mailbox
	matchable
	;; queues
	regex
	regex-case
    simple-exceptions
	s11n
	srfi-1
	srfi-18
	srfi-4
	srfi-69
	system-information
	tcp6

	 ;; 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 (ulex-handler udata dat)) ;; no transmission needed
     (else
      (handle-exceptions ;; TODO - MAKE THIS EXCEPTION CMD SPECIFIC?
	  exn

	  (message exn)
	(begin
	  ;; (mutex-lock! *send-mutex*)
	  (let-values (((inp oup)(tcp-connect host-port)))
	    (let ((res (if (and inp oup)
			   (begin
			     (serialize dat oup)
                 (close-output-port oup)
			     (deserialize inp)
               )
			   (begin
			     (print "ERROR: send called but no receiver has been setup. Please call setup first!")
			     #f))))
	      (close-input-port inp)

	      ;; (mutex-unlock! *send-mutex*)
	      res)))))))) ;; res will always be 'ack unless return-method is direct

(define (send-via-polling uconn host-port cmd data)
  (let* ((qrykey (make-cookie uconn))
	 (sres   (send uconn host-port qrykey cmd data)))
    (case sres