Index: ulex-trials/server-one.scm
==================================================================
--- ulex-trials/server-one.scm
+++ ulex-trials/server-one.scm
@@ -1,33 +1,61 @@
-(require-extension tcp-server format (chicken tcp) (chicken io) (chicken string) sql-de-lite srfi-18 simple-exceptions)
-(let* ((th1 (make-thread (lambda ()
+(import tcp-server format (chicken tcp) (chicken io) (chicken string) (prefix sqlite3 sqlite3:) sql-de-lite srfi-18 simple-exceptions mailbox s11n)
+(let* ((work-mailbox (make-mailbox))
+ (notify-mailbox (make-mailbox))
+(th1 (make-thread (lambda ()
((make-tcp-server
(tcp-listen 6505)
(lambda ()
- (let* ((db (open-database "test.db"))
- (rec-data (read-line)))
- (exec (sql db "INSERT INTO entries (received,send) VALUES (?,?);") rec-data (conc "Server One Response: " rec-data))
- (format (current-error-port) rec-data)
- (write-line (conc "Response to: " rec-data))
- (close-database db)
+ (let* ((db (sqlite3:open-database "test.db"))
+ (rec-data (deserialize)))
+ (sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 136000))
+ ;;(exec (sql db "INSERT INTO entries (received,send) VALUES (?,?);") "something" (conc "Server One Response: " "something else"))
+ (sqlite3:execute db "INSERT INTO entries (received,send) VALUES (?,?);" "something" (conc "Server One Response: " "something else"))
+ (mailbox-send! work-mailbox rec-data)
+ (format (current-error-port) (conc rec-data))
+ (write-line (conc "Response to: " (conc rec-data)))
+ ;;(close-database db)
)))
#t))
-"Ulex command loop"))
+"receive"))
(th2 (make-thread (lambda ()
(print "Jeff is here")
(let loop ((entries 0))
- (thread-sleep! 0.05)
+ (thread-sleep! 0.01)
(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))
- (write-line (conc "entries" entries) o)
+ (serialize (list "localhost:6505" "from-server-one") o)
(print (read-line i))
(close-input-port i)
(close-output-port o))
- (loop (+ entries 1)))) "jeff")))
+ (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.01)
+ (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" 6504))
+ (serialize (list 'ack "from-server-one") o)
+ (print (read-line i))
+ (close-input-port i)
+ (close-output-port o))
+ ;;(thread-sleep! 1)
+ (loop3 1))) "notify"))
+
+)
(thread-start! th1)
(thread-start! th2)
+(thread-start! th3)
+(thread-start! th4)
(thread-join! th2)
)
(print "Done here")
Index: ulex-trials/server-two.scm
==================================================================
--- ulex-trials/server-two.scm
+++ ulex-trials/server-two.scm
@@ -1,34 +1,61 @@
-(require-extension tcp-server format (chicken tcp) (chicken io) (chicken string) sql-de-lite srfi-18 simple-exceptions)
-
-(let* ((th1 (make-thread (lambda ()
+(import tcp-server format (chicken tcp) (chicken io) (chicken string) (prefix sqlite3 sqlite3:) sql-de-lite srfi-18 simple-exceptions mailbox s11n)
+(let* ((work-mailbox (make-mailbox))
+ (notify-mailbox (make-mailbox))
+(th1 (make-thread (lambda ()
((make-tcp-server
(tcp-listen 6504)
(lambda ()
- (let* ((db (open-database "test.db"))
- (rec-data (read-line)))
- (exec (sql db "INSERT INTO entries (received,send) VALUES (?,?);") rec-data (conc "Server Two Response: " rec-data))
- (format (current-error-port) rec-data)
- (write-line (conc "Response to: " rec-data))
- (close-database db)
+ (let* ((db (sqlite3:open-database "test.db"))
+ (rec-data (deserialize)))
+ (sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 136000))
+ ;;(exec (sql db "INSERT INTO entries (received,send) VALUES (?,?);") "something" (conc "Server One Response: " "something else"))
+ (sqlite3:execute db "INSERT INTO entries (received,send) VALUES (?,?);" "something" (conc "Server One Response: " "something else"))
+ (mailbox-send! work-mailbox rec-data)
+ (format (current-error-port) (conc rec-data))
+ (write-line (conc "Response to: " (conc rec-data)))
+ ;;(close-database db)
)))
#t))
-"Ulex command loop"))
+"receive"))
(th2 (make-thread (lambda ()
(print "Jeff is here")
- (let loop ((entries 500))
+ (let loop ((entries 0))
(thread-sleep! 0.01)
- (print "Preparing to send entries" entries)
+ (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))
- (write-line (conc "entries" entries) o)
+ (serialize (list "localhost:6505" "from-server-two") o)
(print (read-line i))
(close-input-port i)
(close-output-port o))
- (loop (+ entries 1)))) "jeff")))
+ (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.01)
+ (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))
+ (serialize (list 'ack "from-server-two") o)
+ (print (read-line i))
+ (close-input-port i)
+ (close-output-port o))
+ ;;(thread-sleep! 1)
+ (loop3 1))) "notify"))
+
+)
(thread-start! th1)
(thread-start! th2)
+(thread-start! th3)
+(thread-start! th4)
(thread-join! th2)
)
(print "Done here")