(require 'cl)
(require 'easymenu)
(require 'widget)
(defcustom marketdata-komodo-servers
'(("sbkmdrdtp07" . "sbkmdrdtp07.mdprod.dowjones.net")
("sbkmdrdtp08" . "sbkmdrdtp08.mdprod.dowjones.net"))
"List of MarketData Komodo servers that may be queried.
\nEach element is a tuple containing a name/server pair."
:type 'list
:group 'marketdata-komodo)
(defcustom marketdata-komodo-sources
'((0 . "ctf")
(1 . "utp")
(2 . "rdf")
(3 . "cta_r")
(4 . "mfds")
(501 . "idpr")
(503 . "rfh")
(505 . "NewStox"))
"List of MarketData symbol sources.
\nEach element is a tuple containing a source-id/source-name pair."
:type 'list
:group 'MarketData)
(defcustom marketdata-komodo-info
'(("http://service.marketwatch.com/ws/2006/08/dataDictionaryGateway"
. ((:name . "DataDictionary")
(:port . 8080)
(:page . "WebServiceProject/testpage.jsp")))
("http://service.marketwatch.com/ws/2006/07/marketDataGateway"
. ((:name . "MarketData")
(:port . 8080)
(:page . "WebServiceProject/testpage.jsp")))
("http://service.dowjones.com/ws/2006/11/symbologyGateway"
. ((:name . "Symbology")
(:port . 8080)
(:page . "WebServiceProject/testpage.jsp")))
("http://service.dowjones.com/ws/2007/09/quoteGateway"
. ((:name . "Quote")
(:port . 8080)
(:page . "WebServiceProject/testpage.jsp")))
("http://service.dowjones.com/ws/2007/10/timeseriesGateway"
. ((:name . "TimeSeries")
(:port . 8080)
(:page . "WebServiceProject/testpage.jsp")
(:fields . ("ticker" . ))))
)
"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 - web page port
:page - web page postfix
:fields - list of field mappings (web to regexp in form)"
:type 'list
:group 'marketdata-komodo)
(defcustom marketdata-komodo-request-timeout
30
"*Number of seconds to wait for a query response."
:type 'integer
:group 'marketdata-komodo)
(defcustom marketdata-komodo-show-output
t
"*Whether to show every response in a buffer or not (t or nil respectively)."
:type 'boolean
:group 'marketdata-komodo)
(defcustom marketdata-komodo-format-output
t
"*Whether to reformat the output xml or not (t or nil respectively)."
:type 'boolean
:group 'marketdata-komodo)
(defcustom marketdata-komodo-initial-query-history
'("sbkmdrdtp07 sbkmdrdtp08")
"*Initial list of server lists to query."
:type 'list
:group 'marketdata-komodo)
(defvar marketdata-komodo-query-history
nil
"History of `marketdata-komodo-query' query arguments.
\nInitialized with `marketdata-komodo-query-history' function.")
(defun marketdata-komodo-query-history-reset ()
"Reset `marketdata-komodo-query-history' to initial values."
(setq marketdata-komodo-query-history
(copy-list marketdata-komodo-initial-query-history)))
(defun marketdata-komodo-query-history-push (servers)
"Push SERVERS onto `marketdata-komodo-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-komodo-query-history)
(setq marketdata-komodo-query-history (remove servers marketdata-komodo-query-history)))
(push servers marketdata-komodo-query-history)))
(marketdata-komodo-query-history-reset)
(defvar marketdata-komodo-select-server-buffer-name
"*MarketData-Komodo-Select-Server*"
"Buffer name to use for select server menu.")
(defvar marketdata-komodo-process-status-buffer-name
"*MarketData-Komodo-Process-Status*"
"Buffer name to use for showing process status.")
(defvar marketdata-komodo-tmp-dir-request
(expand-file-name "~/tmp/marketdata-komodo-request")
"Temp directory to store request post files.")
(defvar marketdata-komodo-tmp-dir-response
(expand-file-name "~/tmp/marketdata-komodo-response")
"Temp directory to store komodo responses.")
(defun marketdata-komodo-output-buffer-name (server)
"Generate output buffer name."
(concat server ":" (buffer-name)))
(defun marketdata-komodo-output-file-name (buffer)
"Generate an output file name from a BUFFER name."
(concat marketdata-komodo-tmp-dir-response "/" buffer))
(defun marketdata-komodo-info (&optional item)
"Return requested komodo info for XML request based on the
SOAP header in the current buffer."
(save-excursion
(goto-char (point-min))
(let (info)
(dolist (komodo marketdata-komodo-info)
(unless info
(when (re-search-forward (car komodo) nil t)
(setq info (cdr komodo)))))
(if item
(cdr (assq item info))
info))))
(defun marketdata-komodo-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-komodo-web-service-args ()
"Return arguments for Web Service Tester from current buffer XML.
\nNote: This only returns arguments for the first request found
in the buffer XML."
(save-excursion
(goto-char (point-min))
(let (port)
(dolist (komodo marketdata-komodo-ports port)
(when (re-search-forward (car komodo) nil t)
(setq port (cdr komodo))))
)))
)
(defun marketdata-komodo-prepare-data (server port)
"Prepare post data in current buffer for request."
(let ((created (marketdata-komodo-date-offset 0))
(expires (marketdata-komodo-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-komodo-select-server ()
"Create a menu of servers the user may select from."
(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 query-history all-servers last-history last-history-servers) (setq buffer (generate-new-buffer marketdata-komodo-select-server-buffer-name))
(set-buffer buffer)
(kill-all-local-variables)
(make-local-variable 'widget-servers)
(dolist (servers marketdata-komodo-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-komodo-query-history))
(setq last-history-servers (split-string (car marketdata-komodo-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)))
(widget-insert "MarketData Komodo Query\n\n")
(widget-insert "Recent Queries:\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-komodo-query value))))
(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
:notify (lambda (widget &rest ignore)
(let ((timeout (widget-value widget)))
(setq marketdata-komodo-request-timeout (string-to-number timeout))))
(number-to-string marketdata-komodo-request-timeout))
(widget-insert "\n")
(widget-create 'push-button
:notify (lambda (&rest ignore)
(let ((servers (widget-value widget-servers)))
(kill-buffer nil)
(marketdata-komodo-query servers)))
"Submit Query")
(widget-insert " ")
(widget-create 'push-button
:notify (lambda (&rest ignore)
(kill-buffer nil)
(customize-group "marketdata-komodo"))
"Configure")
(widget-insert "\n")
(use-local-map widget-keymap)
(widget-setup)
(switch-to-buffer buffer)
(goto-char (point-min))
(widget-forward 1)
))
(defun marketdata-komodo-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-komodo-create-directory (dir)
"Delete the files in DIR, if it exists, else create it."
(when (file-exists-p dir)
(marketdata-komodo-delete-directory dir))
(unless (file-exists-p dir)
(make-directory dir)))
(defun marketdata-komodo-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-komodo-query (&optional server output)
"Submit current buffer XML as a SOAP request to a MarketData
Komodo SERVER on the appropriate port.
Requests are created in the `marketdata-komodo-tmp-dir-request'
directory. Responses are written to files in the
`marketdata-komodo-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-komodo-servers'.
If OUTPUT is nil, a buffer is opened for every response file,
otherwise, a `dired' buffer opened on the
`marketdata-komodo-tmp-dir-response' directory."
(interactive
(let ((hist (copy-list marketdata-komodo-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)
(hist marketdata-komodo-query-history))
(when (equal servers "all")
(setq servers (mapcar #'car marketdata-komodo-servers)))
(when (stringp servers)
(setq servers (split-string servers)))
(when (listp servers)
(setq server (join-strings-delimiter servers " "))
(when (member server hist)
(setq hist (remove server hist)))
(push server hist)
(setq marketdata-komodo-query-history hist))
(let ((xml-buffer (window-buffer)) status-buffer processes times dired-buffer desc port) (condition-case err
(progn
(marketdata-komodo-create-directory marketdata-komodo-tmp-dir-request)
(marketdata-komodo-create-directory marketdata-komodo-tmp-dir-response)
(dired marketdata-komodo-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-komodo-process-" server))
(buffer (marketdata-komodo-output-buffer-name server))
(file (concat marketdata-komodo-tmp-dir-request "/emacs-marketdata-komodo-buffer-" server))
cmd
args)
(when (assoc server marketdata-komodo-servers)
(setq server (cdr (assoc server marketdata-komodo-servers))))
(with-temp-buffer
(insert data)
(unless (and desc port)
(let ((info (marketdata-komodo-info)))
(setq desc (cdr (assq :name info)))
(setq port (number-to-string (cdr (assq :port info))))))
(marketdata-komodo-prepare-data server port)
(write-region nil nil file))
(setq args (concat
"\"-nv\""
" \"--tries=1\""
" \"--timeout=" (shell-quote-argument (number-to-string marketdata-komodo-request-timeout)) "\""
" \"--post-file=" (shell-quote-argument file) "\""
" \"-O\" \"" (marketdata-komodo-output-file-name buffer) "\""
" \"http://" (shell-quote-argument server)
":" (shell-quote-argument port) "\""))
(setq cmd (concat "(start-process \"" name "\" nil \"wget\" " args ")"))
(push (list (eval (read cmd)) server buffer file (current-time)) processes)
))
(setq processes (nreverse processes))
(setq status-buffer (generate-new-buffer marketdata-komodo-process-status-buffer-name))
(switch-to-buffer status-buffer)
(buffer-disable-undo status-buffer)
(dolist (lst processes)
(push (cons (process-name (car lst)) (list 0 0 0)) times))
(let ((running t))
(while running
(setq running nil)
(setq buffer-read-only nil)
(erase-buffer)
(insert (concat "MarketData Komodo Query Process Status\n\n"))
(insert (concat "Komodo: " desc " Port: " port "\n\n"))
(insert "Server Status Time\n")
(insert "-------------------------------------- ------ ---------------\n")
(dolist (lst processes)
(let* ((process (first lst))
(name (process-name process))
(server (second lst))
(status (process-status process))
(time (fifth lst))
(time-diff (cdr (assoc name times))))
(when (eq status 'run)
(setq time-diff (time-subtract (current-time) time))
(setcdr (assoc name times) time-diff)
(setq running t))
(when (> (length server) 38)
(setq server (substring server 0 38)))
(let* ((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))))
(setq time-diff (concat
(if (> hours 0)
(format "%2d:%02d:%02d.%d" hours mins secs microsecs)
(if (> mins 0)
(format " %2d:%02d.%d" mins secs microsecs)
(format " %2d.%d" secs microsecs)))))
(insert (format "%-39s %-7S %s\n" server status time-diff)))))
(setq buffer-read-only t)
(sit-for 0.1)
))
(setq buffer-read-only nil)
(insert "\nFormatting responses...")
(setq buffer-read-only t)
(sit-for 0)
(marketdata-komodo-delete-directory marketdata-komodo-tmp-dir-request)
(dolist (lst (reverse processes))
(let* ((process (first lst))
(server (second lst))
(buffer (third lst))
file)
(setq file (marketdata-komodo-rename-gzip-file (marketdata-komodo-output-file-name buffer)))
(find-file file)
(when (<= (buffer-size) font-lock-maximum-size)
(marketdata-komodo-xml-reformat))
(save-buffer)
(when output
(kill-this-buffer))
(switch-to-buffer status-buffer)
(setq buffer-read-only nil)
(insert ".")
(setq buffer-read-only t)
(sit-for 0)
))
(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)
(when output
(dired marketdata-komodo-tmp-dir-response)
(switch-to-buffer status-buffer))
)
(error
(marketdata-komodo-delete-directory marketdata-komodo-tmp-dir-request)
(dired marketdata-komodo-tmp-dir-response)
(switch-to-buffer status-buffer)
(message "%s" (error-message-string err))))))
(marketdata-komodo-select-server))
(error "This function requires Emacs version 22 or higher")))
(defun marketdata-komodo-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-komodo)