Skip to content

Instantly share code, notes, and snippets.

@ghadishayban
Created December 17, 2011 22:06
Show Gist options
  • Save ghadishayban/1491548 to your computer and use it in GitHub Desktop.
Save ghadishayban/1491548 to your computer and use it in GitHub Desktop.
HL7 LLP wire protocol receiver, ClojureScript on node.js. No ACKs yet
(ns llp.server
(:require [cljs.nodejs :as node]
[clojure.string :as str]))
(def net (node/require "net"))
(def events (node/require "events"))
(defn bufs->string [bufs]
(loop [acc ""
rst bufs]
(if (seq rst)
(recur (+ acc (.toString (first rst) "ascii"))
(rest rst))
acc)))
(def def-term-chars {:start-byte 0x0B
:end-byte1 0x1C
:end-byte2 0x0D})
(defn make-data-handler [{:keys [start-byte
end-byte1
end-byte2]}]
(let [data-bufs (atom []) ;; accumulator of HL7 data seen
state (atom :start-byte)] ;; represents what parser is looking for
(fn [buf]
(let [len (.length buf)]
(loop [next-pos 0
begin-mark :previous-buffer]
(if (> next-pos len)
(if (not= @state :start-byte)
(if (= begin-mark :previous-buffer)
(swap! data-bufs conj buf)
(swap! data-bufs conj (.slice buf begin-mark)))) ;; does begin-mark need a range check?
(condp = (aget buf next-pos)
start-byte ;; See a start-byte
(do (reset! state :end-byte1)
(reset! data-bufs [])
(recur (inc next-pos) (inc next-pos)))
end-byte1 ;; See an endbyte
(condp = @state
:end-byte1 ;; and if we were looking for it
(do (reset! state :end-byte2) ;; look for second end-byte
(recur (inc next-pos) begin-mark)) ;; don't move mark forward
(do (println "Unexpected end-byte1")
(reset! state :start-byte)
(reset! data-bufs [])
(recur (inc next-pos) :previous-buffer)))
end-byte2
(condp = @state
:end-byte2 ;; and if we were looking for it
(do (reset! state :start-byte) ;; look for a new message
(if (= begin-mark :previous-buffer)
(swap! data-bufs conj (.slice buf 0 next-pos))
(swap! data-bufs conj (.slice buf begin-mark next-pos)))
(println "GOT A FULL MESSAGE:\n" (str/replace (bufs->string @data-bufs)
"\r" "\n")) ;; Gets rid of CR's, otherwise terminal output is fucking useless
(reset! data-bufs [])
(recur (inc next-pos) :previous-buffer)) ;; start over!
(recur (inc next-pos) begin-mark)) ;; this is the case for a segment terminator
;; default case for non terminating byte
(condp = @state
:end-byte1 ;;
(recur (inc next-pos) begin-mark)
:end-byte2 ;;
(do (println "Didn't receive EB2")
(reset! state :start-byte)
(reset! data-bufs []) ;; FIXME, maybe this can return gracefully
(recur (inc next-pos) :previous-buffer))
;; else
(recur (inc next-pos) :previous-buffer))))))))) ;; is this recur CORRECT?????
(def dh (make-data-handler def-term-chars))
(defn connect-handler [con]
(.on con "data" dh)
(println "New connection"))
(defn start [& args]
(let [server (.createServer net connect-handler)]
(.listen server (first args) "127.0.0.1"))) ;; CALL ME WITH THE PORT
(set! *main-cli-fn* start)
@cmiles74
Copy link

This looks good! I have some similar looking code in my Clojure HL7 applications. :)

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment