response.lisp 5.42 KB
Newer Older
Carlos Ungil's avatar
Carlos Ungil committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133
(in-package :bloomie)

(defvar *event-types*
  (loop for s in (apropos-list "+BLPAPI-EVENTTYPE-" "BB.FFI")
     collect (cons (symbol-value s) (intern (subseq (string-trim "+" (symbol-name s)) (length "BLPAPI-EVENTTYPE-")) "KEYWORD"))))

#+lispworks
(setf *event-types* '((1 . :ADMIN) (11 . :AUTHORIZATION-STATUS) (6 . :PARTIAL-RESPONSE)
		      (15 . :REQUEST) (4 . :REQUEST-STATUS) (12 . :RESOLUTION-STATUS)
		      (5 . :RESPONSE) (9 . :SERVICE-STATUS) (2 . :SESSION-STATUS)
		      (8 . :SUBSCRIPTION-DATA) (3 . :SUBSCRIPTION-STATUS) (10 . :TIMEOUT)
		      (14 . :TOKEN-STATUS) (13 . :TOPIC-STATUS)))

(defun decode-event-type (x)
  (or (cdr (assoc x *event-types*)) (error "event-type ~A not in ~A" x *event-types*)))

#+lispworks
(defun next-msg (iterator)
  "return null if there are no more messages"
  (multiple-value-bind (res msg)
      (bb.ffi::blpapi-message-iterator-next iterator nil)
    (when (zerop res) msg)))

#-lispworks
(defun next-msg (iterator)
  "return null if there are no more messages"
  (plus-c:c-with ((msg :pointer))
    (when (zerop (bb.ffi:blpapi-message-iterator-next iterator (msg plus-c:&)))
      (autowrap:wrap-pointer msg 'bb.ffi:blpapi-message-t))))

#+lispworks
(defun message-correlation-id (msg)
  (unless (= 1 (bb.ffi::blpapi-message-num-correlation-ids msg))
    (error "multiple correlation ids in a message not supported"))
  (fli:with-dynamic-foreign-objects ((correlationid bb.ffi::blpapi-correlation-id-t :fill 0))
    (bb.ffi::blpapi-message-correlation-id msg 0 :result-pointer correlationid)
    (case (fli:foreign-slot-value correlationid 'bb.ffi::value-type)
      (0 :unset)
      (1 (fli:dereference (fli:foreign-slot-pointer (fli:foreign-slot-pointer correlationid 'bb.ffi::value) 'bb.ffi::int-value) :type :unsigned-int))
      (2 :pointer)
      (3 :autogenerated))))

#-lispworks
(defun message-correlation-id (msg)
  (unless (= 1 (bb.ffi::blpapi-message-num-correlation-ids msg))
    nil))

;; call-by-value is not supported by cl-autowrap
;; cffi-libffi could be used, but it's not easy to compile
;; I got to work (maybe) with ffi.h, ffitarget.h, and libffi-6.dll
;; retrieve from somewhere and the compiler included in Rtools
;; (setf cffi-grovel::*cc* "c:/Rtools/gcc-4.6.3/bin/gcc.exe")
;; but defining the function and required structs is still some work
;; (cl-autowrap is based on cffi-sys and doesn't define cffi objects )

#+lispworks (defvar *mailboxes* (make-hash-table :weak-kind t))

(defun process-message (msg &optional done)
  (declare (ignore done))
  (assert (member (bb.ffi::blpapi-message-type-string msg)
		  '(;; :refdata
		    "ReferenceDataResponse" "ReferenceDataPartialResponse"
		    "HistoricalDataResponse" "HistoricalDataPartialResponse"
		    "IntradayBarResponse"
		    "PortfolioDataResponse" "BeqsResponse" "PingResponse"
		    ;; :apiflds
		    "fieldResponse" "categorizedFieldResponse"
		    ;; :instruments
		    "InstrumentListResponse" "GovtListResponse" "CurveListResponse") 
		  :test #'string=))
  (let ((contents (bb.ffi::blpapi-message-elements msg)))
    (when (not (zerop (bb.ffi::blpapi-element-has-element contents "responseError" nil)))
      (warn "reponse error: TBD"))
    (let ((result (decode-element contents))
	  #+lispworks (correlation-id (message-correlation-id msg)))
      #+lispworks (when (numberp correlation-id)
		    (mp:mailbox-send (gethash correlation-id *mailboxes*) (cons result done)))
      result)))

(defun process-response (event &optional done)
  (let ((iterator (bb.ffi::blpapi-message-iterator-create event)))
    (prog1
	(loop for msg = (next-msg iterator)
	   while msg
	   collect (process-message msg done)
	   do (bb.ffi::blpapi-message-release msg))
      (bb.ffi::blpapi-message-iterator-destroy iterator))))

(defvar *ignored-events* nil)

(defun process-other-event (event type)
  (let ((iterator (bb.ffi::blpapi-message-iterator-create event)))
    (loop for msg = (next-msg iterator)
       while msg
       do (push (list (local-time:now) (message-correlation-id msg) type (decode-element (bb.ffi::blpapi-message-elements msg)))
		*ignored-events*)
       do (bb.ffi::blpapi-message-release msg))
    (bb.ffi::blpapi-message-iterator-destroy iterator)))

(defun process-event (event)
  (let ((event-type (decode-event-type (bb.ffi::blpapi-event-event-type event))))
    (case event-type
      (:response (process-response event t))
      (:partial-response (process-response event))
      (otherwise (process-other-event event event-type)))))

#+lispworks
(defun next-event ()
  "second value true when the response has been processed completely"
  (assert *session*)
  (multiple-value-bind (res event)
      (bb.ffi::blpapi-session-next-event *session* nil 0)
    (check-errors res)
    (values event (string= :response (decode-event-type (bb.ffi::blpapi-event-event-type event))))))

#-lispworks
(defun next-event ()
  "second value true when the response has been processed completely"
  (assert *session*)
  (plus-c:c-with ((event :pointer))
      (check-errors (bb.ffi:blpapi-session-next-event *session* (event plus-c:&) 0))
      (values (autowrap:wrap-pointer event 'bb.ffi:blpapi-event-t)
	      (string= :response (decode-event-type (bb.ffi:blpapi-event-event-type event))))))

(defun retrieve-response ()
  (loop for (event done) = (multiple-value-list (next-event))
     append (process-tree (process-event event))
     do (bb.ffi::blpapi-event-release event)
     until done))

#+lispworks
(defun retrieve-loop ()
  (bt:make-thread (lambda () (loop do (retrieve-response)))))