(require 'cl)
(require 'easymenu)
(require 'widget)
(defcustom marketdata-gateway-servers
'(("sbkmdpwebapi" . "sbkmdpwebapi.mdprod.dowjones.net")
("secmdpwebapi" . "secmdpwebapi.mdprod.dowjones.net")
("sbkmdwebp01" . "sbkmdwebp01.mdprod.dowjones.net")
("sbkmdwebp02" . "sbkmdwebp02.mdprod.dowjones.net")
("sbkmdwebp03" . "sbkmdwebp03.mdprod.dowjones.net")
("sbkmdwebp04" . "sbkmdwebp04.mdprod.dowjones.net")
("secmdwebp01" . "secmdwebp01.mdprod.dowjones.net")
("secmdwebp02" . "secmdwebp02.mdprod.dowjones.net")
("secmdwebp03" . "secmdwebp03.mdprod.dowjones.net")
("secmdwebp04" . "secmdwebp04.mdprod.dowjones.net"))
"List of MarketData Gateway servers that may be queried.
\nEach element is a tuple containing a name/server pair."
:type 'list
:group 'marketdata-gateway)
(defcustom marketdata-gateway-info
'(("http://service.marketwatch.com/ws/2006/08/dataDictionaryGateway" . ((:name . "DataDictionary") (:port . 9205)))
("http://service.marketwatch.com/ws/2006/07/marketDataGateway" . ((:name . "MarketData") (:port . 9206)))
("http://service.dowjones.com/ws/2006/11/symbologyGateway" . ((:name . "Symbology") (:port . 9207)))
("http://service.dowjones.com/ws/2007/09/quoteGateway" . ((:name . "Quote") (:port . 9208)))
("http://service.dowjones.com/ws/2007/10/timeseriesGateway" . ((:name . "TimeSeries") (:port . 9209))))
"List of MarketData Gateway server query patterns and info about them.
\nEach element is a tuple containing a query-pattern/info pair.
The info is an association list of named data items as follows:
\n :name - gateway name
:port - gateway port"
:type 'list
:group 'marketdata-gateway)
(defcustom marketdata-gateway-request-timeout
30
"*Number of seconds to wait for a query response."
:type 'integer
:group 'marketdata-gateway)
(defcustom marketdata-gateway-batch-size
100
"*Number of requests in a batch run."
:type 'integer
:group 'marketdata-gateway)
(defcustom marketdata-gateway-show-output
t
"*Whether to show every response in a buffer or not (t or nil respectively)."
:type 'boolean
:group 'marketdata-gateway)
(defcustom marketdata-gateway-format-output
t
"*Whether to reformat the output xml or not (t or nil respectively)."
:type 'boolean
:group 'marketdata-gateway)
(defcustom marketdata-gateway-initial-query-history
'("sbkmdpwebapi secmdpwebapi"
"sbkmdwebp01 sbkmdwebp02 sbkmdwebp03 sbkmdwebp04 secmdwebp01 secmdwebp02 secmdwebp03 secmdwebp04")
"*Initial list of server lists to query."
:type 'list
:group 'marketdata-gateway)
(defvar marketdata-gateway-query-history
nil
"History of `marketdata-gateway-query' query arguments.
\nInitialized with `marketdata-gateway-query-history' function.")
(defun marketdata-gateway-query-history-reset ()
"Reset `marketdata-gateway-query-history' to initial values."
(setq marketdata-gateway-query-history
(append marketdata-gateway-initial-query-history
(do ((servers marketdata-gateway-servers (cdr servers))
(result ""))
((not servers) (list result))
(if (cdr servers)
(setq result (concat result (caar servers) " "))
(setq result (concat result (caar servers))))))))
(defun marketdata-gateway-query-history-push (servers)
"Push SERVERS onto `marketdata-gateway-query-history' list
after removing any existing entries."
(when (stringp servers)
(setq servers (split-string servers)))
(when servers
(setq servers (join-strings-delimiter servers " "))
(when (member servers marketdata-gateway-query-history)
(setq marketdata-gateway-query-history (remove servers marketdata-gateway-query-history)))
(push servers marketdata-gateway-query-history)))
(marketdata-gateway-query-history-reset)
(defvar marketdata-gateway-menu-buffer-name
"*Marketdata-Gateway-Menu*"
"Buffer name to use for menu.")
(defvar marketdata-gateway-process-status-buffer-name
"*MarketData-Gateway-Process-Status*"
"Buffer name to use for showing process status.")
(defvar marketdata-gateway-tmp-dir-request
(expand-file-name "~/tmp/marketdata-gateway-request")
"Temp directory to store request post files.")
(defvar marketdata-gateway-tmp-dir-response
(expand-file-name "~/tmp/marketdata-gateway-response")
"Temp directory to store gateway responses.")
(defun marketdata-gateway-output-buffer-name (server)
"Generate output buffer name."
(concat server ":" (buffer-name)))
(defun marketdata-gateway-output-file-name (buffer)
"Generate an output file name from a BUFFER name."
(concat marketdata-gateway-tmp-dir-response "/" buffer))
(defun marketdata-gateway-info (&optional item)
"Return requested gateway info for XML request based on the
SOAP header in the current buffer."
(save-excursion
(goto-char (point-min))
(let (info)
(dolist (gateway marketdata-gateway-info)
(unless info
(when (re-search-forward (car gateway) nil t)
(setq info (cdr gateway)))))
(if item
(cdr (assq item info))
info))))
(defun marketdata-gateway-date-offset (&optional offset)
"Return current UTC date plus OFFSET seconds."
(unless offset
(setq offset 0))
(substring
(shell-command-to-string
(concat
"TZ=UTC date -d \"" (shell-quote-argument (number-to-string offset))
" sec\" \"+%Y-%m-%dT%H:%M:%SZ\""
)) 0 -1))
(defun marketdata-gateway-prepare-data (server port)
"Prepare post data in current buffer for request."
(let ((created (marketdata-gateway-date-offset 0))
(expires (marketdata-gateway-date-offset 5)))
(save-excursion
(goto-char (point-min))
(while (re-search-forward "<wsa:To>.*</wsa:To>" nil t)
(replace-match (concat "<wsa:To>http://" server ":" port "</wsa:To>")))
(goto-char (point-min))
(while (re-search-forward "#{created}" nil t)
(replace-match created))
(goto-char (point-min))
(while (re-search-forward "#{expires}" nil t)
(replace-match expires))
)))
(defun marketdata-gateway-menu (&optional server batch)
"Create a menu of options the user may select from.
\nIf SERVER is non-nil, it sets the default servers to query.
If BATCH is non-nil, it is passed on to `marketdata-gateway-query' calls."
(interactive)
(defun list-to-string (lst)
"Return space delimited version of items in LST."
(do ((x lst (cdr x))
result)
((not x) (apply 'concat (reverse result)))
(if (cdr x)
(push (concat (car x) " ") result)
(push (car x) result))))
(let (buffer (post-buffer-name (buffer-name)) query-history all-servers last-history last-history-servers) (setq buffer (generate-new-buffer marketdata-gateway-menu-buffer-name))
(set-buffer buffer)
(kill-all-local-variables)
(make-local-variable 'widget-servers)
(when server
(marketdata-gateway-query-history-push server))
(dolist (servers marketdata-gateway-query-history)
(pushnew servers query-history :test 'string=)
(dolist (server (split-string servers))
(pushnew server all-servers :test 'string=)))
(setq query-history (nreverse query-history))
(setq all-servers (sort all-servers 'string-lessp))
(setq last-history (car marketdata-gateway-query-history))
(setq last-history-servers (split-string (car marketdata-gateway-query-history)))
(make-local-variable 'widget-checkboxes)
(setq widget-checkboxes nil)
(dolist (server all-servers)
(let ((name (intern (concat "widget-checkbox-" server))))
(make-local-variable name)
(push name widget-checkboxes)))
(make-local-variable 'widget-batch)
(setq widget-batch 1)
(widget-insert "MarketData Gateway Query\n\n")
(widget-insert (concat "Post Buffer: " post-buffer-name "\n\n"))
(if batch
(progn
(widget-insert (format "Recent Queries (batch: %s):\n\n" batch))
(widget-insert " ")
(widget-create 'push-button
:notify `(lambda (&rest ignore)
(kill-buffer nil)
(marketdata-gateway-menu ,server nil))
"Normal Query"))
(progn
(widget-insert "Recent Queries (normal):\n\n")
(widget-insert " ")
(widget-create 'push-button
:notify `(lambda (&rest ignore)
(kill-buffer nil)
(marketdata-gateway-menu ,server marketdata-gateway-batch-size))
"Batch Query")))
(widget-insert "\n\n")
(do ((servers query-history (cdr servers))
(cnt 1 (1+ cnt)))
((or (not servers) (> cnt 10)))
(widget-insert " ")
(widget-create 'push-button
:value (car servers)
:notify `(lambda (widget &rest ignore)
(let ((value (widget-value widget)))
(kill-buffer nil)
(marketdata-gateway-query value ,batch))))
(widget-insert "\n"))
(widget-insert "\n")
(widget-insert "Select Servers:\n\n")
(widget-insert " ")
(widget-create 'push-button
:notify `(lambda (&rest ignore)
(widget-value-set widget-servers ,(list-to-string all-servers))
(dolist (widget (list ,@widget-checkboxes))
(widget-value-set widget t))
(widget-setup))
"All")
(widget-insert " ")
(widget-create 'push-button
:notify `(lambda (&rest ignore)
(widget-value-set widget-servers "")
(dolist (widget (list ,@widget-checkboxes))
(widget-value-set widget nil))
(widget-setup))
"None")
(widget-insert "\n\n")
(dolist (server all-servers)
(widget-insert " ")
(let ((widget
(widget-create
'checkbox
:notify (lambda (widget &rest ignore)
(let ((value (widget-value widget))
(server (widget-get widget :server))
(servers (split-string (widget-value widget-servers))))
(if value
(unless (member server servers)
(widget-value-set widget-servers (list-to-string (sort (cons server servers) 'string-lessp))))
(widget-value-set widget-servers (list-to-string (remove server servers))))
(widget-setup)))
(member server last-history-servers))))
(widget-put widget :server server)
(widget-insert (concat " " server "\n"))
(funcall `(lambda () (setq ,(intern (concat "widget-checkbox-" server)) widget)))))
(widget-insert "\n")
(widget-insert "Servers: ")
(setq widget-servers
(widget-create 'editable-field
last-history))
(widget-insert "\n")
(widget-insert "Timeout: ")
(widget-create 'editable-field
:size 10
:notify (lambda (widget &rest ignore)
(let ((timeout (widget-value widget)))
(setq marketdata-gateway-request-timeout (string-to-number timeout))))
(number-to-string marketdata-gateway-request-timeout))
(widget-insert " ")
(widget-insert "Batch Size: ")
(widget-create 'editable-field
:size 10
:notify (lambda (widget &rest ignore)
(let ((batch (widget-value widget)))
(setq marketdata-gateway-batch-size (string-to-number batch))))
(number-to-string marketdata-gateway-batch-size))
(widget-insert "\n\n")
(widget-create 'push-button
:notify (lambda (&rest ignore)
(let ((servers (widget-value widget-servers)))
(kill-buffer nil)
(marketdata-gateway-query servers)))
"Submit Query")
(widget-insert " ")
(widget-create 'push-button
:notify (lambda (&rest ignore)
(let ((servers (widget-value widget-servers)))
(kill-buffer nil)
(marketdata-gateway-query servers marketdata-gateway-batch-size)))
"Submit Batch")
(widget-insert " ")
(widget-create 'push-button
:notify (lambda (&rest ignore)
(kill-buffer nil)
(customize-group "marketdata-gateway"))
"Configure")
(widget-insert " ")
(widget-create 'push-button
:notify `(lambda (&rest ignore)
(kill-buffer nil)
(marketdata-gateway-query-history-reset)
(marketdata-gateway-menu ,server ,batch))
"Reset History")
(widget-insert "\n")
(use-local-map widget-keymap)
(widget-setup)
(switch-to-buffer buffer)
(goto-char (point-min))
(widget-forward 2)
))
(defun marketdata-gateway-delete-directory (dir)
"Delete all files in DIR and DIR itself."
(when (file-exists-p dir)
(dolist (file (directory-files dir t))
(unless (string-match "^\\." (file-name-nondirectory file))
(delete-file file)))))
(defun marketdata-gateway-create-directory (dir)
"Delete the files in DIR, if it exists, else create it."
(when (file-exists-p dir)
(marketdata-gateway-delete-directory dir))
(unless (file-exists-p dir)
(make-directory dir)))
(defun marketdata-gateway-rename-gzip-file (file)
"Test if FILE is a GZIP file, and if it is, rename it with a
`.gz' extension.
\nReturn the new file name."
(let ((new-file file))
(when (string-match
"gzip compressed data"
(shell-command-to-string (concat "file \"" file "\"")))
(setq new-file (concat file ".gz"))
(rename-file file new-file))
new-file))
(defun join-strings-delimiter (lst &optional delim)
"Convert LST of strings into a single string.
\nUse optional DELIM as a delimiter."
(unless delim
(setq delim ""))
(reduce #'(lambda (x y) (concat x delim y)) lst))
(defun marketdata-gateway-format-time (time)
"Return TIME formatted as a string.
TIME is either a list in the format returned by `current-time' or
a floating point number as follows:
(SECONDS-HI16BITS SECONDS-LOW16BITS MICROSECONDS)
SECONDS.MICROSECONDS"
(let (total-seconds
microsecs)
(if (listp time)
(setq total-seconds (+ (* (first time) 65536) (second time))
microsecs (third time))
(setq total-seconds (truncate time)
microsecs (* (- time total-seconds) 1000000)))
(let* ((hours (floor (/ total-seconds 3600)))
(mins (floor (/ (- total-seconds (* hours 3600)) 60)))
(secs (- total-seconds (* hours 3600) (* mins 60)))
(microsecs-string (substring (concat (number-to-string microsecs) "000") 0 3))
(time-string (concat
(if (> hours 0)
(format "%2d:%02d:%02d.%s" hours mins secs microsecs-string)
(if (> mins 0)
(format " %2d:%02d.%s" mins secs microsecs-string)
(format " %2d.%s" secs microsecs-string))))))
time-string)))
(defun marketdata-gateway-query (&optional server batch)
"Submit current buffer XML as a SOAP request to a MarketData
Gateway SERVER on the appropriate port.
Requests are created in the `marketdata-gateway-tmp-dir-request'
directory. Responses are written to files in the
`marketdata-gateway-tmp-dir-response' directory.
If SERVER is nil, the user is prompted for one or a list of them,
with history available and seeded with
`marketdata-gateway-servers'.
If BATCH is non-nil, a batch test is performed where each server
is queried BATCH number of times. If BATCH < 1, then the test is
run until canceled (with \\[keyboard-quit]).
If `marketdata-gateway-show-output' is t, a buffer is opened for
every response file, otherwise, a `dired' buffer opened on the
`marketdata-gateway-tmp-dir-response' directory.
If `marketdata-gateway-format-output' is t, all output xml is
formatted to make it easier for human consumption."
(interactive
(let ((hist (copy-list marketdata-gateway-query-history)))
(list (read-from-minibuffer "Server(s) to query: "
"" nil nil
'hist))))
(if (>= emacs-major-version 22)
(if (and server (not (equal server "")) (not (equal server '(""))))
(let ((servers server))
(when (equal servers "all")
(setq servers (mapcar #'car marketdata-gateway-servers)))
(when (stringp servers)
(setq servers (split-string servers)))
(marketdata-gateway-query-history-push servers)
(let ((xml-buffer (window-buffer)) status-buffer processes times batches recents averages dired-buffer desc port) (condition-case err
(progn
(marketdata-gateway-create-directory marketdata-gateway-tmp-dir-request)
(marketdata-gateway-create-directory marketdata-gateway-tmp-dir-response)
(unless batch
(dired marketdata-gateway-tmp-dir-response)
(setq dired-buffer (current-buffer)))
(dolist (server servers)
(set-buffer xml-buffer)
(message "Querying server: %s" server)
(let ((data (buffer-substring-no-properties (point-min) (point-max)))
(name (concat "marketdata-gateway-process-" server))
(buffer (marketdata-gateway-output-buffer-name server))
(file (concat marketdata-gateway-tmp-dir-request "/emacs-marketdata-gateway-buffer-" server))
cmd
args)
(when (assoc server marketdata-gateway-servers)
(setq server (cdr (assoc server marketdata-gateway-servers))))
(with-temp-buffer
(insert data)
(unless (and desc port)
(let ((info (marketdata-gateway-info)))
(setq desc (cdr (assq :name info)))
(setq port (number-to-string (cdr (assq :port info))))))
(marketdata-gateway-prepare-data server port)
(write-region nil nil file))
(setq args (concat
"\"-nv\""
" \"--tries=1\""
" \"--timeout=" (shell-quote-argument (number-to-string marketdata-gateway-request-timeout)) "\""
" \"--post-file=" (shell-quote-argument file) "\""
" \"-O\" \"" (marketdata-gateway-output-file-name buffer) "\""
" \"http://" (shell-quote-argument server)
":" (shell-quote-argument port) "\""))
(setq cmd (concat "(start-process \"" name "\" nil \"wget\" " args ")"))
(push (cons name (list (eval (read cmd)) server buffer file (current-time) cmd)) processes)
))
(setq processes (nreverse processes))
(setq status-buffer (generate-new-buffer marketdata-gateway-process-status-buffer-name))
(switch-to-buffer status-buffer)
(buffer-disable-undo status-buffer)
(dolist (name (mapcar 'car processes))
(push (cons name (list 0 0 0)) times))
(when batch
(dolist (name (mapcar 'car processes))
(push (cons name 0) batches)
(push (cons name 0) recents)
(push (cons name 0) averages)))
(let ((running t) (batch-count (when batch
(if (< batch 1)
"infinite"
(number-to-string batch))))) (while running
(setq running nil)
(setq buffer-read-only nil)
(erase-buffer)
(insert (concat "MarketData Gateway Query Process Status\n\n"))
(if batch
(progn
(insert (concat "Gateway: " desc " Port: " port " Batch Count: " batch-count
" Timeout: " (number-to-string marketdata-gateway-request-timeout) "\n\n"))
(insert "Server Status Request Time Recent Time Average Time Batch\n")
(insert "-------------------------------------- ------ ------------ ------------ ------------ -----\n"))
(progn
(insert (concat "Gateway: " desc " Port: " port
" Timeout: " (number-to-string marketdata-gateway-request-timeout) "\n\n"))
(insert "Server Status Request Time\n")
(insert "-------------------------------------- ------ ------------\n")))
(dolist (alst processes)
(let* ((lst (cdr alst))
(name (car alst))
(process (first lst))
(server (second lst))
(status (process-status process))
(time (fifth lst))
(time-diff (cdr (assoc name times)))
(run (when batch (cdr (assoc name batches))))
(avg (when batch (cdr (assoc name averages))))
(microsecs (third time-diff))
(total-seconds (+ (* (first time-diff) 65536) (second time-diff)))
(hours (floor (/ total-seconds 3600)))
(mins (floor (/ (- total-seconds (* hours 3600)) 60)))
(secs (- total-seconds (* hours 3600) (* mins 60))))
(when (and batch (< run batch) (not (eq status 'run)))
(setcdr (assoc name batches) (1+ run))
(let ((mic microsecs)
(sec total-seconds))
(while (>= mic 1)
(setq mic (/ mic 10.0)))
(setq sec (+ sec mic))
(setcdr (assoc name recents) sec)
(if (= run 0)
(setq avg sec)
(setq avg (/ (+ (* avg run) sec) (1+ run))))
(setcdr (assoc name averages) avg))
(let ((buffer (third lst))
(file (fourth lst))
(cmd (sixth lst)))
(setq time (current-time))
(setcdr alst (list (eval (read cmd)) server buffer file time cmd))
(setq status 'run)))
(when (eq status 'run)
(setcdr (assoc name times) (time-subtract (current-time) time))
(setq running t))
(let ((server (if (> (length server) 38)
(setq server (substring server 0 38))
server))
(time-disp (marketdata-gateway-format-time time-diff))
(rec-disp (when batch (marketdata-gateway-format-time (cdr (assoc name recents)))))
(avg-disp (when batch (marketdata-gateway-format-time avg))))
(if batch
(insert (format "%-39s %-7S %s %s %s %5d\n" server status time-disp rec-disp avg-disp run))
(insert (format "%-39s %-7S %s\n" server status time-disp))))))
(setq buffer-read-only t)
(sit-for 0.1)
))
(setq buffer-read-only nil)
(if batch
(insert "\n")
(insert "\nFormatting responses..."))
(setq buffer-read-only t)
(sit-for 0)
(marketdata-gateway-delete-directory marketdata-gateway-tmp-dir-request)
(unless batch
(dolist (alst (reverse processes))
(let* ((lst (cdr alst))
(process (first lst))
(buffer (third lst))
file)
(setq file (marketdata-gateway-rename-gzip-file (marketdata-gateway-output-file-name buffer)))
(find-file file)
(when marketdata-gateway-format-output
(when (<= (buffer-size) font-lock-maximum-size)
(marketdata-gateway-xml-reformat)))
(save-buffer)
(unless marketdata-gateway-show-output
(kill-this-buffer))
(switch-to-buffer status-buffer)
(setq buffer-read-only nil)
(insert ".")
(setq buffer-read-only t)
(sit-for 0)
)))
(unless batch
(kill-buffer dired-buffer))
(switch-to-buffer status-buffer)
(setq buffer-read-only nil)
(insert "done\n")
(setq buffer-read-only t)
(delete-other-windows)
(unless (or marketdata-gateway-show-output batch)
(dired marketdata-gateway-tmp-dir-response)
(switch-to-buffer status-buffer))
)
(error
(marketdata-gateway-delete-directory marketdata-gateway-tmp-dir-request)
(unless batch
(dired marketdata-gateway-tmp-dir-response))
(switch-to-buffer status-buffer)
(message "%s" (error-message-string err))))))
(marketdata-gateway-menu server batch))
(error "This function requires Emacs version 22 or higher")))
(defun marketdata-gateway-query-batch (&optional server batch)
"Run `marketdata-gateway-query' in batch mode.
\nIf BATCH is nil, `marketdata-gateway-batch-size' is used."
(interactive
(let ((hist (copy-list marketdata-gateway-query-history)))
(list (read-from-minibuffer "Server(s) to query: "
"" nil nil
'hist))))
(if batch
(marketdata-gateway-query server batch)
(marketdata-gateway-query server marketdata-gateway-batch-size)))
(defun marketdata-gateway-xml-reformat ()
"Reformat XML buffer.
\nConvert poorly formatted XML into something better."
(xml-mode)
(let ((xml-eol "[ \t]*\n[ \t]*")
(xml-tag-end-regexp ">")
(xml-close-tag-regexp "</")
(xml-block-regexp "<[^>]*>[^<]*</[^>]*>"))
(save-excursion
(save-match-data
(goto-char (point-min))
(while (re-search-forward xml-eol nil t)
(replace-match "" nil nil))
(goto-char (point-min))
(while (re-search-forward xml-tag-end-regexp nil t)
(insert "\n")
(when (and
(looking-at xml-block-regexp)
(not (looking-at xml-close-tag-regexp)))
(re-search-forward xml-block-regexp nil t)
(forward-char -1)))
(indent-region (point-min) (point-max))
))))
(provide 'marketdata-gateway)