escape-string

This commit is contained in:
David Botton 2020-12-14 22:36:29 -05:00
parent 252f2bd922
commit d7ae4c1bfd
3 changed files with 48 additions and 22 deletions

View file

@ -28,8 +28,9 @@
(validp function)
(cclose function)
(shutdown function)
(cwrite function)
(cwriteln function))
(put function)
(put-line function)
(new-line function))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -56,7 +57,9 @@
(let ((uid (clog::generate-connection-id)))
(clog::prep-query uid nil)
(execute connection-id
(format nil "ws.send (\"~A:\"+eval(\"~A\"));" uid script))
(format nil "ws.send (\"~A:\"+eval(\"~A\"));"
uid
(clog:escape-string script)))
(clog::wait-for-answer uid)))
;;;;;;;;;;;;
@ -87,18 +90,26 @@
reistablish connectivity."
(execute connection-id "Shutdown_ws(event.reason='user')"))
;;;;;;;;;;;;
;; cwrite ;;
;;;;;;;;;;;;
;;;;;;;;;
;; put ;;
;;;;;;;;;
(defun cwrite (connection-id text)
"Write TEXT raw to document object of CONNECTION-ID with out new line."
(execute connection-id (format nil "document.write('~A');" text)))
(defun put (connection-id text)
"Write TEXT to document object of CONNECTION-ID with out new line."
(execute connection-id (format nil "document.write('~A');" (clog:escape-string text))))
;;;;;;;;;;;;;;
;; cwriteln ;;
;; put-line ;;
;;;;;;;;;;;;;;
(defun cwriteln (connection-id text)
"Write TEXT raw to document object of CONNECTION-ID with new line."
(execute connection-id (format nil "document.writeln('~A');" text)))
(defun put-line (connection-id text)
"Write TEXT to document object of CONNECTION-ID with new line and HTML <br />."
(execute connection-id (format nil "document.writeln('~A<br />');" (clog:escape-string text))))
;;;;;;;;;;;;;;
;; new-line ;;
;;;;;;;;;;;;;;
(defun new-line (connection-id)
"Write a new line raw to document object of CONNECTION-ID with a <br />."
(execute connection-id (format nil "document.writeln('<br />');")))

View file

@ -38,8 +38,9 @@ application."
(set-on-connect function)
"CLOG utilities"
(open-browser function))
(escape-string function)
(open-browser function))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Implementation - clog
@ -235,6 +236,19 @@ located at STATIC-ROOT."
"Change the ON-CONNECTION-HANDLER set during Initialize."
(setf *on-connect-handler* on-connect-handler))
;;;;;;;;;;;;;;;;;;;
;; escape-string ;;
;;;;;;;;;;;;;;;;;;;
(defun escape-string (str)
"Escape STR for sending to browser script."
(let ((res))
(setf res (ppcre:regex-replace-all "\\x22" str "\\x22"))
(setf res (ppcre:regex-replace-all "\\x27" res "\\x27"))
(setf res (ppcre:regex-replace-all "\\x0A" res "\\x0A"))
(setf res (ppcre:regex-replace-all "\\x0D" res "\\x0D"))
res))
;;;;;;;;;;;;;;;;;;
;; open-browser ;;
;;;;;;;;;;;;;;;;;;

View file

@ -7,17 +7,18 @@
(defun on-connect (id)
(format t "Connection ~A is valid? ~A~%" id (clog-connection:validp id))
(dotimes (n 10)
(clog-connection:cwrite id "<b>connection-write</b>")
(clog-connection:cwriteln id "<i>connection-writeln</i>")
(clog-connection:put id "<b>connection-write</b>")
(clog-connection:put-line id "<i>connection-writeln</i>")
(sleep .2))
(clog-connection:cwrite id "<br><b>Query Result : </b>")
(clog-connection:cwrite id (clog-connection:query id "navigator.appVersion"))
(clog-connection:cwrite id "<hr>simulate network interupt")
(clog-connection:put id "<br><b>Query Result : </b>")
(clog-connection:put-line id (clog-connection:query id "navigator.appVersion"))
(clog-connection:new-line id)
(clog-connection:put id "<hr>simulate network interupt")
(clog-connection:cclose id)
(sleep .2)
(clog-connection:cwrite id "<br><b>reconnected</b>")
(clog-connection:put id "<br><b>reconnected</b>")
(sleep .2)
(clog-connection:cwrite id "<br><b>shutting down connection</b>")
(clog-connection:put id "<br><b>shutting down connection</b>")
(sleep .2)
;; It is generally uneccessary to shutdown the connection
(clog-connection:shutdown id))