diff --git a/clog-connection.lisp b/clog-connection.lisp
index 852447b..2ea6d13 100644
--- a/clog-connection.lisp
+++ b/clog-connection.lisp
@@ -11,6 +11,7 @@
;; Exports - clog-connection
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
(mgl-pax:define-package :clog-connection
(:documentation "The Common List Omnificent GUI - Connection")
(:use #:cl #:mgl-pax))
@@ -22,31 +23,41 @@
"CLOG connections"
- (message function)
- (execute-script function)
- (validp function)
- (cclose function)
- (shutdown function)
- (cwrite function)
- (cwriteln function))
+ (execute function)
+ (query function)
+ (validp function)
+ (cclose function)
+ (shutdown function)
+ (cwrite function)
+ (cwriteln function))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Implemetation - clog-connection
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
;;;;;;;;;;;;;
-;; message ;;
+;; execute ;;
;;;;;;;;;;;;;
-(defun message (connection-id message)
- "Send MESSAGE to CONNECTION-ID."
+(defun execute (connection-id message)
+ "Execute SCRIPT on CONNECTION-ID, disregard return value."
(let ((con (clog::get-connection connection-id)))
(when con
(websocket-driver:send con message))))
-;;;;;;;;;;;;;;;;;;;;
-;; execute-script ;;
-;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;
+;; query ;;
+;;;;;;;;;;;
-(defun execute-script (connection-id script)
- "Execute SCRIPT on CONNECTION-ID, disregard return value."
- (message connection-id script))
+(defun query (connection-id script)
+ "Execute SCRIPT on CONNECTION-ID, return value."
+ (let ((uid (clog::generate-connection-id)))
+ (clog::store-query uid nil)
+ (execute connection-id
+ (format nil "ws.send (\"~A:\"+eval(\"~A\"));" uid script))
+ (clog::wait-for-answer uid)))
;;;;;;;;;;;;
;; validp ;;
@@ -65,7 +76,7 @@
(defun cclose (connection-id)
"Close connection to CONNECTION-ID. The boot file may try to reistablish
connectivity."
- (execute-script connection-id "ws.close()"))
+ (execute connection-id "ws.close()"))
;;;;;;;;;;;;;;
;; shutdown ;;
@@ -74,7 +85,7 @@
(defun shutdown (connection-id)
"Shutdown connection to CONNECTION-ID. The boot file may not try to
reistablish connectivity."
- (execute-script connection-id "Shutdown_ws(event.reason='user')"))
+ (execute connection-id "Shutdown_ws(event.reason='user')"))
;;;;;;;;;;;;
;; cwrite ;;
@@ -82,7 +93,7 @@ reistablish connectivity."
(defun cwrite (connection-id text)
"Write TEXT raw to document object of CONNECTION-ID with out new line."
- (message connection-id (format nil "document.write('~A');" text)))
+ (execute connection-id (format nil "document.write('~A');" text)))
;;;;;;;;;;;;;;
;; cwriteln ;;
@@ -90,4 +101,4 @@ reistablish connectivity."
(defun cwriteln (connection-id text)
"Write TEXT raw to document object of CONNECTION-ID with new line."
- (message connection-id (format nil "document.writeln('~A');" text)))
+ (execute connection-id (format nil "document.writeln('~A');" text)))
diff --git a/clog.lisp b/clog.lisp
index 3b38700..58f2efe 100644
--- a/clog.lisp
+++ b/clog.lisp
@@ -59,11 +59,14 @@ application."
(defvar *connection-lock* (bordeaux-threads:make-lock)
"Protect the connection hash tables")
+(defvar *queries* (make-hash-table) "Waiting queries")
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; generate-connection-id ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun generate-connection-id ()
+ "Generate unique ids for use in connections and sripts. (Private)"
(incf *new-id*))
;;;;;;;;;;;;;;;;;;;;
@@ -102,9 +105,35 @@ application."
;; handle-message ;;
;;;;;;;;;;;;;;;;;;;;
+(defvar *queries-lock* (bordeaux-threads:make-lock))
+(defvar *queries-sems* (make-hash-table))
+
+(defun store-query (id answer)
+ (bordeaux-threads:with-lock-held (*queries-lock*)
+ (setf (gethash id *queries-sems*) (bordeaux-threads:make-semaphore))
+ (setf (gethash id *queries*) answer)))
+
+(defun wait-for-answer (id)
+ (bordeaux-threads:wait-on-semaphore (gethash id *queries-sems*) :timeout 3)
+ (let ((answer (gethash id *queries*)))
+ (bordeaux-threads:with-lock-held (*queries-lock*)
+ (remhash id *queries*)
+ (remhash id *queries-sems*))
+ answer))
+
(defun handle-message (connection message)
- (let ((id (gethash connection *connections*)))
- (format t "msg: ~A sent ~A - ~A~%" id message connection)))
+ (let ((id (gethash connection *connections*))
+ (ml (ppcre:split ":" message :limit 2)))
+ (cond ((equal (car ml) "0")
+ (when *verbose-output*
+ (format t "~A Ping ~A~%" id (car ml))))
+ (t
+ (when *verbose-output*
+ (format t "~A ~A = ~A~%" id (car ml) (cadr ml)))
+ (bordeaux-threads:with-lock-held (*queries-lock*)
+ (setf (gethash (parse-integer (car ml)) *queries*) (cadr ml)))
+ (bordeaux-threads:signal-semaphore
+ (gethash (parse-integer (car ml)) *queries-sems*))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; handle-close-connection ;;
@@ -156,9 +185,7 @@ application."
"Inititalze CLOG on a socket using HOST and PORT to serve BOOT-FILE as
the default route to establish web-socket connections and static files
located at STATIC-ROOT."
-
- (set-on-connect on-connect-handler)
-
+ (set-on-connect on-connect-handler)
(setf *app*
(lack:builder
(:static :path (lambda (path)
@@ -168,14 +195,11 @@ located at STATIC-ROOT."
:root static-root)
(lambda (env)
(clog-server env))))
-
(setf *client-handler* (clack:clackup *app* :address host :port port))
-
(when *verbose-output*
- (progn
- (format t "HTTP listening on : ~A:~A~%" host port)
- (format t "HTML Root : ~A~%" static-root)
- (format t "Boot file default : ~A~%" boot-file))))
+ (format t "HTTP listening on : ~A:~A~%" host port)
+ (format t "HTML Root : ~A~%" static-root)
+ (format t "Boot file default : ~A~%" boot-file)))
;;;;;;;;;;;;;;
;; shutdown ;;
diff --git a/test/test-clog.lisp b/test/test-clog.lisp
index 008b534..f597717 100644
--- a/test/test-clog.lisp
+++ b/test/test-clog.lisp
@@ -1,10 +1,10 @@
(defpackage #:test-clog
(:use #:cl)
- (:export test-connect on-connect))
+ (:export test-connect on-connect1 on-connect2))
(in-package :test-clog)
-(defun on-connect (id)
+(defun on-connect1 (id)
(format t "Connection ~A is valid? ~A~%" id (clog-connection:validp id))
;; (clog:execute-script id "alert('test1');")
(dotimes (n 10)
@@ -19,9 +19,13 @@
(clog-connection:cwrite id "
shutting down connection")
(clog-connection:shutdown id))
+(defun on-connect2 (id)
+ (clog-connection:cwrite id "Query Result : ")
+ (clog-connection:cwrite id (clog-connection:query id "navigator.appVersion")))
+
(defun test-connect ()
(print "Init connection")
- (clog:initialize #'on-connect :boot-file "/debug.html")
+ (clog:initialize #'on-connect2 :boot-file "/debug.html")
(print "Open browser")
(clog:open-browser)
)