Add thread safe queue. Use to push updates to client.

diff --git a/eow.asd b/eow.asd
index 5e8e4d236505fbad6a6f93368e43b9fd0522ad1c..01d54501da943a142dd09f4c2aa1159b727efd0b 100644 (file)
--- a/eow.asd
+++ b/eow.asd
@@ -21,7 +21,9 @@
     :components ((:file "package")
                  (:file "util"
                         :depends-on ("package"))
+                 (:file "locked-queue"
+                        :depends-on ("package"))
                 (:file "web"
-                       :depends-on ("package"))
+                       :depends-on ("package" "locked-queue"))
                  (:file "empire"
                         :depends-on ("util"))))

diff --git a/locked-queue.lisp b/locked-queue.lisp
new file mode 100644 (file)
index 0000000..66f4354
--- /dev/null
+++ b/locked-queue.lisp
@@ -0,0 +1,35 @@
+(in-package :locked-queue)
+
+(declaim (optimize (space 0) (speed 0) (safety 3) (debug 3)))
+
+(defclass locked-queue ()
+  ((queue :initform nil)
+   (mutex :initform (sb-thread:make-mutex :name "queue lock"))
+   (waitq :initform (make-waitqueue))))
+
+(defun create ()
+  (make-instance 'locked-queue))
+
+(defmethod dequeue ((q locked-queue))
+  (with-slots (queue mutex waitq) q
+    (with-mutex (mutex)
+      (if (or (null queue)
+             (null (first queue)))
+         (condition-wait waitq mutex))
+      (prog1 (first (car queue))
+       (setf (car queue)
+             (rest (car queue)))))))
+
+(defmethod enqueue ((q locked-queue) value)
+  (with-slots (queue mutex waitq) q
+    (with-mutex (mutex)
+      (let ((last (list value)))
+       (if (null (first queue))
+           (progn
+             (setf queue (cons last last))
+             (condition-notify waitq))
+           (progn
+             (setf (rest (cdr queue))
+                   last
+                   (cdr queue) last)
+             (cons (car queue) last)))))))

diff --git a/package.lisp b/package.lisp
index f801b626b52976d10f80a1c8ed7ab847037dacfb..c06705a8c79b382790a282ef1bd37c5c33c812e7 100644 (file)
--- a/package.lisp
+++ b/package.lisp
@@ -11,6 +11,9 @@
     (:export :read-message-loop
              :read-message
             :make-connection))
+  (defpackage :locked-queue
+    (:use :cl :sb-thread)
+    (:export :create :enqueue :dequeue))
   (defpackage :empire-web
     (:use :cl :hunchentoot)
     (:export :start)))

diff --git a/static/eow.js b/static/eow.js
index f85607584d06d431ba35b1851bb9cdbf19b9fc5a..00b34ee239e46328344d35e3fbf85a4f097b524e 100644 (file)
--- a/static/eow.js
+++ b/static/eow.js
@@ -8,8 +8,9 @@ function eowOut(output) {
 function hello() {
   dojo.xhrGet( {
     // The following URL must match that used to test the server.
-    url: "/eow/static/ajax.txt", 
+    url: "/eow/update", 
     handleAs: "javascript",
+    //handleAs: "text",
 
     timeout: 5000, // Time in milliseconds
 

diff --git a/web.lisp b/web.lisp
index 763b6f3a46621d7698aa0daa576fcb3b961060bf..40b74066ca506a21ff2c3e9fe1617c6bdf8e9ae8 100644 (file)
--- a/web.lisp
+++ b/web.lisp
@@ -30,10 +30,17 @@
          (fullname (concatenate 'string +static-files-root+ fname)))
     (handle-static-file fullname)))
 
+(defvar *update-queue* (locked-queue:create))
+
+(defun update ()
+  "Send stream of updates to client"
+  (locked-queue:dequeue *update-queue*))
+
 (defun dispatch (request)
   (let ((script-name (script-name request)))
     (cond
       ((not (string-starts-with script-name +web-root+)) nil) ; do not handle this request
+      ((string= script-name "/eow/update") 'update)
       ((or (string-equal script-name +web-root-base+)
            (string-equal script-name +web-root+)) (redirect +root-url+)) ; go to the start page
       ((string-starts-with script-name +static-web-root+) 'serve-static)))) ; serve static file