;; -*- emacs-lisp -*- ;; ;; Allow a user to send a buffer (or portion of a buffer) of SQL to ;; the skyserver, inserting the result into another emacs buffer ;; ;; Robert Lupton (rhl@astro.princeton.edu) February 2002 ;; (defvar skyserver-version "$Name: v1_47 $" "Version of Robert Lupton's emacs SkyServer mode") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defgroup skyserver nil "Group for skyserver customisation" :prefix 'skyserver :group 'external) (defgroup skyserver-general nil "Control various general aspects of how skyserver-mode should behave" :group 'skyserver) (defgroup skyserver-database nil "Select which databases to use, whether they require passwords, and so forth. " :group 'skyserver) (defgroup skyserver-sql nil "Control how skyserver mode should handle SQL and Transact-SQL" :group 'skyserver) (defgroup skyserver-proxlist nil "Configure how proxlist queries should be handled" :group 'skyserver) (defgroup skyserver-casjobs nil "Configure submitting queries via the casJobs system" :group 'skyserver) (defgroup skyserver-access nil "Configure how emacs talks to the skyserver" :group 'skyserver) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; All customisation variables are now at the end of the file, so as ;; to allow skyserver-database-list to call skyserver-set-databases ;; ;; Try to load bigint.el ;; (if (and (not (featurep 'bigint)) (not (load "bigint" t))) (progn (message (concat "Failed to load bigint; " "skyserver mode won't be able to manipulate 64-bit ints")) (sleep-for 1))) ;; ;; Here's the main user interface routine ;; (defun skyserver-mode (&optional arg) "En/disable Skyserver mode. In this mode, you can send queries directly from the current buffer to an SDSS skyserver, returning the results in another buffer. Each output buffer is associated with a separate query to the skyserver, so you may have more than one query current at a time. Commands: skyserver-submit-current-query (\\[skyserver-submit-current-query]) Send query under cursor to the skyserver; with a prefix argument prompt for name of output buffer. skyserver-submit-buffer (\\[skyserver-submit-buffer]) Send current buffer to the skyserver; with a prefix argument prompt for name of output buffer. skyserver-submit-region (\\[skyserver-submit-region]) Send current region to the skyserver; with a prefix argument prompt for name of output buffer. skyserver-submit-sql-sync (\\[skyserver-submit-sql-sync]) Prompt for and then send a query to the skyserver. The current output buffer is not used. skyserver-show-output (\\[skyserver-show-output]) Switch to the output buffer; with a prefix argument, display it in another window. In the output window, this key is bound to skyserver-show-query which switches to the (surprise!) query window. skyserver-show-output-end (\\[skyserver-show-output-end]) Display the end of the output buffer; chiefly useful for seeing SQL error messages. skyserver-table (\\[skyserver-table]) Retrieve the schema for the table name near point; with a prefix argument, only return columns that match a (restricted) regexp. If you omit the table name, list all system tables. skyserver-list-processes (\\[skyserver-list-processes]) List all active queries skyserver-delete-process (\\[skyserver-delete-process]) Kill the skyserver process associated with a buffer skyserver-set-database Set the database where queries should be run skyserver-version (\\[skyserver-version]) Retrieve the skyserver version information. skyserver-help (\\[skyserver-help]) Ask your browser to display the skyserver help pages skyserver-show-symbol-table (\\[skyserver-show-symbol-table]) Display emacs' idea of the values of @variables; with a prefix-argument show the raw and expanded values. (reset with \"\\C-c\\C-r\" in the \"*skyServer Variables\" buffer) skyserver-send-mouse-url-to-browser (\\[skyserver-send-mouse-url-to-browser]) Send url under mouse to your browser (bound in results buffer; skyserver-use-password Connect via password-protected URL skyserver-user Login name for password-protected URL also bound to mouse button-2) Variables: skyserver-database-name Human-readable name of database (optional) skyserver-send-url Command to send URL to server skyserver-hook Hook function for skyserver mode skyserver-readonly-results Make output buffers readonly? skyserver-always-use-bigint Rewrite the query to use count_big and bigint to avoid 2^31-row problems? skyserver-check-query Perform some simple syntax checks on query before submission skyserver-beep Beep when a query completes skyserver-allow-overwrite Allow the output of queries to overwrite skyserver-fake-tsql Substitute @constants into the query, a little like Transact-SQL's constants skyserver-pretty-format Cleanup the output a little, in particular replacing commas with spaces skyserver-default-output-buffer Default output buffer skyserver-output-buffer Output buffer (buffer local variable) Menus: If you have easymenu loaded a menu will be available; see the manual for a way to add entries to select your favourite databases. You might want to add the following to your .emacs file: (autoload 'skyserver-mode \"skyserver\" \"Interact with the SDSS skyserver\" t) (add-hook 'sql-mode-hook '(lambda () (skyserver-mode t) (skyserver-font-lock-add-keywords) (setq font-lock-keywords-case-fold-search t) (font-lock-mode t))) And maybe something like (add-hook 'skyserver-hook '(lambda () (setq skyserver-pretty-format t) )) A better alternative to using a hook is to use emacs' customize command, available via the Skysrvr menu. The URL that submits your query is to be found in buffer (skyserver-formatting-buffer) a single undo in this buffer will show you the query in human-readable form as sent to the server; another undo will show the raw query. If you want to use my bigint mode (strongly recommended as it allows skyserver mode's Transact-SQL emulator to work around emacs' limitations; see the manual for details) you need to ensure that (load \"bigint\") succeeeds. " (interactive "P") (set (make-variable-buffer-local 'skyserver-mode) (if (null arg) (not skyserver-mode) (> (prefix-numeric-value arg) 0))) (make-variable-buffer-local 'skyserver-proxlist) (make-variable-buffer-local 'skyserver-proxlist-search) (make-variable-buffer-local 'skyserver-proxlist-qclass) (make-variable-buffer-local 'skyserver-proxlist-qselect) (make-variable-buffer-local 'skyserver-proxlist-radius) (make-variable-buffer-local 'skyserver-temp-filename) (make-variable-buffer-local 'skyserver-writing-to-file) (make-variable-buffer-local 'skyserver-mode-line-string) (if skyserver-database-name (skyserver-set-mode-line-string (not (skyserver-buffer-is-query)))) (or (assq 'skyserver-mode minor-mode-alist) (setq minor-mode-alist (cons (list 'skyserver-mode 'skyserver-mode-line-string) minor-mode-alist))) ;; ;; Create our own key modemap ;; (if (not skyserver-mode-map) (setq skyserver-mode-map (make-sparse-keymap))) (use-local-map skyserver-mode-map) (skyserver-define-menu skyserver-mode-map) (define-key skyserver-mode-map "\C-c\C-b" 'skyserver-submit-buffer) (define-key skyserver-mode-map "\C-c\C-c" 'skyserver-submit-current-query) (define-key skyserver-mode-map "\C-c<" 'skyserver-casjobs-return-table) (define-key skyserver-mode-map "\C-c>" 'skyserver-casjobs-submit-current-query-long) (define-key skyserver-mode-map "\C-c\C-p" 'skyserver-show-query-plan) (define-key skyserver-mode-map "\C-c\C-d" 'skyserver-set-database-by-name) (define-key skyserver-mode-map "\C-c\C-q" 'skyserver-casjobs-set-target-and-queue) (define-key skyserver-mode-map "\C-c\C-r" 'skyserver-submit-region) (define-key skyserver-mode-map "\C-c\C-s" 'skyserver-submit-buffer) (define-key skyserver-mode-map "\C-c:" 'skyserver-submit-sql-sync) (define-key skyserver-mode-map "\C-c\C-e" 'skyserver-show-output-end) (define-key skyserver-mode-map "\C-c\C-f" 'skyserver-show-output) (define-key skyserver-mode-map "\C-c\C-g" 'skyserver-delete-process) (define-key skyserver-mode-map "\C-c\C-h" 'skyserver-help) (define-key skyserver-mode-map "\C-c\C-l" '(lambda (show-this-query) "List skyserver processes" (interactive "P") (if show-this-query (skyserver-casjobs-show-status nil nil t) (skyserver-list-processes (buffer-name (current-buffer)))))) (define-key skyserver-mode-map "\C-c\C-j" 'skyserver-casjobs-list-queries) (define-key skyserver-mode-map "\C-cs" 'skyserver-show-symbol-table) (define-key skyserver-mode-map "\C-c\C-t" 'skyserver-table) (define-key skyserver-mode-map "\C-c\C-v" 'skyserver-version) (define-key skyserver-mode-map "\e\C-a" 'skyserver-beginning-of-defun) (define-key skyserver-mode-map "\e{" 'skyserver-beginning-of-defun) (define-key skyserver-mode-map "\e\C-e" 'skyserver-end-of-defun) (define-key skyserver-mode-map "\e}" 'skyserver-end-of-defun) (define-key skyserver-mode-map "\e\C-@" 'skyserver-mark-sexp) (define-key skyserver-mode-map (if skyserver-xemacs-p "\e\C- " '[27 67108896]) 'skyserver-mark-sexp) ; "\e\C- " doesn't seem to work in fsfemacs ;; (set (make-variable-buffer-local 'comment-start-skip) "/\\* *\\|-- *") (set (make-variable-buffer-local 'comment-start) " -- ") ;; (add-hook 'kill-emacs-hook 'skyserver-kill-all-mortal-files) ;; (run-hooks 'skyserver-hook)) ;; ;; A mode for clients such as job listings ;; (defun skyserver-client-mode (&optional arg) "En/disable Skyserver Client mode." (interactive "P") (set (make-variable-buffer-local 'skyserver-client-mode) (if (null arg) (not skyserver-client-mode) (> (prefix-numeric-value arg) 0))) (or (assq 'skyserver-client-mode minor-mode-alist) (setq minor-mode-alist (cons (list 'skyserver-client-mode " SkysrvrClient") minor-mode-alist))) (if (not skyserver-client-mode-map) (if nil (setq skyserver-client-mode-map (make-sparse-keymap)) (set (make-local-variable 'skyserver-client-mode-map) (make-sparse-keymap)))) (use-local-map skyserver-client-mode-map) (define-key skyserver-client-mode-map "q" 'bury-buffer) (define-key skyserver-client-mode-map "\C-c\C-j" 'skyserver-casjobs-list-queries) (define-key skyserver-client-mode-map "\C-cs" 'skyserver-show-symbol-table) (define-key skyserver-client-mode-map "\C-c\C-t" 'skyserver-table) (define-key skyserver-client-mode-map "\C-c\C-v" 'skyserver-version) (skyserver-define-menu skyserver-client-mode-map)) ;; (defun skyserver-define-menu (map) "" (interactive) ;; ;; Define the elements of skyserver-database-list as accessible databases, ;; and prepare to declare them to easymenu. ;; ;; There has to be an easier way to do the latter than building a function! ;; (let ( (basename "skyserver-set-database") (database-list (skyserver-get-param 'names)) (easy-menu-list (list ["" nil t])) (i 0) procname name host path ) (while database-list (setq name (car database-list)) (setq database-list (cdr database-list)) (setq host (skyserver-get-param name 'host)) (setq path (skyserver-get-param name 'path)) (setq procname (format "%s-%d" basename (setq i (1+ i)))) (eval `(defun ,(intern procname) () "" (interactive) (let ( save ) (setq save (if (and (stringp skyserver-select-database-is-sticky) (string-equal skyserver-select-database-is-sticky "only-this-buffer")) "local" (if (y-or-n-p (concat "Changed database to " ,name " (" ,host "/" ,path "); set as default?")) skyserver-select-database-is-sticky "local"))) (message (skyserver-set-database ,name save))))) (setq easy-menu-list (append easy-menu-list (list (vector (if (string= (concat name host path) "") "" (format "%-15s %s/%s" name host path)) (intern procname) t)) )) ) (eval `(defun skyserver-add-hosts-to-menu () "Declare the databases in skyserver-database-list to easymenu" (interactive) (list ,@easy-menu-list))) ) ;; Add easymenu if loaded (if (featurep 'easymenu) (let ( (menu) ) (defun skyserver-customize () "Switch to the skyserver customisation buffer" (interactive) (customize-group 'skyserver)) (defun skyserver-proxlist-customize () "Switch to the skyserver customisation buffer" (interactive) (customize-group 'skyserver-proxlist)) (setq menu '("Skysrvr" "-------" )) (let ( (db-menu '("Choose Database")) ) (if (fboundp 'skyserver-add-hosts-to-menu) (setq db-menu (append db-menu (skyserver-add-hosts-to-menu)))) (setq menu (append menu (list db-menu)))) (setq menu (append menu (skyserver-proxlist-menu))) (setq menu (append menu '( ["Customise " skyserver-customize t] ["Emacs \"T-SQL\" " skyserver-toggle-fake-tsql :style toggle :selected skyserver-fake-tsql] "-------" ["Submit query " skyserver-submit-current-query t] ["Submit buffer " skyserver-submit-buffer t] ["Submit long query " skyserver-casjobs-submit-current-query-long (skyserver-casjobs-server)] ["Show plan" skyserver-show-query-plan t] ["Return table " skyserver-casjobs-return-table (skyserver-casjobs-server)] ["List processes " skyserver-list-processes t] ["Show job status " (lambda () (interactive) (skyserver-casjobs-show-status nil nil t)) (and skyserver-jobId (skyserver-casjobs-server))] ["List jobs " skyserver-casjobs-list-queries (skyserver-casjobs-server)] ["Set target/queue " skyserver-casjobs-set-target-and-queue (skyserver-casjobs-server)] ["Delete process " skyserver-delete-process t] "-------" ;;["Show table schema " skyserver-table t]; fails to show keys ["Show table schema " skyserver-table :keys 'skyserver-table] ["Show symbol table " skyserver-show-symbol-table t] ["Reset symbol table " skyserver-reset-symbol-table t] ["Show output " skyserver-show-output t] ["Show output end " skyserver-show-output-end t] ))) (setq menu (append menu '( "-------" ["Reset password " skyserver-reset-passwd t] ["Version " skyserver-version t] ["Help " skyserver-help t] ["Submitted Query " skyserver-show-submitted t] ))) (if (boundp 'sql-mode-menu) (easy-menu-remove sql-mode-menu)) (easy-menu-define Skyserver-menu map "Skyserver menu" menu) (easy-menu-add Skyserver-menu map) ))) ;; (defun skyserver-proxlist-menu () (let ( (prox-menu (list "Proxlist Queries")) (search-menu (list "Search type")) (class-menu (list "Object class to return")) (select-menu (list "Returned properties")) (radius-menu (list "Match radius")) ) (setq search-menu (append search-menu (list ["All" (setq skyserver-proxlist-search "all") t] ["Nearest" (setq skyserver-proxlist-search "nearest") t]))) (setq class-menu (append class-menu (list ["Everything" (setq skyserver-proxlist-qclass "everything") t] ["Galaxies" (setq skyserver-proxlist-qclass "galaxy") t] ["Stars" (setq skyserver-proxlist-qclass "star") t]))) (setq select-menu (append select-menu (list ["Count only" (setq skyserver-proxlist-qselect "count") t] ["URL to obj" (setq skyserver-proxlist-qselect "url") t] ["Tiny (ra,dec,id,type,url)" (setq skyserver-proxlist-qselect "tiny") t] ["Small (>10 fields)" (setq skyserver-proxlist-qselect "small") t] ["Medium (>20 fields)" (setq skyserver-proxlist-qselect "medium") t] ["Large (>300 fields)" (setq skyserver-proxlist-qselect "large") t]))) (defun skyserver-proxlist-set-radius () "" (interactive) (let ( (radstr (read-string "Radius (arcmin) " (format "%g" skyserver-proxlist-radius))) ) (if (string-match "^[0-9]+\\(\.[0-9]*\\)?\\([eE][-+]?[0-9]+\\)?$" radstr) (setq skyserver-proxlist-radius (string-to-number radstr)) (error (format "%s is not a number" radstr))))) (setq prox-menu (append prox-menu (list ["Save parameters in buffer" skyserver-proxlist-insert-values t]))) (setq prox-menu (append prox-menu (list search-menu))) (setq prox-menu (append prox-menu (list class-menu))) (setq prox-menu (append prox-menu (list select-menu))) (setq prox-menu (append prox-menu (list ["Match radius (arcmin)" skyserver-proxlist-set-radius t]))) (list prox-menu))) ;; ;; (defun skyserver-database-name (&optional name) "Return NAME if non-nil, or database-name if bound, or, failing that, skyserver-database-name" (interactive) (cond (name name) ((and (boundp 'database-name) database-name) database-name) (t skyserver-database-name))) (defun skyserver-database-fullname () "Return a full database name, including e.g. the casjobs target" (let ( (name (skyserver-database-name)) ) (if (skyserver-casjobs-server) (setq name (concat name "[" skyserver-casjobs-target "]"))) name)) ;; ;; Select a database ;; (defun skyserver-set-databases (symb val) (if (not (boundp 'skyserver-loading-lisp)) (let ( (list val) many-default default) (while list (setq entry (car list)) (setq list (cdr list)) (if (nth 1 entry) ;default (if default (progn (setq many-default t) (setq default (concat default " and \"" (nth 0 entry) "\""))) (setq default (concat "\"" (nth 0 entry) "\""))))) (if many-default (error (concat "You may have only one default database, but you chose " default))))) ;; Actually save the value (set-default symb val) ;; Set default database (let ( name (database-list (skyserver-get-param 'names)) ) (while database-list (setq name (car database-list)) (setq database-list (cdr database-list)) (if (skyserver-get-param name 'is-default) (let ( (save (if (boundp 'skyserver-loading-lisp) nil skyserver-select-database-is-sticky)) ) (skyserver-set-database name save) (setq database-list nil)))) ;break loop )) (defun skyserver-set-database-by-name (&optional set-default) "Select the current database given its name. With a prefix argument, make the chosen database the default." (interactive "P") (let ( (save (if set-default skyserver-select-database-is-sticky "local")) ) (message (concat (skyserver-set-database nil save) (if (not (equal "local" save)) " (set as default)"))))) ;; ;; Search the skyserver-database-list list. ;; (defun skyserver-get-param (desired-name &optional field no-error) "Return a property FIELD (e.g. 'host) of a named database; if field is nil return a list of all the properties; if it's 'get, return the list element itself. If the name is 'names, return a list of database names. It is usually an error to ask for a non-existent database but if NO-ERROR is t, just return 'error. See skyserver-set-param to set a parameter " (let ( (databases skyserver-database-list) val j found-db entry default name host db no-passwd) (while databases (setq entry (car databases)) (setq databases (cdr databases)) (setq j -1) (setq name (nth (setq j (1+ j)) entry)) (setq default (nth (setq j (1+ j)) entry)) (setq host (nth (setq j (1+ j)) entry)) (setq path (nth (setq j (1+ j)) entry)) (setq no-passwd (nth (setq j (1+ j)) entry)) (cond ((equal desired-name 'names) ;; build a list of database names (if (not (string= name "")) (progn (setq found-db t) (setq val (cons name val))))) (t (if (string-equal name desired-name) (progn (setq databases nil) ;break loop (setq found-db t) (setq val (cond ((not field) (list default host path nil no-passwd)) ((equal field 'get) (cdr entry)) ((equal field 'name) desired-name) ((equal field 'is-default) default) ((equal field 'host) host) ((or (equal field 'path) (equal field 'database)) path) ((or (equal field 'no-passwd) (equal field 'connection-type)) no-passwd) ((equal field 'casjobs) (equal no-passwd "casjobs")) (t (error "Unknown field name: %s" (prin1-to-string field)) )))))))) (if (not found-db) (if no-error 'error (error (concat "Unknown database name: " desired-name))) val))) (defun skyserver-set-param (name field value) "Set the NAMEd FIELD for the specified database to VALUE" (let ( (properties (skyserver-get-param name 'get)) n ) (cond ((equal field 'is-default) (setq n 0)) ((equal field 'host) (setq n 1)) ((or (equal field 'path) (equal field 'database)) (setq n 2)) ((or (equal field 'no-passwd) (equal field 'connection-type)) (setq n 3)) (t (error "Unknown field name: %s" (prin1-to-string field)))) (setcar (nthcdr n properties) value)) value) (defun skyserver-set-database (&optional name save) "Set the NAME of the database that you want to query. If SAVE is true, save the values as if regularly customised. If SAVE has the value \"local\", the selected database will only apply to the current buffer. " (interactive) (if (or (not name) (equal name "")) (setq name (skyserver-completing-read "Choose database (TAB to complete): " skyserver-database-list))) (if (equal save "local") (make-local-variable 'skyserver-database-name) (kill-local-variable 'skyserver-database-name)) (setq skyserver-database-name name) (if (boundp 'database-name) (makunbound database-name)) ;; Remove old database name, if present, and replace by new, if known (skyserver-set-mode-line-string) ;; Do I need to change the default database? (if (not (skyserver-get-param skyserver-database-name 'is-default)) (let ( (databases (skyserver-get-param 'names)) db ) (while databases (setq db (car databases)) (setq databases (cdr databases)) (skyserver-set-param db 'is-default (equal db skyserver-database-name))) (if (or (equal save t) (equal save 1)) (customize-save-variable 'skyserver-database-list skyserver-database-list)))) name) ;; (defun skyserver-reset-passwd (&optional user passwd) "Reset the password used to connect to a database" (interactive) (if (skyserver-casjobs-server) (progn (if (not user) (progn (setq user (read-string "CasJobs user name: ")) (setq skyserver-casjobs-user user) (set-default 'skyserver-user user) (if (y-or-n-p "Remember that name for future sessions? ") (customize-save-variable 'skyserver-casjobs-user user)))) (setq skyserver-casjobs-passwd (if passwd passwd (skyserver-passwd (format "CasJobs password for user %s: " skyserver-casjobs-user) t)))) (setq skyserver-user (if user user (read-string "User: " skyserver-user))) (setq skyserver-passwd (if passwd passwd (skyserver-passwd nil t))) )) ;; (defun skyserver-passwd (&optional prompt just-return-value) "Reset the password. You shouldn't need to do explicitly this unless you gave an incorrect password If JUST-RETURN-VALUE is t, skyserver-password won't be set and the password will be returned to the user " (interactive) (if (not prompt) (setq prompt "Password: ")) (let ( (passwd (if (fboundp 'comint-read-noecho) (comint-read-noecho prompt t) (read-passwd prompt))) ) (if just-return-value passwd (setq skyserver-passwd passwd)))) ;; (defun skyserver-toggle-fake-tsql (&optional value) "Toggle the value of skyserver-fake-tsql" (interactive) (setq skyserver-fake-tsql (if value value (not skyserver-fake-tsql))) (message (concat "skyserver.el's fake T-SQL support is " (if skyserver-fake-tsql "enabled" "disabled"))) (skyserver-set-mode-line-string) skyserver-fake-tsql) ;; ;; These are the main user commands ;; (defun skyserver-submit-buffer (out-buffer-name &optional append) "Submit the current buffer to the skyServer, returning the results in skyserver-output-buffer. If you provide a prefix-argument you'll be prompted for the buffer name, and it'll be associated with a file on disk. See also skyserver-submit-region" (interactive "P") (skyserver-check-for-proxlist) (skyserver-submit-region out-buffer-name (point-min) (point-max) append)) (defun skyserver-casjobs-submit-current-query-long () "Submit query under cursor to the casJobs server as a long query; see skyserver-submit-buffer for details" (interactive) (if (not (skyserver-casjobs-server)) (error "%s is not a casjobs server" (skyserver-database-name))) (let ( (skyserver-casjobs-longQuery t) ) (call-interactively 'skyserver-submit-current-query))) (defun skyserver-show-query-plan () "Show execution plan for the query under cursor from the skyServer; see skyserver-submit-buffer for details" (interactive) (skyserver-check-for-proxlist) (save-excursion (skyserver-mark-sexp) (let* ( (region (skyserver-mark-sexp t)) (start (car region)) (end (cdr region)) (query (skyserver-get-query-from-buffer start end)) (formatted-buffer (concat (skyserver-formatting-buffer nil) "-plan")) (mangled-query (skyserver-mangle-query query formatted-buffer t)) ) (if t (if (bufferp (get-buffer formatted-buffer)) ; delete scratch buffer (kill-buffer formatted-buffer))) (require 'browse-url) (browse-url (skyserver-build-url (skyserver-database-name) (concat "qplan/viewplan.aspx" "?wsid=" (skyserver-casjobs-webid) "&target=" skyserver-casjobs-target "&sql="mangled-query))) ))) (defun skyserver-submit-current-query () "Submit query under cursor to the skyServer; see skyserver-submit-buffer for details" (interactive) (skyserver-check-for-proxlist) (save-excursion (skyserver-mark-sexp) (call-interactively 'skyserver-submit-region))) (defun skyserver-buffer-is-query () "Return t iff this buffer appears to contain a SQL query, as opposed to a list of positions for the proxlist server" (interactive) (save-match-data (save-excursion (goto-char (point-min)) (let ( (case-fold-search t) ) (or (< (point-max) 10) ;a new buffer (re-search-forward (concat "^[ \t]*\\<\\(" "create\\|drop\\|declare\\|insert\\|select\\|truncate" "\\)\\>") nil t)))))) (defun skyserver-check-for-proxlist () "See if this is a proxlist buffer, and, if so, maybe insert proxlist parameters into buffer" (setq skyserver-proxlist (not (skyserver-buffer-is-query))) (if (and skyserver-proxlist skyserver-proxlist-always-insert-values) (skyserver-proxlist-insert-values))) (defun skyserver-mark-sexp (&optional return-list) "Put mark at end of this select statement, point at beginning. The select statement marked is the one that contains point or follows point If the buffer contains sections delimited by ^L in the first column, these are taken to define the query boundaries. If the buffer contains only one select statement (starting in the first column), then the entire buffer is the query. Otherwise, mark the query containing point, and any TSQL-initialisations that precede it; this will not, in general, include any other sql statement such as dropping tables that you may want included while talking to a casJobs server. If RETURN-LIST is true, return a list (point-min . point-max) rather than setting point or mark. " (interactive) (let ( end ) (if return-list (save-excursion (skyserver-end-of-defun) (setq end (point)) (skyserver-beginning-of-defun t) (while (looking-at "^[ \t]*$") (forward-line 1)) (cons (point) end)) (skyserver-end-of-defun) (setq end (point)) (skyserver-beginning-of-defun t) (while (looking-at "^[ \t]*$") (forward-line 1)) (push-mark end nil t) (sit-for 0)))) (defun skyserver-submit-query (out-buffer-name &optional append) "Submit the current buffer to the skyServer as a SQL query, returning the results in skyserver-output-buffer. If you provide a prefix-argument you'll be prompted for the buffer name, and it'll be associated with a file on disk. You should not need to use this command, as usually skyserver mode can automatically decide if a buffer contains SQL (as opposed to a proxlist query). This works by setting the buffer-local variable skyserver-proxlist " (interactive "P") (setq skyserver-proxlist nil) (skyserver-submit-region out-buffer-name (point-min) (point-max) append)) (defun skyserver-submit-proxlist (out-buffer-name &optional append) "Submit the current buffer to the skyServer as a proxlist query, returning the results in skyserver-output-buffer. If you provide a prefix-argument you'll be prompted for the buffer name, and it'll be associated with a file on disk. This works by setting the buffer-local variable skyserver-proxlist " (interactive "P") (setq skyserver-proxlist t) (skyserver-submit-region out-buffer-name (point-min) (point-max) append)) (defun skyserver-submit-region (out-buffer-name min max &optional append) "Submit the current region (or the entire buffer if no region is defined) to the skyServer, returning the results in skyserver-output-buffer. If you provide a prefix-argument you'll be prompted for the buffer name, and it'll be associated with a file on disk. See also skyserver-submit-buffer" (interactive "P\nr") (let* ( (out-buffer-noext (file-name-sans-extension (buffer-file-name))) (basename (file-name-nondirectory out-buffer-noext)) (suffix ".dat") (buffer skyserver-output-buffer) (skyserver-starting-lineno (1+ (count-lines (point-min) min))) writing-to-file ) (cond (out-buffer-name (setq out-buffer-name (read-string "Output buffer: " (if (string-equal buffer skyserver-default-output-buffer) (concat basename suffix) (cond (skyserver-write-file (concat (if skyserver-read-result-via-disk (if (equal t skyserver-writing-to-file) ">" "") (if skyserver-append-to-file ">>" ">")) (if (string-match "^\\*+" buffer) (replace-match "" nil nil buffer) buffer))) (t buffer))))) (setq skyserver-writing-to-file nil) (if (not (string-equal out-buffer-name "")) (setq skyserver-writing-to-file (if skyserver-read-result-via-disk (if (string-match "^>" out-buffer-name) t 1) t)) (if skyserver-read-result-via-disk (setq out-buffer-name (concat ">" basename suffix)))))) (if skyserver-read-result-via-disk (if (not (equal t skyserver-writing-to-file)) (setq out-buffer-name (concat ">" basename suffix)))) (setq writing-to-file skyserver-writing-to-file) ;for skyserver-submit-sql (let ( (query (skyserver-get-query-from-buffer min max)) ) (catch 'empty-query (let ( (jobtype nil) ) (skyserver-submit-job jobtype query out-buffer-name skyserver-casjobs-target skyserver-casjobs-queue nil append)))))) ;; (defun skyserver-get-query-from-buffer (min max) "Return the query in the current region (or the entire buffer if no region is defined)" (let ( (query (buffer-substring-no-properties min max)) ) (if (and skyserver-include-header (not (string-match "" query))) (save-excursion ; is there a header? (goto-char (point-min)) (if (re-search-forward "--.*
" nil t) (let ( (hstart (line-start-position)) hend ) (if (not (re-search-forward "--.*
" nil t)) (progn (message "Saw
but no
; ignoring") (sleep-for 1)) (setq hend (line-end-position))) (if hend (progn (cond ((and (<= min hstart) (>= max hend)) t) ; header's already included ((or (and (< min hstart) (> max hstart)) (and (< min hend) (> max hend))) (message "Query overlaps header; ignoring header") (sleep-for 1)) (t (if (boundp 'skyserver-starting-lineno) (let ( (nhlines 1) ) ;no. of lines in header (save-excursion (goto-char hstart) (while (search-forward "\n" hend t) (setq nhlines (1+ nhlines)))) (setq skyserver-starting-lineno (- skyserver-starting-lineno nhlines)))) (setq query (concat (buffer-substring-no-properties hstart hend) "\n" query)))))))))) query)) ;; ;; Switch to the query buffer ;; (defun skyserver-show-query (&optional other buffer) "Switch to the buffer containing the query; with a prefix-argument, display the buffer in another window, but don't switch to it" (interactive "P") (if (not buffer) (setq buffer skyserver-query-buffer)) (if other (display-buffer buffer t) (let ( (window (get-buffer-window buffer)) ) (if window (select-window window) (switch-to-buffer buffer))))) ;; ;; Switch to the output buffer ;; (defun skyserver-show-output (&optional other output-buffer) "Switch to the buffer where output should appear; with a prefix-argument, display the buffer in another window, but don't switch to it See also skyserver-show-output-end " (interactive "P") (if (not output-buffer) (setq output-buffer skyserver-output-buffer)) (if (not (get-buffer output-buffer)) (error (concat "buffer " output-buffer " doesn't exist"))) (if other (display-buffer output-buffer t) (let ( (window (get-buffer-window output-buffer)) ) (if window (select-window window) (switch-to-buffer output-buffer))))) (defun skyserver-show-output-end () "Show the end of the query buffer in a different window. This is probably mostly useful for looking at SQL error messages" (interactive) (skyserver-show-output t) (end-of-buffer-other-window 0)) ;; ;; Provide help with skyserver ;; (defun skyserver-help () "Send a request to your browser to display the skyserver help page If you want help with emacs' skyserver mode, say ESC-x describe-mode in a file that is using minor mode SkyServer " (interactive) (require 'browse-url) (message "Sending url to your browser") (browse-url (skyserver-build-url (skyserver-database-name) (if (skyserver-casjobs-server) "Guide.aspx" "help/browser/browser.asp")))) ;; ;; Download version info from the skyserver ;; (defun skyserver-version (&optional db) "\ Return version information for the attached database, and also for this lisp package. If you're connected to only one database, just hit when prompted for a database name; if you have tables such as rhlDB..photoObj you might want to specify rhlDB (or move the mouse over the rhlDB before issuing this command). N.b. Performs a query. " (interactive) (if (not db) (setq db "")) (let* ( (database-name skyserver-database-name) (host (skyserver-get-param database-name 'host)) (path (skyserver-get-param database-name 'path)) (target skyserver-casjobs-target) skyserver-url start end ) (setq skyserver-url (concat host "/" path (if (skyserver-use-password database-name) (format "\n Connecting as user %s with password *********" skyserver-user) "") (if (skyserver-casjobs-server) (format "\n Connecting to CasJobs server as user %s with password *********%s" skyserver-casjobs-user (if (and skyserver-casjobs-target skyserver-casjobs-queue) (format "\n Target/Queue: %s/%s%s" skyserver-casjobs-target skyserver-casjobs-queue (if (and skyserver-casjobs-taskname (not (string= "" skyserver-casjobs-taskname))) (format " Taskname: %s" skyserver-casjobs-taskname) "")) "") ) ""))) (save-excursion (setq start (progn (if (not (looking-at "\\<")) (forward-word -1)) (point))) (setq end (progn (if (not (looking-at "\\>")) (forward-word 1)) (if (looking-at "\\.\\.") (progn (setq db (buffer-substring-no-properties start (point)))))))) (setq db (read-string (if (string-equal db "") "Database ( for default): " "Database: ") db)) (let ( (skyserver-pretty-format t) (query (concat "select cast(name as char(20)) as name, value from " (if (equal db "") "" (concat db "..")) "SiteConstants" (concat " where " "name like 'DB%'" " or " "name like '%URL%'" " or " "name like 'Checksum'"))) (buffer) ) (setq buffer (skyserver-submit-sql-sync query)) (while (get-buffer-process buffer) (sit-for 0.1)) (set-buffer buffer) (display-buffer buffer)) (let ( (min (point-min)) url ) (setq url (with-current-buffer (skyserver-formatting-buffer "sync") (buffer-substring-no-properties (point-min) (point-max)))) (string-match "^[^?]+" url) (setq url (match-string 0 url)) (goto-char min) (if (not (equal db "")) (progn (insert (format "Database: %s\n\n" db)) (setq min (point)))) (cond ((looking-at "\\(name value\\|NAME VALUE\\)\n") (forward-line 2) (delete-region min (point)) (indent-region (point-min) (point-max) 8)) ((looking-at "No objects have been found") (forward-line 2) (delete-region min (point)) (insert "The SiteConstants don't appear to be set\n")) ((save-excursion (search-forward "Cannot open database requested in login" nil t)) (delete-region min (point-max)) (beep) (insert (format "\ The database %s is not accepting logins at this time " skyserver-url))) ((save-excursion (and (search-forward "[, \n\t]+") nil t) (let ( (newtable (match-string 1)) ) (if (not (string-match "^\\(on\\|join\\|from\\)$" newtable)) ; no "as" (progn (message (format "%s is an object of type %s" table newtable)) (sit-for 0.4) (setq table newtable)))))))) (setq table (read-string "Table: " table)) (if (string-equal "" table) (setq find-symbols (y-or-n-p "Include functions/procedures? "))) (cond (find-symbols) ((string-match "^\\(dbo\\.\\)?f\\(.*\\)N?$" table) (let* ( (begin (match-beginning 2)) (end (if (string-match "N$" table) -1 nil)) (ntable (substring table begin end)) ) (save-excursion (goto-char start) (if (not (looking-at "dbo\\.")) (goto-char (- start 4))) (if (looking-at "dbo\\.") (setq get-values (y-or-n-p (format "Look up values from table %s? " ntable)))) (if get-values (setq table ntable)))))) (if (string-match "^\\(.*\\.\\)\\([^.]+\\)$" table) (progn (setq DB (match-string 1 table)) (setq table (match-string 2 table)))) (if (not regexp) (setq regexp (if pattern (format "%s" (skyserver-convert-regexp (read-string "Regexp: "))) "%"))) (if (not (string= table "")) (progn (setq symbol-type (skyserver-return-eval-expr (format "xtype from %ssysobjects where name like '%s'" DB table))) (setq symbol-description (skyserver-return-eval-expr (format "description, text from %sdbObjects where name like '%s'" DB table) nil t)) )) (if skip-header (setq symbol-description nil)) (message "") (cond (find-symbols (setq query (format "\ select cast(sys.name as char(30)) as name, cast(case xtype when 'FN' then 'Function' when 'P' then 'Procedure' when 'TF' then 'Table-Function' when 'U' then 'Table' when 'V' then 'View' else 'Unknown' end as char(14)) as 'Type', db.description as description from %ssysobjects as sys join %sdbObjects as db on sys.name = db.name where sys.name like '%s' and xtype not in ('C', 'D', 'F', 'PK', 'UQ', 'S') order by name " DB DB regexp)) (setq format "%-30s %-15s %s\n")) ((string= table "") (setq query (format "\ select cast(name as char(20)) as name, '|' as '|', description from dbObjects %s where type in ('U', 'V') and name like '%s' order by name " table regexp)) (setq format "%-20s %s %s\n")) (get-values (setq query (format "\ select cast(name as char(30)) as name, value, description from %s%s where name like '%s' order by name " DB table regexp)) (setq format "%-30s %s\n")) (t (if (or (string= symbol-type "U") (string= symbol-type "V")) (progn (setq query (format "\ select cast(name as char(20)) as name, '|' as '|', cast(unit as char(10)) as unit, '|' as ';', cast(enum as char(10)) as enum, '|' as ':', description from %sfDocColumns('%s') where name like '%s' order by name " DB table regexp)) (setq format "%-20s %s %-10s %s %-10s %s %s\n")) (setq query (format "\ select cast(name as char(20)) as name, '|' as '|', description as description, '|' as ';', text as text from dbobjects where name like '%s' order by name " table)) (setq format "%-20s %s %s %s %s\n") ))) (set-buffer (skyserver-submit-sql query "" t nil t t)) ;; ;; Remove any commas in result ;; (let ( (modified (buffer-modified-p)) ) (goto-char (point-min)) (let ( (header (buffer-substring (point-min) (line-end-position))) start-header) (kill-line 1) (if symbol-description (let ( (len (length symbol-description)) ) (insert-string (concat symbol-description "\n\n")) (save-excursion (narrow-to-region (point-min) (+ len (point-min))) (fill-paragraph t) (widen)))) (setq start-header (point)) (while (string-match ",[|:#]," header) (setq header (replace-match " | " nil nil header))) (insert-string (condition-case nil (apply 'format format (split-string header)) ((error nil) (concat header "\n")))) (insert-string "\ ------------------------------------------------------------------------------- ") (goto-char start-header)) (while (re-search-forward "," nil 1) (replace-match " ")) (set-buffer-modified-p modified)) (setq case-fold-search t) ;as SQL is case-insensitive )) ;; ;; List all active queries ;; (defun skyserver-list-processes (&optional query-buffer-name) "List all active queries" (interactive) (let ( (proc-list (process-list)) query-list (nquery 0) (buffer "*skyServer Queries*") (format "%-20s %-20s %-5s %11s %s\n") proc pname sql-buffer pbuffer pstatus nlines to-file start-time ) ;;if we don't do this, the attempt to go to the correct line is ignored (if (and (get-buffer buffer) (not (equal (get-buffer buffer) (current-buffer)))) (kill-buffer buffer)) (set-buffer (get-buffer-create buffer)) (skyserver-client-mode t) (local-set-key "\C-cf" '(lambda (&optional other) (interactive "P") (save-excursion (beginning-of-line) (let ( (dot (point)) (start (point)) (buffer) ) (skip-chars-forward "^ \t\n") (setq buffer (buffer-substring start (point))) (if (= (length buffer) 0) (error "Please choose a line with a buffer")) (with-current-buffer buffer (skyserver-show-output other)))))) (local-set-key "\C-c\C-f" '(lambda (&optional other) "Switch to buffer containing this line's query; with a prefix argument, show query in another window" (interactive "P") (save-excursion (beginning-of-line) (let ( (dot (point)) (start (point)) (buffer) ) (skip-chars-forward "^ \t\n") (setq buffer (buffer-substring start (point))) (if (= (length buffer) 0) (error "Please choose a line with a buffer")) (skyserver-show-output other buffer))))) (local-set-key "\C-l" '(lambda (arg) (interactive "P") (let ( (dot (point)) ) (skyserver-list-processes) (goto-char dot)) (recenter arg))) (local-set-key "\C-c\C-l" '(lambda () (interactive) (let ( (dot (point)) ) (skyserver-list-processes) (goto-char dot)))) (let ( (keys (list "\n" "\r" "\t")) key dt ) (while (setq key (car keys)) (setq keys (cdr keys)) (local-set-key key '(lambda (&optional other) "Show status of process listed on current line. With a prefix argument, show status in another window" (interactive "P") (save-excursion (beginning-of-line) (let ( (dot (point)) (start (point)) (buffer) jobId db-name ) (skip-chars-forward "^ \t\n") (setq buffer (buffer-substring start (point))) (if (= (length buffer) 0) (error "Please choose a line with a buffer")) (with-current-buffer buffer (setq jobId skyserver-jobId) (setq db-name (skyserver-database-name))) (skyserver-casjobs-show-status jobId db-name other)))) ))) (local-set-key "\C-c\C-j" '(lambda (&optional prefix) (interactive "P") (skyserver-casjobs-list-queries prefix))) (let ( (keys (list "\C-c\C-g" "\C-k")) key dt ) (while (setq key (car keys)) (setq keys (cdr keys)) (local-set-key key '(lambda () "Kill the query on the line under the cursor" (interactive) (let ( (dot (point)) start query buffer ) (save-excursion (beginning-of-line) (setq start (point)) (skip-chars-forward "^ \t\n") (setq query (buffer-substring start (point))) (skip-chars-forward " \t\n") (setq start (point)) (skip-chars-forward "^ \t\n") (setq buffer (buffer-substring start (point))) (if (= (length buffer) 0) (error "Please choose a line with a buffer")) (let ( (pname buffer) (plist skyserver-process-info) (old nil) ) ;; Remove from saved list of queries (while (and plist (not (string-equal (car (car plist)) buffer))) (setq old plist) (setq plist (cdr plist))) (if plist ;found it (if (not old) ;first element (setq skyserver-process-info (cdr skyserver-process-info)) (setcdr old (cdr plist))))) ;; Remove queries' formatted buffer (let ( (formatted-buffer (skyserver-formatting-buffer query)) ) (if (bufferp (get-buffer formatted-buffer)) (kill-buffer formatted-buffer)) (if (bufferp (get-buffer (concat formatted-buffer "-plan"))) (kill-buffer (concat formatted-buffer "-plan")))) ;; actually kill the process (if (get-buffer-process buffer) (skyserver-delete-process nil buffer t)) (skyserver-list-processes)) (goto-char dot)))))) ;; Start actual display code (delete-region (point-min) (point-max)) (insert (concat (format format "Query" "Buffer" "Nline" "Time " "Output File") "\n")) (setq query-list (append skyserver-process-info proc-list)) (setq query-list (sort (copy-sequence query-list) '(lambda (a b) (setq a (if (processp a) (buffer-name (process-buffer a)) (car a))) (setq b (if (processp b) (buffer-name (process-buffer b)) (car b))) (string-lessp a b)))) (while query-list (setq proc (car query-list)) (setq query-list (cdr query-list)) (if (processp proc) (progn (setq pname (process-name proc)) (if (not (string-match "Query\\(<[0-9]+>\\)?" pname)) (setq pname nil)) (setq pbuffer (process-buffer proc)) (setq dt nil)) (setq pname (car proc)) (let ( (list proc-list) ) (while (and list pname) (if (string-equal pname (buffer-name (process-buffer (car list)))) (setq pname nil)) ; don't include from *-info list (setq list (cdr list)))) (setq pbuffer pname) (let ( (status (cdr (cdr proc))) ) (if (and pbuffer (buffer-live-p pbuffer)) (setq status (save-excursion (with-current-buffer pbuffer (if skyserver-jobId (skyserver-casjobs-get-status skyserver-jobId 'Status t) status))))) (setq dt (cond ((string-equal status "Active") (concat " " (with-current-buffer pbuffer (with-current-buffer skyserver-query-buffer (skyserver-casjobs-reformat-time (skyserver-casjobs-get-status skyserver-jobId 'TimeElapsed)))) " ")) ((string-equal status "Ready") "Ready ") (t (concat "[" (car (cdr proc)) "]" (cond ((string-equal status "Killed") "K") ((string-equal status "Timeout") "T") ((string-equal status "Failed") "F") (t " "))))) ))) (if (and pname (buffer-live-p pbuffer)) (progn (setq nquery (+ nquery 1)) (with-current-buffer pbuffer (setq start-time (if (boundp 'skyserver-start-time) skyserver-start-time nil)) (setq nlines (count-lines (point-min) (point-max))) (setq to-file skyserver-write-file) (setq sql-buffer skyserver-query-buffer)) (if to-file (let ( (ans nil) (result (split-string (shell-command-to-string (concat "wc -l " to-file)))) ) (if (> (length skyserver-output-filter) 0) (setq ans (concat "| " skyserver-output-filter " > "))) (while (string-equal (car result) "") (setq result (cdr result))) (setq nlines (string-to-int (car result))) (setq to-file (concat ans to-file)))) (if (not dt) (setq dt (concat (skyserver-elapsed-time start-time) " "))) (insert (format format sql-buffer pbuffer nlines (if dt dt "??? ") (cond (to-file to-file) (t "(buffer)")) )) ))) (if (= nquery 0) (insert "No queries are active\n")) (insert " You may use ^C^F to switch to any query's buffer, and use ^C^F in that buffer to switch to the corresponding SQL buffer. or shows details of the query if available (primarily useful for casJobs queries). q buries this buffer. Use ^K (or ^C^G) to kill a running query; ^K deletes a completed query ") (set-buffer-modified-p nil) (goto-char (point-min)) (if (and query-buffer-name (re-search-forward (concat "^" query-buffer-name) nil t)) (beginning-of-line)) (goto-char (point)) (display-buffer buffer))) ;; ;; Return a string telling now long a query's been running ;; (defun skyserver-elapsed-time (start-time) "" (if start-time (let* ((now (current-time)) (dt0 (- (nth 0 now) (nth 0 start-time))) (dt1 (- (nth 1 now) (nth 1 start-time))) (time) ) (if skyserver-xemacs-p (let ( (ut-offset (- 0 (car (current-time-zone)))) ) ;seconds West of GMT (setq dt1 (+ dt1 ut-offset)) (if (string-equal ; Work around daylight saving in %T (format-time-string "%T" (cons 0 ut-offset)) "23:00:00") (setq dt1 (+ dt1 3600))))) (while (< dt1 0) (setq dt1 (+ 65536 dt1)) (setq dt0 (1- dt0))) (setq time (if skyserver-xemacs-p (format-time-string "%T" (cons dt0 dt1)) (format-time-string "%T" (cons dt0 dt1) t))) (if (string-match "^00:0?" time) (replace-match "" nil nil time) (if (string-match "^0*" time) (replace-match "" nil nil time)))) "???")) ;; ;; Show the query that was actually submitted to skyserver ;; (defun skyserver-show-submitted (&optional sync) "Show the query that was actually submitted to skyserver, after all skyserver mode's substitutions have been made. With a prefix argument, show the last synchronous query." (interactive "P") (let* ( (buffer-name (skyserver-formatting-buffer (buffer-name))) (buffer (get-buffer buffer-name)) ) (if (not (bufferp buffer)) (error "No processed query is associated with this buffer")) (switch-to-buffer buffer) (undo-start) (undo-more 1) ; (advertised-undo undoes too much) ;; ;; Delete all blank lines. ;; (undo-boundary) (save-excursion (goto-char (point-min)) (while (re-search-forward "^[ \t\n]+\n" nil t) (replace-match ""))))) ;; ;; Kill the skyserver process ;; (defun skyserver-delete-process (&optional no-confirm buffer error) "Kill the skyserver process associated with a BUFFER; if optional NO-CONFIRM (interactively, with a prefix-argument) ask no questions. If ERROR is non-nil, abort if the process isn't killed. There are two levels of process to kill; the http connection to the database, and the query itself. We try to handle both levels. " (interactive "P") (if (not buffer) (setq buffer (read-string "Kill the process running in buffer: " skyserver-output-buffer))) (set-buffer buffer) (let ( (proc (get-buffer-process buffer)) (is-casjobs (skyserver-casjobs-server)) ) (if (not proc) (if (and (not is-casjobs) (not no-confirm)) (error "There is no process associated with %s" buffer)) (if (or no-confirm (y-or-n-p (format "Kill skyserver process in %s? " buffer))) (progn (kill-process proc) (while (get-buffer-process buffer) (sit-for 1))) (if error (error "%s's process wasn't killed" buffer)))) (let ( (jobId (with-current-buffer buffer skyserver-jobId)) ) (if (and jobId is-casjobs) (skyserver-casjobs-kill-job jobId))) )) ;; ;; Symbol table code for skyserver ;; (defvar skyserver-symbtable nil "A symbol table for @variables") (defun skyserver-reset-symbol-table () "Undefine all \"Transact-SQL\" @variables" (interactive) (setq skyserver-symbtable nil)) (defun skyserver-show-symbol-table (&optional show-unexpanded) "Show the values of all symbols in the skyserver symbol table. With a prefix-argument list the unexpanded and expanded values of the symbol" (interactive "P") (let ( (buffer "*skyServer Variables*") (fmt (if show-unexpanded "%-20s %-8s %-40s %s\n" "%-20s %-8s %s\n")) table-ptr chosen-var saw-chosen-var (var) (val) (eval)) (save-excursion ; Just look up one variable? (skip-chars-backward "@a-zA-Z0-9_") (if (and skyserver-mode (looking-at "@[a-zA-Z0-9_]+")) (progn (setq chosen-var (match-string 0)) (setq chosen-var (if (y-or-n-p (format "Only look up value of %s? " chosen-var)) (upcase chosen-var) nil))))) (display-buffer (get-buffer-create buffer)) (set-buffer buffer) (skyserver-client-mode t) (let ( (keys (list "\C-c\C-d" "\C-k")) key ) (while (setq key (car keys)) (setq keys (cdr keys)) (local-set-key key '(lambda (&optional all) "Reset the symbol-table entry on the current line" (interactive "P") (let (var (point (point)) ) (save-excursion (beginning-of-line) (if (or all (not (looking-at "@[^ \t\n]+"))) (if (or all (y-or-n-p "I don't see a symbol on this line; delete all variables? ")) (skyserver-reset-symbol-table) (error "")) (setq var (match-string 0)) (skyserver-set-symbol var nil 'delete))) (skyserver-show-symbol-table) (goto-char point)))))) (local-set-key "\C-c\C-l" '(lambda () "Refresh the symbol table information" (interactive) (let ( (point (point)) ) (skyserver-show-symbol-table) (goto-char point)))) (local-set-key "\C-c\C-r" '(lambda () "Reset the symbol table to empty" (interactive) (skyserver-reset-symbol-table) (skyserver-show-symbol-table))) (toggle-read-only 0) (delete-region (point-min) (point-max)) ;; ;; Sort symbol table ;; (setq skyserver-symbtable (sort skyserver-symbtable '(lambda (A B) "" (let ( (varA (downcase (car A))) (varB (downcase (car B))) ) (string-lessp varA varB))))) (insert "skyServer mode \"Transact-SQL\" variables\n\n") (insert (concat (if show-unexpanded (format fmt "Name" "Type" "Value" "Expanded") (format fmt "Name" "Type" "Value")) "\n")) (setq table-ptr skyserver-symbtable) (while table-ptr (setq var (car (car table-ptr))) (setq val (cdr (car table-ptr))) (setq eval (nth 1 val)) (setq type (nth 2 val)) (setq val (car val)) (if (or (not chosen-var) (string-equal var chosen-var)) (progn (setq saw-chosen-var t) (insert (if show-unexpanded (format fmt var type val (if (equal val eval) "" eval)) (format fmt var type (if (equal val eval) val eval)))))) (setq table-ptr (cdr table-ptr))) (toggle-read-only 0) (set-buffer-modified-p nil) (if (and chosen-var (not saw-chosen-var)) (error (format "Variable %s doesn't seem to be defined" chosen-var))))) (defun skyserver-set-symbol (var type val &optional eval) "Add a variable VAR of type TYPE to the skyserver symbol table with value VAL. The optional EVAL is the expanded value of VAL, if known" (save-match-data (if (and type (string-match "([0-9]*)$" type)) (setq type (substring type 0 (match-beginning 0)))) (if (and val (stringp val)) ; strip trailing whitespace (if (string-match "\\([ \t]+\\)$" val) (setq val (substring val 0 (match-beginning 1))))) (if (and eval (stringp eval)) ; strip trailing whitespace (if (string-match "\\([ \t]+\\)$" eval) (setq eval (substring eval 0 (match-beginning 1))))) (if (not (and type (string-match (concat "^\\(" skyserver-sql-type-regexp "\\)$") type))) (progn (if (not (string-equal val "delete")) (progn (message (format "Variable %s has unknown type %s; assuming \"varchar\"" var type)) (sleep-for 2))) (setq type "varchar"))) ) (setq var (upcase var)) (let ( (table-ptr skyserver-symbtable) (optr nil) ) (while (and var table-ptr) (if (equal (car (car table-ptr)) var) (let* ( (vals (cdr (car table-ptr))) (symb-val (nth 0 vals)) (symb-eval (nth 1 vals)) (symb-type (nth 2 vals)) ) (if (equal val 'delete) (progn (setq var nil) ; break loop (if (not optr) (setq skyserver-symbtable (cdr table-ptr)) (setcdr optr (cdr table-ptr)))) (setq var nil) ; break loop (setcdr (car table-ptr) (cond ((or (not type) (not (equal type symb-type))) (list val eval type)) (t (list (cond (val val) (t symb-val)) (cond (eval eval) (t symb-eval)) (cond (type type) (t symb-type))))))) )) (setq optr table-ptr) (setq table-ptr (cdr table-ptr)))) (if (not (equal val 'delete)) (if var ; not inserted yet (setq skyserver-symbtable (append skyserver-symbtable (list (cons var (list val eval type)))))))) (defun skyserver-get-symbol-type (var) "Return variable VAR's type from the skyserver symbol table" (let ( (cons (skyserver-get-symbol var t)) ) (nth 2 cons))) (defun skyserver-get-symbol (var &optional cons) "Return variable VAR's value from the skyserver symbol table If CONS is true, return the symbol's cons cell " (setq var (upcase var)) (let ( (table-ptr skyserver-symbtable) (val) ) (while (and var table-ptr) (if (equal (car (car table-ptr)) var) (progn (setq var nil) (setq val (cdr (car table-ptr))) (if (not cons) (let ( (eval (nth 1 val)) ) (setq val (cond (eval eval) (t (nth 0 val))))))) ) (setq table-ptr (cdr table-ptr))) val)) (defun skyserver-return-eval-expr (dbo-expr &optional allow-failed-expansion long-value) "Return a string which is the value of dbo-expr E.g. (skyserver-return-eval-expr \"dbo.fPhotoFlagsN(0x1234)\") If ALLOW-FAILED-EXPANSION is true don't throw an error if expansion failed. If LONG-VALUE, return a (possibly multi-line) result, not just a single word " (let ( (marker "SELECTED_STRING_RHL") (err1 "Error: SQL") (err2 "You are not authorized to view this page") ) (save-excursion (set-buffer (skyserver-submit-sql-sync (format "select '%s' as '%s', %s" marker marker dbo-expr))) (goto-char (point-min)) (skip-chars-forward "# ") (cond ((re-search-forward (concat err1 "\\|" err2) nil t) (if allow-failed-expansion (progn dbo-expr) (delete-region (point-min) (match-beginning 0)) (goto-char (point-min)) (if (looking-at err2) (progn (insert "\n") (goto-char (point-min)))) (save-excursion (goto-char (point-max)) (insert (concat "while expanding\n\t" dbo-expr "\n"))) (forward-line 1) (beginning-of-line) (skip-chars-forward " \t") (set-buffer-modified-p nil) (error (concat "Error expanding " dbo-expr " : " (buffer-substring (point) (line-end-position)))))) ((looking-at marker) ; the query probably worked (let ( val ) (forward-line 1) (if (not (re-search-forward (concat marker "[ \t,\"]*" "\\([^\" \t\n]*\\)") nil t)) (error (format "Expected to see %s; saw %s" marker (buffer-substring (point) (line-end-position))))) (setq val (if long-value (buffer-substring (match-end 1) (point-max)) (match-string 1))) (if (string-match "^[ \t]+" val) (setq val (substring val (match-end 0)))) (if (string-match "[ \t]+$" val) (setq val (substring val 0 (match-beginning 0)))) (if (string-equal "" val) (error (concat "Failed to expand " dbo-expr))) (if (string-equal "null" val) (error (concat "SQL-server returned \"" val "\"" " when expanding " dbo-expr))) val)) (t dbo-expr))))) ;; ;; Expand some expressions val used to initialise "set @var = val" ;; (defun skyserver-expand-expr (expr &optional allow-failed-expansion) "Expand at least some expressions used to initialise Transact-SQL variables. In particular, evaluate saved procedures by querying the database. See also skyserver-eval-expr to evaluate bitwise operators" ;; ;; Expand dbo.func() calls ;; (let ( (expanded) ) (while (or (if (string-match "^[ \t]*\\[^\0]*" expr) (progn (setq expr (concat "(" (skyserver-eval-expr expr nil) ")")) (string-match "[^\0]*" expr))) (string-match "\\\\(}\\)?\\)" expr) (let* ( (var (concat (match-string 2 expr) (match-string 4 expr))) (val (if (string= "@" (substring var 0 1)) (save-match-data (let ( (atval (match-string 1 expr)) ) (while (string-match "@" atval) ;replace @s by \001s (setq atval (replace-match "\001" t nil atval))) atval)) (skyserver-get-symbol (concat "@" var)))) ) (if (not val) (error (concat "@" var " hasn't been set"))) (setq expr (replace-match val t nil expr)))) (while (string-match "\\(\001\\)" expr) ; switch \001 back to @ (setq expr (replace-match "@" t nil expr))) ;; ;; Collapse whitespace ;; (while (string-match "\t\\|[ \t][ \t]+" expr) (setq expr (replace-match " " nil nil expr))) ;; ;; Expand some expressions ;; (cond ((not int) t) ((string-match "^[ \t]*\\" expr) (setq expr (skyserver-expand-expr expr))) ((string-match "[g-wyzG-WYZ]" expr) ;; not an integral expression; we'll catch this later expr) (t ;; ;; Handle (parens) ;; (while (string-match "\\((\\([^()]*\\))\\)" expr) (setq expr (replace-match (save-match-data (skyserver-eval-expr (substring expr (match-beginning 2) (match-end 2)) int)) t nil expr))) ;; ;; Handle bitwise operators ;; ;; Watch out: the emacs builtin operator string-to-int assumes ;; 28-bit ints (on at least some hardware; I doubt it it uses ;; 64 bits on _any_ hardware). If you load my bigint package ;; it'll be used to do the desired arithmetic to arbitrary precision. ;; It's distributed with skyserver.el ;; (if (string-match "^[ \t]*\\(0[xX][0-9a-f]+\\|[0-9]+\\)[ \t]*$" expr) expr ; nothing to do (if (string-match "0[xX][0-9a-f]+\\|[0-9]+" expr) (let ( string-to-int number-to-string logior logand logxor iexpr trailer ) (if (featurep 'bigint) (progn (setq string-to-int 'bigint-string-to-bigint) (setq number-to-string 'bigint-to-string) (setq logior 'bigint-logior) (setq logand 'bigint-logand) (setq logxor 'bigint-logxor)) (setq string-to-int 'string-to-int-hex) (setq number-to-string 'number-to-string) (setq logior 'logior) (setq logand 'logand) (setq logxor 'logxor)) (setq iexpr expr) ;initial value of expr (setq expr (let ( (val 0) (num) (op) ) (setq val (funcall string-to-int (match-string 0 expr) "hex")) (setq expr-p t) ; it's an expression (setq expr (substring expr (match-end 0))) (while (string-match "^[ \t]*\\([^a-zA-Z_0-9.]\\)[ \t]*\\(0[xX][0-9a-zA-Z]+\\|[0-9]+\\)" expr) (setq op (match-string 1 expr)) (setq num (funcall string-to-int (match-string 2 expr) "hex")) ;;( debug (message (concat op " ::: " expr))) (setq val (cond ((string-equal "|" op) (funcall logior val num)) ((string-equal "&" op) (funcall logand val num)) ((string-equal "^" op) (funcall logxor val num)) (t (error (concat "Unknown bitwise operator \"" op "\" : " expr))))) (setq expr (substring expr (match-end 0)))) (if (not (string-match "^[ \t]*$" expr)) (setq trailer expr)) (cond ((stringp val) val) ((and skyserver-check-tsql-initialization trailer) iexpr) ; should cause error later (t (funcall number-to-string val))))) ))))) expr) ;; (defun skyserver-submit-sql-sync (&optional query target) "Submit a query like skyserver-submit-sql, but force query to be executed synchronously, and not to use the current output buffer. If target is specified, override the default for this database" (interactive) (catch 'empty-query (let* ( (no-command (not query)) (queue "1") (buffer (skyserver-submit-job "shortQuery" query "" target queue t nil t)) ) (if no-command (display-buffer buffer)) buffer))) ;; (defun skyserver-submit-sql (&optional query buffer forget-buffername append sync show-result) "Submit a sql query to skyserver" (catch 'empty-query (skyserver-submit-job "query" query buffer skyserver-casjobs-target skyserver-casjobs-queue forget-buffername append sync show-result))) ;; ;; And here's the workhorse ;; (defun skyserver-submit-job (jobtype command buffer &optional target queue forget-buffername append sync show-result) "Submit a SQL server command to skyserver, returning the answer in BUFFER default: [skyserver-output-buffer]. If BUFFER starts with a +, or is of the form \"filename a\", the command results will be appended. If FORGET-BUFFERNAME is non-nil, don't make BUFFER the default output buffer If APPEND is true (or is implicitly set by BUFFER's value) the command results are appended to BUFFER. If SYNC is true, wait for command to complete. If NOT-PROXLIST is true, this isn't a proxlist query even if you think that it is. " (if (not jobtype) (setq jobtype (if skyserver-proxlist "proxlist" "query"))) (if (skyserver-casjobs-server) (progn (if (string= jobtype "query") (setq jobtype (if (not (boundp 'skyserver-casjobs-longQuery)) "casShortQuery" "casQuery"))) (if (string= jobtype "shortQuery") (setq jobtype "casShortQuery")))) (if (not (equal jobtype "proxlist")) (setq skyserver-proxlist nil)) (if skyserver-database-name (skyserver-set-mode-line-string)) (if (not command) (progn (setq command (read-string "Query: select " skyserver-previous-query)) (if (string-match "^select[ \t]" command) (setq command (replace-match "" nil nil command))) (setq skyserver-previous-query command) (setq command (concat "select " command)))) (make-variable-buffer-local 'skyserver-output-buffer) (make-variable-buffer-local 'skyserver-query-buffer) (make-variable-buffer-local 'skyserver-write-file) (make-variable-buffer-local 'skyserver-append-to-file) (make-variable-buffer-local 'skyserver-jobtype) (make-variable-buffer-local 'skyserver-jobId) (setq skyserver-jobId nil) ;remove old value (if buffer (progn (if (string= buffer "") (setq buffer (cond (sync (concat skyserver-default-output-buffer "*")) (t skyserver-default-output-buffer)))) (if (string-match "^\\+\\(.*\\)\\|\\([^ \t]+\\)[ \t]+[aA]$" buffer) (let ( (match-data (match-data)) ) (setq match-data (nthcdr 2 match-data)) ; pop match 0 (while (not (car match-data)) (setq match-data (nthcdr 2 match-data))) ; pop nil match (setq buffer (substring buffer (nth 0 match-data) (nth 1 match-data))) (setq append t)))) (setq buffer skyserver-output-buffer) (if (and (string-match "^\\*+" buffer) (not (string-equal buffer skyserver-default-output-buffer))) (setq buffer (replace-match "" nil nil buffer))) (if skyserver-write-file (setq buffer (concat (if skyserver-append-to-file ">>" ">") buffer)))) ;; ;; Deal with ">", requesting that we write straight to a file ;; (if (string-match "^>>?" buffer) (let* ( (filename (substring buffer (match-end 0))) (buffer-visiting (find-buffer-visiting filename)) ) (setq skyserver-write-file t) (setq skyserver-append-to-file (string-match "^>>" buffer)) (if (and buffer-visiting (buffer-modified-p buffer-visiting)) (if (y-or-n-p (format "Buffer visiting %s buffer is modified; continue? " filename)) (with-current-buffer buffer-visiting (set-buffer-modified-p nil)) (error (concat filename " buffer is modified")))) (setq buffer filename)) (setq skyserver-write-file nil)) (if (not forget-buffername) (setq skyserver-output-buffer (skyserver-uniquified-buffer-name buffer))) (setq skyserver-jobtype jobtype) (if (string= buffer (concat skyserver-default-output-buffer "*")) (if (bufferp (get-buffer buffer)) (kill-buffer buffer))) ;may be in wrong directory (if (not (or sync skyserver-write-file (string-equal buffer skyserver-default-output-buffer) (string-equal buffer skyserver-casjobs-admin-buffer) )) (find-file-noselect buffer t)) (let* ( (ibuffer (buffer-name (current-buffer))) (database-name (skyserver-database-name)) (parent-buffer (buffer-name)) (write-file skyserver-write-file) (append-to-file skyserver-append-to-file) (proxlist skyserver-proxlist) (proc) (temp-filename) (skyServer-format-query-b (skyserver-formatting-buffer (if sync "sync" nil)))) (if (bufferp buffer) (save-excursion (delete-region (point-min) (point-max)))) (if (get-buffer buffer) (with-current-buffer buffer (setq skyserver-database-name database-name) (setq skyserver-jobId nil))) ;remove old value ;; ;; Format the query for transmission to the server ;; (if (not target) (setq target skyserver-casjobs-target)) (cond ((not queue) (setq queue skyserver-casjobs-queue)) ((equal queue 1) ;the fast queue (setq queue "1"))) (let ( (host (skyserver-get-param database-name 'host)) (path (skyserver-get-param database-name 'path)) (search skyserver-proxlist-search) (qclass skyserver-proxlist-qclass) (qselect skyserver-proxlist-qselect) (radius skyserver-proxlist-radius) ) (if (get-buffer skyServer-format-query-b) (kill-buffer skyServer-format-query-b)) ; may have wrong directory (set-buffer (get-buffer-create skyServer-format-query-b)) (cond (proxlist (setq command (skyserver-mangle-proxlist command database-name (concat "tools/crossid/" skyserver-upload-asp "?") search qclass qselect radius))) (t (let ( action ) (setq action (cond ((or (equal jobtype "casjobs") (equal jobtype "casQuery") ) "CasJobs.asmx/") ((equal jobtype "casShortQuery") "getCsv.aspx/") ((equal jobtype "casExtractTable") "TableJobs.asmx/") ((equal jobtype "casusers") "CasUsers.asmx/") (t (concat "tools/search/" (if (and (stringp database-name) (string-match "^EDR" database-name)) "x_sql.asp" skyserver-sql-asp))) )) (setq command (concat (skyserver-build-url database-name) "/" action (cond ((or (equal jobtype "casusers") (equal jobtype "casExtractTable") (equal jobtype "casjobs")) (if (bufferp (get-buffer buffer)) (kill-buffer buffer)) ;may be in wrong directory command) ((or (equal jobtype "casQuery") (equal jobtype "casShortQuery")) (skyserver-casjobs-set-target-and-queue target queue) (concat (cond ((equal jobtype "casQuery") "SubmitJob") (t "SubmitShortJob")) "?wsid=" (skyserver-casjobs-webid) "&qry=" (skyserver-mangle-query command skyServer-format-query-b) "&target=" target "&taskname=" (cond (sync "TMP") (skyserver-casjobs-taskname skyserver-casjobs-taskname) (t "")) (if (not (string= jobtype "casShortQuery")) (concat "&estimate=" queue)) "&autocomplete=" (if skyserver-casjobs-autocomplete "1" "0") )) (t (concat "?cmd=" (skyserver-mangle-query command skyServer-format-query-b) "&format=" (if skyserver-csv-output "csv" "xml")))))) )))) (if (or (string-match "?cmd=\\([ \t\n]*\\)&format" command) ;an empty regular query (string-match "&qry=\\([ \t\n]*\\)&target" command)) ;an empty casJobs query (progn (message "Your query is empty (after pre-processing); ignoring") (throw 'empty-query nil))) (delete-region (point-min) (point-max)) (insert command) ;; Prepare to submit query (let ( (buffer (get-buffer buffer)) (buffer-file (buffer-file-name (get-buffer buffer))) ) (if (bufferp buffer) (with-current-buffer buffer (if (and skyserver-read-result-via-disk buffer-file (file-exists-p buffer-file) (not (buffer-modified-p))) (set-visited-file-modtime) ;avoid queries about changed-on-disk )))) (find-file-noselect buffer t) (save-match-data (let ( (cbuffer-name (buffer-name (current-buffer))) ) (if (string-match "\\(<[0-9]+>\\||\\(.*\\)\\)$" cbuffer-name) (setq buffer (concat buffer "|" (match-string 2 cbuffer-name)))))) (let ( (xbuffer (skyserver-uniquified-buffer-name buffer)) ) (if (or show-result (not (or forget-buffername sync))) (display-buffer xbuffer)) (set-buffer xbuffer)) (set (make-local-variable 'skyserver-database-name) (skyserver-database-name)) (if (or forget-buffername sync) (local-set-key "q" 'bury-buffer)) (setq skyserver-writing-to-file (if (boundp 'writing-to-file) writing-to-file ; defined in caller; file local here nil)) ;; ;; Set local variables in output buffer ;; (setq skyserver-query-buffer parent-buffer) (setq skyserver-jobtype jobtype) (local-set-key "\C-c\C-f" 'skyserver-show-query) (local-set-key "\C-c\C-l" '(lambda () (interactive) (skyserver-list-processes skyserver-query-buffer))) (local-set-key "\C-c:" 'skyserver-submit-sql-sync) (if (and (buffer-modified-p) (not skyserver-allow-overwrite) (not (y-or-n-p (format "Buffer %s is modified; continue? " buffer)))) (error "Query output buffer is modified")) (if (not append) (progn (toggle-read-only 0) (delete-region (point-min) (point-max)) (sit-for 0))) (set-buffer-modified-p nil) ;; ;; If there's a running process and we kill it, we don't want the ;; sentinel to notice; so install a nil sentinel ;; (setq proc (get-buffer-process buffer)) (if proc (set-process-sentinel proc '(lambda (a b)))) ;; ;; Is there already a process running? ;; (if (get-buffer-process buffer) (progn (skyserver-delete-process nil buffer t) (message "submitting new query") (setq mode-line-process ""))) ;; ;; Actually send command. If skyserver-send-url has two %s formats, ;; replace them by the data and command respectively (i.e. a POST request); ;; if it has one, replace it by the command-and-data (i.e. a GET request); ;; otherwise append the command-and-data (i.e. an implicit trailing %s) ;; (let ( (send-url skyserver-send-url) shell-command cgi-cmd cgi-data split cmd args ) (if (string-match "^\\([^?]*\\)\\?\\(.*\\)" command) (progn (setq cgi-cmd (match-string 1 command)) (setq cgi-data (match-string 2 command)))) (if (and skyserver-send-long-url skyserver-long-url-length (> skyserver-long-url-length 0) (> (length cgi-data) skyserver-long-url-length)) (setq send-url skyserver-send-long-url)) (setq shell-command (cond ((string-match "%F.*%s" send-url) ;; %F is name of temporary file (setq temp-filename (make-temp-file "Skyserver")) (skyserver-add-mortal-file temp-filename) ;mark for deletion (write-region cgi-data nil temp-filename) (string-match "%F" send-url) (format (replace-match "%s" t t send-url) temp-filename cgi-cmd)) ((string-match "%s.*%s" send-url) (format send-url cgi-data cgi-cmd)) ((string-match "%s" send-url) (format send-url command)) (t (concat send-url " " command)))) (setq split (split-string shell-command)) (setq cmd (nth 0 split)) (setq args (cdr split)) (if sync (progn (apply 'call-process cmd nil buffer nil args) (while (get-buffer-process buffer) (sit-for 1)) (if (and temp-filename (file-exists-p temp-filename)) (delete-file temp-filename))) (let ( (el) (args-ptr args) ) (while (setq el (car args-ptr)) (setcar args-ptr (if nil (shell-quote-argument el) (format "'%s'" el ))) (setq args-ptr (cdr args-ptr)))) (if write-file (let ( (file (buffer-file-name (get-buffer (skyserver-uniquified-buffer-name buffer)))) ) (if (string-match "^\\*+" file);buffer may have a "*" prepended (setq file (replace-match "" nil nil file))) (substring buffer 1) (setq skyserver-write-file file) ; local in this buffer (insert-string (format (concat "\nOutput will be " (if append-to-file "appended" "written directly") " to file %s\n") file)) (if (and skyserver-read-result-via-disk (not (equal t skyserver-writing-to-file))) (insert-string (format "\ and then read into this buffer when the command has completed This behaviour is controlled by the variable skyserver-read-result-via-disk which may be set using customize. If you don't want the results read for you, use e.g. ^U^C^C to specify the output buffer as \">%s\". " file))) (if (> (length skyserver-output-filter) 0) (progn (insert-string (format "\nOutput will be filtered through \"%s\"\n" skyserver-output-filter)) (setq args (append args (list "|" skyserver-output-filter))))) (set-buffer-modified-p nil) (setq args (append args (list (if append-to-file ">>" ">") file)))) (if (not skyserver-read-result-via-disk) (setq skyserver-write-file nil)) ; local in this buffer ) ;; deal with temp files (if (boundp 'skyserver-temp-filename) (skyserver-kill-mortal-file skyserver-temp-filename)) (setq skyserver-temp-filename temp-filename) ;; actually (apply 'start-process-shell-command "Query" buffer cmd args))) (setq proc (get-buffer-process buffer)) (if (not proc) (let ( (xml (and (not (string= jobtype "shortQuery")) (not (string= jobtype "query")))) ) (skyserver-format-buffer buffer xml) (set-buffer buffer) (set-buffer-modified-p nil) (local-set-key "\C-c\C-t" 'skyserver-table) (skyserver-mouse-install-mouse)) (set-buffer parent-buffer) (setq mode-line-process " Active") (force-mode-line-update) (set-buffer buffer) (local-set-key "\C-c\C-t" 'skyserver-table) (skyserver-mouse-install-mouse) (set (make-local-variable 'skyserver-parent-buffer) parent-buffer) (set (make-local-variable 'skyserver-start-time) (current-time)) (if (not sync) (progn (set-process-sentinel proc 'skyserver-sentinel) (set-process-filter proc 'skyserver-filter)))) (if (buffer-live-p (get-buffer ibuffer)) (set-buffer ibuffer))) buffer) ;; ;; Given a SQL query in the current buffer, transform it into a form ;; that can be passed to skyserver as an HTTP form request ;; (defun skyserver-mangle-query (query &optional buffer dont-drop-tables) "Format a query for transmission to the server" (if (not buffer) (setq buffer (skyserver-formatting-buffer "sync"))) (let ( (ibuffer (current-buffer)) ) (set-buffer (get-buffer-create buffer)) (delete-region (point-min) (point-max)) (insert query) (undo-boundary) (goto-char (point-min)) (setq case-fold-search t) (modify-syntax-entry ?_ "w") ; _ is part of a word (if skyserver-fake-tsql (save-excursion ;; Add \ as required; we do this so as to allow real t-sql code, which ;; doesn't require continuation characters. Currently we only add the ;; \ at the end of lines ending in a | or an & (goto-char (point-min)) (while (re-search-forward "\\(|\\|&\\)[ \t]*$" nil t) (replace-match (concat (match-string 1) "\\\\"))) ;; Handle include statements (goto-char (point-min)) (let ( included-files-alist ) (while (re-search-forward "^[ \t]*\\#[ \t]*include[ \t]+\"?\\([a-z0-9_./]+\\)\"?" nil t) (let ( (include-file (match-string 1)) ) (if (assoc include-file included-files-alist) (progn (message "Ignoring re-inclusion of %s" include-file) (sit-for 1)) (message "Including %s" include-file) (sit-for 0) (insert-file-contents include-file) (message "") (sit-for 0) (setq included-files-alist (cons (cons include-file t) included-files-alist))) (replace-match "") (goto-char (point-min))))) ;recursive inclusion is allowed )) ;; Strip comments. Preserve \ at the end of -- comments so that ;; they can appear within @variables. They aren't allowed within /* */ ;; as it's just too messy (save-excursion (goto-char (point-min)) (while (re-search-forward (concat "\f" "\\|" "--\\([^\n\\]\\|\\\\[^\n]\\)*" "\\|" "/\\*\\([^*]*\\*\\([^/]\\|$\\)\\)*[^*]*\\*/") nil t) (let ( (comment (match-string 0)) (val "") ) (save-match-data (while (string-match "\n" comment) (setq val (concat val "\n")) (setq comment (replace-match "" nil nil comment)))) (replace-match val t t)))) ;; Handle named constants. The syntax is: ;; set @name = value (if skyserver-fake-tsql (save-excursion (let ( (var) (type) (val) (eval) ) ;; Strip declarations; required by real Transact-SQL, ;; but we're faking things (goto-char (point-min)) (while (re-search-forward "declare[ \t]+\\(\\(@[a-zA-Z0-9_]+\\)[ \t]*\\(\\w+\\(([0-9]+)\\)?\\)\\)+" nil t) (setq var (match-string 2)) (setq type (downcase (match-string 3))) (skyserver-set-symbol var type nil nil) (replace-match "")) ;; Replace occurrences of @value; first read the definition (goto-char (point-min)) (while (re-search-forward "\\(set\\|select\\)[ \t]+\\(@[a-zA-Z0-9_]+\\)[ \t]*=[ \t]*\\([^\n\\\\]*\\)\\(\\\\[ \t]*\\)?$" nil t) (setq var (match-string 2)) (setq val (match-string 3)) (replace-match "") (if (match-beginning 4) ; saw continuation character (let ( (append t) ) (while append (forward-line 1) (beginning-of-line) (re-search-forward "\\([^\n\\]*\\)\\(\\\\[ \t]*\\)?$" (line-end-position) t) (setq val (concat val (match-string 1))) (setq append (match-string 2)) (replace-match "")))) ;; ;; Lookup that symbol and see if it has an expanded value; ;; if it does have an expanded value, use it; if it doesn't, ;; query the database to look it up ;; E.g. dbo.fPhotoStatus('OK_RUN') --> 16 ;; (setq eval nil) (let* ( (symb-entry (skyserver-get-symbol var t)) (symb-val (nth 0 symb-entry)) (symb-eval (nth 1 symb-entry)) (symb-type (skyserver-get-symbol-type var)) ) (if (and (not (string-match "\\\\|@" val)) ;always re-eval these (equal symb-val val) symb-eval) (setq eval symb-eval)) (if symb-type (setq type symb-type) (error (concat "Symbol " var " has not been declared")))) (if (not eval) (setq eval (skyserver-eval-expr (skyserver-expand-expr val (or (equal "char" type) (equal "varchar" type))) (or (equal "int" type) (equal "bigint" type))))) ; Write bigints in hex (if (and (string= type "bigint") (string-match "^[0-9]+$" eval)) (setq eval (bigint-to-string (bigint-string-to-bigint eval "hex")))) (skyserver-set-symbol var type val eval) (if nil ; debugging (progn (message (format "%s : %s [%s]" var val (cond (eval eval) (t "")))) (sleep-for 1))) (if eval (setq val eval)) ; use expanded value ;; ;; Maybe check that that value has the desired type ;; (if skyserver-check-tsql-initialization (let ( allowed ) (cond ((string-match "^\\(decimal\\|float\\|numeric\\|real\\)$" type) (setq allowed "[-+]?\\([0-9]+\\.[0-9]*\\|\\.?[0-9]+\\)\\(e[-+]?[0-9]+\\)?[ \t]*$")) ((string-match "^\\(big\\|small\\|tiny\\)?int$" type) (setq allowed "\\([-+]?[0-9]+\\|0x[0-9a-f]+\\)[ \t]*$"))) (if (and allowed (not (string-match (concat "^[ \t]*" allowed) val))) (let ( msg ) (if (and eval (not (string-equal val eval))) (setq msg (format "Invalid initialisation for %s %s: %s (%s)" type var eval val))) (setq msg (format "Invalid initialisation for %s %s: %s" type var val)) (skyserver-set-symbol var nil 'delete) (error msg))))) )) ;; ;; Make those substitutions of @variables ;; (goto-char (point-min)) (let ( (table-ptr skyserver-symbtable) var val regexp ) (while table-ptr (setq var (car (car table-ptr))) (setq val (skyserver-get-symbol var)) (setq var (substring var 1)) ;strip @ (setq regexp (concat "@\\(" var "\\>\\|{" var "}\\)")) (save-excursion (while (re-search-forward regexp nil t) (if (not val) (error (format "Variable @%s is declared but not initialised" var))) (replace-match val t))) (setq table-ptr (cdr table-ptr)))))) ;; Handle requests to drop tables (do this after @variable expansion) (save-excursion (goto-char (point-min)) (let ( (end-of-search (if skyserver-handle-mydb-anywhere nil (save-excursion (re-search-forward "^[ \t]*select\\>" nil t)))) ) (while (re-search-forward "^[ \t]*\\(create\\|drop\\|truncate\\) table[ \t]+\\([a-z0-9_]+\\)\\.\\([a-z0-9_]+\\)\\([ \t]+\\(maybe\\)\\)?" end-of-search t) (let ( (action (downcase (match-string 1))) (db (match-string 2)) (table (match-string 3)) (maybe (match-string 5)) (body nil) ) (replace-match "") (if (string= action "create") (let ( (start (point)) end ) (save-excursion (forward-sexp) (setq end (point)) (setq body (buffer-substring-no-properties start end)) (delete-region start end)))) (if (and (or (not maybe) (y-or-n-p (format "%s %s? " action table))) (not dont-drop-tables)) (skyserver-handle-mydb-tables action db table body)))))) ;; ;; Maybe check for certain syntax errors; ;; currently only C-like syntax, the use of unexpanded @variables, and the ;; use of power() with an integer or low-precision numeric as the first argument ;; (if skyserver-check-query (let ( (Cisms '( ("==" "=") ("&&" "and") ("||" "or") ("\\" "atn2") ("\\" "power") ("\\" "log10") ("\\" "log") ("\\*\\*" "power"))) (starting-lineno (if (boundp 'skyserver-starting-lineno) skyserver-starting-lineno 1)) C SQL) (while Cisms (setq C (car (car Cisms))) (setq SQL (car (cdr (car Cisms)))) (setq Cisms (cdr Cisms)) (save-excursion (if (re-search-forward C nil t) (let ( (lineno (+ starting-lineno (count-lines (point-min) (line-beginning-position)))) ) (if (string-match "^\\(\\\\<\\)?\\([a-z0-9_]+\\)\\(\\\\>\\)?$" C) (setq C (match-string 2 C))) ; remove word anchors, \<...\> (error "Syntax error: C style expression \"%s\" at line %d (use \"%s\")" C lineno SQL))))) (if skyserver-fake-tsql (save-excursion (while (re-search-forward "@\\([{}a-zA-Z_0-9]+\\)" nil t) (let ( (var (match-string 0)) fixed-var ) (save-match-data (if (string-match "^@{}\\(.*\\)" var) (setq fixed-var (concat "@" (match-string 1 var))))) (if fixed-var (replace-match fixed-var) (error "Unexpanded TSQL variable \"%s\" at line %d" var (+ starting-lineno (count-lines (point-min) (line-beginning-position))) )))))) (save-excursion (while (re-search-forward "\\" nil t) (replace-match "bigint" nil t))) (save-excursion (while (re-search-forward "\\" nil t) (replace-match "count_big" nil t))))) (undo-boundary) ;; ;; This is what we mean by the "Submitted Query" ;; ;; Protect % first (save-excursion (while (re-search-forward "%" nil t) (replace-match "%25" nil t))) ;; Protect + & : | < > ; ' " (save-excursion (while (re-search-forward "\\+" nil t) (replace-match "%2b" nil t))) (save-excursion (while (re-search-forward "&" nil t) (replace-match "%26" nil t))) (save-excursion (while (re-search-forward ":" nil t) (replace-match "%3a" nil t))) (save-excursion (while (re-search-forward "|" nil t) (replace-match "%7c" nil t))) (save-excursion (while (re-search-forward "<" nil t) (replace-match "%3c" nil t))) (save-excursion (while (re-search-forward ">" nil t) (replace-match "%3e" nil t))) (save-excursion (while (re-search-forward ";" nil t) (replace-match "%3b" nil t))) (save-excursion (while (re-search-forward "'" nil t) (replace-match "%27" nil t))) (save-excursion (while (re-search-forward "\"" nil t) (replace-match "%22" nil t))) ;; remove blank lines before "select" (save-excursion (if (re-search-forward "^[ \t\n]+" nil t) (replace-match "" nil t))) ;; "distinct" and "select" may not be on a line by themselves, ;; so add a space (save-excursion (while (re-search-forward "\\(distinct\\|select\\|top +[0-9]+\\)\n" nil t) (replace-match "\\1 \n" t))) ;; Protect spaces (save-excursion (while (re-search-forward "\n" nil t) (replace-match (if skyserver-send-newlines "%0a" "+") nil t))) (save-excursion (while (re-search-forward "\t" nil t) (replace-match "%09" nil t))) (save-excursion (while (re-search-forward " " nil t) (replace-match "+" nil t))) (setq query (buffer-string)) (set-buffer ibuffer)) query) (defun skyserver-formatting-buffer (extension) "Return the name of the buffer that should be used to format a query, addding \"-EXTENSION\" to default name. If extension is NIL, use the current buffername" (let ( (basename "*skyServer-format-query") name ) (if (not extension) (setq extension (buffer-name))) (concat basename "-" extension))) ;; ;; reset the mode-line ;; (defun skyserver-set-mode-line-string (&optional proxlist) (setq skyserver-mode-line-string (concat " " (if proxlist "Proxlist" "SkyServer") (if skyserver-database-name (concat "(" (skyserver-database-fullname) ")")) (if (or (not (boundp 'skyserver-fake-tsql)) skyserver-fake-tsql) " @" " X@X") )) (force-mode-line-update)) ;; ;; Create/Drop/Truncate a mydb table ;; (defun skyserver-handle-mydb-tables (action db table &optional body) "Apply ACTION to TABLE from database DB. Action may be create, drop, or truncate" (save-window-excursion (let* ( (mydb "mydb") (at (if skyserver-fake-tsql "@{}" "@")) cmd (pparticiple (upcase-initials (cond ((string= action "create") "creating") ((string= action "drop") "dropping") ((string= action "truncate") "truncating") (t (error "I don't know how to perform action \"%s\"" action)) ))) ) (save-match-data (if (not (string-match db mydb)) (error (format "You may only %s tables from %s (saw %s.%s)" action mydb db table))) (cond ((string= action "create") (setq cmd (format " declare %sfoo bigint select %sfoo = count_big(*) from information_schema.tables where table_name = '%s' if %sfoo > 0 drop table %s\n" at at table at table)) (setq cmd (concat cmd (format "create table %s %s" table body))) ) (t (setq cmd (format " declare %sfoo bigint select %sfoo = count_big(*) from information_schema.tables where table_name = '%s' if %sfoo > 0 %s table %s" at at table at action table)))) (message "%s %s.%s" pparticiple db table) (sleep-for 1) (let ( error-msg ) (if (not (condition-case msg (skyserver-submit-sql-sync cmd db) (error (progn (setq error-msg (car (cdr msg))) nil)))) (progn (display-buffer (concat skyserver-default-output-buffer "*")) (message "Failed to %s %s.%s" action db table) (if (y-or-n-p "Abort query? ") (error error-msg))))) )))) ;; ;; Given a file consisting of lines of ;; ;; or ;; ;; format it so that can be passed to skyserver as an HTTP form request ;; (defun skyserver-mangle-proxlist (query name action search qclass qselect radius) "" (delete-region (point-min) (point-max)) (insert query) (undo-boundary) (goto-char (point-min)) ;; Strip comments starting -- or # (save-excursion (while (re-search-forward "[ \t]*\\(--\\|#\\).*[\r\n]*" nil t) (replace-match "" t t))) (undo-boundary) ;; Protect % first (save-excursion (while (re-search-forward "%" nil t) (replace-match "%25" nil t))) ;; Protect + (save-excursion (while (re-search-forward "\\+" nil t) (replace-match "%2b" nil t))) ;; Protect spaces after stripping leading whitespace (save-excursion (while (re-search-forward "^[ \t]+" nil t) (replace-match "" t t))) (save-excursion (while (re-search-forward "\n" nil t) (replace-match (if skyserver-send-newlines "%0a" "+") nil t))) (save-excursion (while (re-search-forward "\t" nil t) (replace-match "%09" nil t))) (save-excursion (while (re-search-forward " " nil t) (replace-match "+" nil t))) ;; ;; ;; (goto-char (point-min)) (insert (skyserver-build-url name action)) (insert "paste=") (goto-char (point-max)) (save-match-data (setq search (cond ((string-match "^\\(a\\|all\\)$" search) "a") ((string-match "^\\(n\\|near\\(est\\)?\\)$" search) "n"))) (setq qclass (cond ((string-match "^\\(a\\|all\\|everything\\)$" qclass) "a") ((string-match "^\\(g\\|galax\\(y\\|ies\\)\\)$" qclass) "g") ((string-match "^\\(s\\|stars?\\)$" qclass) "s"))) (setq qselect (cond ((string-match "^\\(c\\|count\\)$" qselect) "c") ((string-match "^\\(u\\|url\\)$" qselect) "u") ((string-match "^\\(t\\|tiny\\)$" qselect) "t") ((string-match "^\\(s\\|small\\)$" qselect) "s") ((string-match "^\\(m\\|medium\\)$" qselect) "m") ((string-match "^\\(l\\|large\\)$" qselect) "l")))) (insert (format "&search=%s" search)) (insert (format "&qclass=%s" qclass)) (insert (format "&qselect=%s" qselect)) (insert (format "&radius=%f" radius)) (if skyserver-csv-output (insert "&format=csv") (insert "&format=xml")) (buffer-string)) ;; ;; Build a complete URL for the skyserver ;; (defun skyserver-build-url (name &optional url-base) "Build a complete URL from url-base (a part of a URL) to go to the skyserver" (if url-base (setq url-base (concat "/" url-base))) (let ( (host (skyserver-get-param name 'host)) (path (skyserver-get-param name 'path)) ) (if (skyserver-use-password name) (let ( db version ) (save-match-data (string-match "^\\([^/]+\\)\\(/\\(.*\\)\\)?$" path) (setq db (match-string 1 path)) (setq version (if (match-string 3 path) (match-string 3 path) "")) (if (not (string-match "pw$" db)) (setq db (concat db "pw"))) (setq path (concat db "/" version))) (if (not skyserver-passwd) (skyserver-passwd)) (concat "http://" skyserver-user ":" skyserver-passwd "@" host "/" path url-base)) (concat "http://" host "/" path url-base)))) ;; ;; Cleanup the output buffer, or a region thereof ;; (defun skyserver-format-buffer (buffer &optional xml min max raw) "Cleanup the skyserver output buffer, or a region thereof" (if (not min) (setq min (point-min))) (if (not max) (setq max (point-max))) (set-buffer (get-buffer-create buffer)) (goto-char min) (toggle-read-only 0) (save-excursion (while (search-forward " " max t) (replace-match ""))) (setq xml nil) ;XXX (setq xml (or xml (looking-at "<\\?xml"))) (cond (raw t) ((or (save-excursion (re-search-forward "^