gered/clj-browserchannel
Archived
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

Add send-string, buffer now contains json strs rather than data

Browse source 
Based on commit by vdichev "Replace send-map with send-string with JSON already converted to String", but keeping send-map and moving encoding of buffer before write to keep IE writer consistent with XHRWriter
This commit is contained in:
Gijs Stuurman 2012-05-11 22:08:57 +02:00
parent 28f1a7248f
commit f6d9daf6c5
1 changed files with 25 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

43
clj-browserchannel-server/src/net/thegeez/browserchannel.clj
View file

@ -50,9 +50,8 @@
(.schedule scheduler f secs TimeUnit/SECONDS)) (.schedule scheduler f secs TimeUnit/SECONDS))
;; json responses are sent as "size-of-response\njson-response" ;; json responses are sent as "size-of-response\njson-response"
(defn size-json-str [data] (defn size-json-str [json]
(let [json (json/json-str data) (let [size (alength (.getBytes json "UTF-8"))]
size (alength (.getBytes json "UTF-8"))]
(str size "\n" json))) (str size "\n" json)))
;; make sure the root URI for channels starts with a / for route matching ;; make sure the root URI for channels starts with a / for route matching
@ -195,7 +194,7 @@
(when (seq domain) (when (seq domain)
(async-adapter/write-chunk respond (str "<script>try{document.domain=\"" (pr-str (json/json-str domain)) "\";}catch(e){}</script>\n")))) (async-adapter/write-chunk respond (str "<script>try{document.domain=\"" (pr-str (json/json-str domain)) "\";}catch(e){}</script>\n"))))
(write [this data] (write [this data]
(async-adapter/write-chunk respond (str "<script>try {parent.m(" (pr-str (json/json-str data)) ")} catch(e) {}</script>\n")) (async-adapter/write-chunk respond (str "<script>try {parent.m(" (pr-str data) ")} catch(e) {}</script>\n"))
(when-not write-padding-sent (when-not write-padding-sent
(async-adapter/write-chunk respond ie-stream-padding) (async-adapter/write-chunk respond ie-stream-padding)
(set! write-padding-sent true))) (set! write-padding-sent true)))
@ -225,7 +224,7 @@
;; the client acknowledges received arrays when creating a new backwardchannel ;; the client acknowledges received arrays when creating a new backwardchannel
(acknowledge-arrays [this array-ids]) (acknowledge-arrays [this array-ids])
(queue-array [this array]) (queue-string [this string])
;; heartbeat is a timer to send noop over the backward channel ;; heartbeat is a timer to send noop over the backward channel
(clear-heartbeat [this]) (clear-heartbeat [this])
@ -338,7 +337,7 @@
(let [session-agent *agent*] (let [session-agent *agent*]
(schedule (fn [] (schedule (fn []
(send-off session-agent #(-> % (send-off session-agent #(-> %
(queue-array ["noop"]) (queue-string "[\"noop\"]")
flush-buffer))) flush-buffer)))
(:heartbeat-interval details)))))) (:heartbeat-interval details))))))
(clear-session-timeout [this] (clear-session-timeout [this]
@ -355,10 +354,10 @@
(schedule (fn [] (schedule (fn []
(send-off session-agent close "Timed out")) (send-off session-agent close "Timed out"))
(:session-timeout-interval details)))))) (:session-timeout-interval details))))))
(queue-array [this array] (queue-string [this string]
(let [next-array-id (inc last-sent-array-id)] (let [next-array-id (inc last-sent-array-id)]
(-> this (-> this
(update-in [:array-buffer] conj [next-array-id array]) (update-in [:array-buffer] conj [next-array-id string])
(assoc :last-sent-array-id next-array-id)))) (assoc :last-sent-array-id next-array-id))))
(acknowledge-arrays [this array-id] (acknowledge-arrays [this array-id]
(update-in this [:to-confirm-array-ids] (update-in this [:to-confirm-array-ids]
@ -371,10 +370,15 @@
this ;; nothing to do when there's no connection this ;; nothing to do when there's no connection
(if-let [buffer (seq array-buffer)] (if-let [buffer (seq array-buffer)]
(try (try
;; buffer contains [[1 json-str] ...] can't use
;; json-str which will double escape the json
(let [data (str "["
(str/join "," (map (fn [[n d]] (str "[" n "," d "]")) buffer))
"]")]
;; write throws exception when the connection is closed ;; write throws exception when the connection is closed
(write (:respond back-channel) buffer) (write (:respond back-channel) data))
;; size is an approximation ;; size is an approximation
(let [this (let [size (reduce + 0 (map count (map json/json-str buffer)))] (let [this (let [size (reduce + 0 (map count (map second buffer)))]
(-> this (-> this
(assoc :array-buffer clojure.lang.PersistentQueue/EMPTY) (assoc :array-buffer clojure.lang.PersistentQueue/EMPTY)
(assoc :last-sent-array-id (first (last buffer))) (assoc :last-sent-array-id (first (last buffer)))
@ -456,23 +460,24 @@
(let [has-back-channel (if (:back-channel session) 1 0) (let [has-back-channel (if (:back-channel session) 1 0)
last-sent-array-id (:last-sent-array-id session) last-sent-array-id (:last-sent-array-id session)
;; the sum of all the data that is still to be send ;; the sum of all the data that is still to be send
;; technically the size is padded by "[","," and "]" dividers inserted by
;; the encoding but this number is only used for estimation on
;; the client side.
outstanding-bytes (let [buffer (:array-buffer session)] outstanding-bytes (let [buffer (:array-buffer session)]
(if (empty? buffer) (if (empty? buffer)
0 0
(reduce + 0 (map count (map json/json-str buffer)))))] (reduce + 0 (map count (map second buffer)))))]
[has-back-channel last-sent-array-id outstanding-bytes])) [has-back-channel last-sent-array-id outstanding-bytes]))
;; convience function to send data to a session ;; convience function to send data to a session
;; the data will be queued until there is a backchannel to send it over ;; the data will be queued until there is a backchannel to send it
(defn send-map [session-id map] ;; over
(defn send-string [session-id string]
(when-let [session-agent (get @sessions session-id)] (when-let [session-agent (get @sessions session-id)]
(send-off session-agent #(-> % (send-off session-agent #(-> %
(queue-array map) (queue-string string)
flush-buffer)))) flush-buffer))))
(defn send-map [session-id map]
(send-string session-id (json/json-str map)))
;; wrap the respond function from :reactor with the proper ;; wrap the respond function from :reactor with the proper
;; responsewrapper for either IE or other clients ;; responsewrapper for either IE or other clients
(defn wrap-continuation-writers [handler options] (defn wrap-continuation-writers [handler options]
@ -545,7 +550,7 @@
{:status 200 {:status 200
:headers (assoc (:headers options) "Content-Type" "application/javascript") :headers (assoc (:headers options) "Content-Type" "application/javascript")
:body :body
(size-json-str [[0,["c", session-id, host-prefix, 8]]])}) (size-json-str (json/json-str [[0,["c", session-id, host-prefix, 8]]]))})
;; For existing sessions: ;; For existing sessions:
;; Forward sent data by client to listeners ;; Forward sent data by client to listeners
;; reply with ;; reply with
@ -558,7 +563,7 @@
(let [status (session-status @session-agent)] (let [status (session-status @session-agent)]
{:status 200 {:status 200
:headers (:headers options) :headers (:headers options)
:body (size-json-str status)}))))) :body (size-json-str (json/json-str status))})))))
;; GET req server->client is a backwardchannel opened by client ;; GET req server->client is a backwardchannel opened by client
(defn handle-backward-channel [req session-agent options] (defn handle-backward-channel [req session-agent options]