+++ /dev/null
-{}
\ No newline at end of file
+++ /dev/null
-;;; ejc-autocomplete.el -- SQL completitions at point (the part of ejc-sql).
-
-;;; Copyright © 2013-2016 - Kostafey <kostafeyNOSPAMgmail.com>
-
-;;; This program is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 2, or (at your option)
-;;; any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program; if not, write to the Free Software Foundation,
-;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
-
-;;; Code:
-
-(require 'dash)
-(require 'auto-complete)
-(require 'ejc-lib)
-
-(defun ejc-get-prefix-word ()
- "Return the word preceding dot before the typing."
- (save-excursion
- (let ((space-dist (or (save-excursion
- (re-search-backward "[ \n\t\r]+" nil t))
- 0))
- (dot (search-backward "." nil t))
- (space (re-search-backward "[ \n\t\r.]+" nil t)))
- (if (and dot
- space
- (> dot space)
- (<= space-dist space)) ; is a dot completition
- (buffer-substring (1+ space) dot)
- nil))))
-
-(defvar ejc-ansi-sql-words
- '("select" "where" "and" "or" "from" "insert" "update" "delete" "join"
- "order" "by" "distinct" "create" "alter" "drop"
- "grant" "revoke" "deny" "commit" "rollback" "savepoint"))
-
-(defvar ejc-auxulary-sql-words
- '("show" "errors" "desc" "count" "type" "table" "function" "procedure"
- "begin" "end" "for" "return"))
-
-(defun ejc-get-ansi-sql-words ()
- (append ejc-ansi-sql-words
- ejc-auxulary-sql-words
- (mapcar 'upcase ejc-ansi-sql-words)
- (mapcar 'upcase ejc-auxulary-sql-words)))
-
-(defun ejc-not-nil-str (s)
- (not (equal s "nil")))
-
-;;;###autoload
-(defun ejc-candidates ()
- "Possible completions list according to already typed prefixes."
- (let* ((prefix-1 (ejc-get-prefix-word))
- (prefix-2 (save-excursion
- (search-backward "." nil t)
- (ejc-get-prefix-word)))
- (result (ejc-get-stucture ejc-db prefix-1 prefix-2))
- (pending (car result))
- (candidates-cache (cdr result)))
- (if (ejc-not-nil-str pending)
- (message "Receiving database structure (%s)..." pending))
- (if (and (not prefix-1) (not prefix-2))
- (append candidates-cache (ejc-get-ansi-sql-words))
- candidates-cache)))
-
-(defun ejc-return-point ()
- "Return point position if point (cursor) is located next to dot char (.#)"
- (let ((curr-char (buffer-substring
- (save-excursion
- (left-char 1)
- (point))
- (point))))
- (if (equal curr-char ".")
- (point)
- nil)))
-
-(defvar ac-source-ejc-sql
- '((candidates . ejc-candidates)
- (requires . 1)
- (cache . t)))
-
-(defvar ac-source-ejc-sql-point
- '((candidates . ejc-candidates)
- (prefix . ejc-return-point)
- (requires . 0)
- (cache . t)))
-
-;;;###autoload
-(defun ejc-ac-setup ()
- "Add the completion sources to the front of `ac-sources'.
-This affects only the current buffer."
- (interactive)
- (add-to-list 'ac-sources 'ac-source-ejc-sql)
- (add-to-list 'ac-sources 'ac-source-ejc-sql-point ))
-
-(provide 'ejc-autocomplete)
-
-;;; ejc-autocomplete.el ends here
+++ /dev/null
-;;; ejc-format.el -- SQL formatting library (the part of ejc-sql).
-
-;;; Copyright © 2012, 2013 - Kostafey <kostafeyNOSPAMgmail.com>
-
-;;; This program is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 2, or (at your option)
-;;; any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program; if not, write to the Free Software Foundation,
-;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
-
-;;; Code:
-
-(require 'cua-base)
-(require 'ejc-lib)
-(require 'subr-x)
-
-(defvar ejc-sql-separator "/"
- "The char with purpose to separate the SQL statement both other.")
-
-(font-lock-add-keywords
- 'sql-mode '(("/" 0 'font-lock-function-name-face t)))
-
-(defun ejc-get-sql-boundaries-at-point ()
- "Returns list of the boundaries of the current SQL expression.
-The current SQL expression is the expression under the point.
-The boundaries are marked by `ejc-sql-separator's. If the top or
-bottom boundary is absent - it returns beginning or end of the
-buffer."
- (save-excursion
- (let* ((beg (progn
- (if (search-backward ejc-sql-separator nil t nil)
- (forward-char)
- (beginning-of-buffer))
- (point)))
- (end (progn
- (if (search-forward ejc-sql-separator nil t nil)
- (backward-char)
- (end-of-buffer))
- (point))))
- (list beg end))))
-
-(defmacro ejc--in-sql-boundaries (beg end &rest body)
- "Inject `beg' and `end' local variables to the `body' scope.
-`beg' and `end' are the boundaries of the current sql expression."
- `(let* ((boundaries (ejc-get-sql-boundaries-at-point))
- (,beg (car boundaries))
- (,end (car (cdr boundaries))))
- ,@body))
-
-(defun ejc-mark-this-sql ()
- "Select (mark) SQL around the point."
- (interactive)
- (ejc--in-sql-boundaries beg end
- (when mark-active
- (setq mark-active nil))
- (goto-char beg)
- (cua-set-mark)
- (goto-char end)))
-
-(defun ejc-next-sql (&optional mark)
- "Goto next SQL statement."
- (interactive)
- (ejc--in-sql-boundaries
- beg end
- (if (and mark (not mark-active))
- (cua-set-mark))
- (goto-char end)
- (right-char 1)))
-
-(defun ejc-previous-sql (&optional mark)
- "Goto previous SQL statement."
- (interactive)
- (ejc--in-sql-boundaries
- beg end
- (if (and mark (not mark-active))
- (cua-set-mark))
- (goto-char beg)
- (left-char 1)))
-
-(defun ejc-apply-in-sql-boundaries (func)
- (ejc--in-sql-boundaries beg end
- (apply func (list beg end))))
-
-(defun ejc-get-sql-at-point ()
- "Return SQL around the point."
- (ejc--in-sql-boundaries beg end
- (let ((sql (ejc-strip-text-properties (buffer-substring beg end))))
- sql)))
-
-(defmacro ejc-ensure-sql-mode (&rest body)
- `(if (not (equal major-mode 'sql-mode))
- (error "SQL formatting is suitable in sql-mode only.")
- (progn ,@body)))
-
-(defun ejc-format-sql (beg end)
- (interactive "r")
- (ejc-ensure-sql-mode
- (save-excursion
- (mapc (lambda (from-to)
- (ejc-apply-in-sql-boundaries
- (lambda (beg end)
- (replace-regexp (car from-to) (cadr from-to) nil beg end))))
- '(("\n" " ")
- ("," ", ")
- (" +" " ")
- ("," ",\n ")
- ("select" "select \n ")
- (" from " "\nfrom \n ")
- (" where " "\nwhere \n ")
- (" and " "\n and ")
- (" or " "\n or ")
- (" order by " "\norder by \n")
- (" inner join " "\ninner join ")
- (" left join " "\nleft join ")
- (" on " "\n on ")
- (" group by " "\ngroup by "))))))
-
-(defun ejc-format-sql-at-point ()
- (interactive)
- (ejc--in-sql-boundaries
- beg end
- (ejc-format-sql beg end)))
-
-(defun ejc-pretty-print-sql-at-point ()
- "Pretty-print SQL bounded by the `ejc-sql-separator' or/and buffer
-boundaries."
- (interactive)
- (ejc--in-sql-boundaries
- beg end
- (let ((result (ejc-pretty-print (buffer-substring beg end) :hibernate)))
- (delete-region beg end)
- (insert result))))
-
-(defun ejc-pretty-print-sql-region (beg end)
- "Pretty-print SQL bounded by the selection area."
- (interactive "r")
- (let ((result (ejc-pretty-print (buffer-substring beg end) :hibernate)))
- (delete-region beg end)
- (insert result)))
-
-(defun ejc-insert-file-header ()
- (interactive)
- (insert (concat "-- -*- mode: sql; -*-\n"
- "-- Local Variables:\n"
- "-- eval: (ejc-sql-mode)\n"
- "-- End:\n")))
-
-(defvar ejc-clear-sql-regexp
- (concat "^\\s-*\\t*\""
- "\\|\\\\n\"\s-*\\+$"
- "\\|\\\\n\";$"))
-
-(defun ejc-strinp-sql-at-point ()
- (interactive)
- (ejc--in-sql-boundaries
- beg end
- (save-excursion
- (replace-regexp ejc-clear-sql-regexp "" nil beg end)
- (whitespace-cleanup-region beg end))))
-
-(defun ejc-longest-line-length (beg-line end-line)
- (interactive)
- (save-excursion
- (let ((curr-line beg-line)
- (max-length 0)
- (new-length 0))
- (while (<= curr-line end-line)
- (goto-line curr-line)
- (setq new-length (save-excursion
- (end-of-line)
- (current-column)))
- (if (> new-length max-length)
- (setq max-length new-length))
- (setq curr-line (1+ curr-line)))
- max-length)))
-
-(defun ejc-is-separator-string (pos)
- (equal (string-trim (buffer-substring
- pos
- (save-excursion
- (end-of-line)
- (point))))
- ejc-sql-separator))
-
-(defun ejc-dress-sql-at-point ()
- (interactive)
- (ejc-strinp-sql-at-point)
- (save-excursion
- (ejc--in-sql-boundaries
- beg end
- (let* ((beg-line (progn (goto-char beg)
- (right-char)
- (line-number-at-pos)))
- (end-line (progn (goto-char end)
- (if (ejc-is-separator-string end)
- (left-char 1))
- (line-number-at-pos)))
- (length-line (ejc-longest-line-length beg-line end-line))
- (curr-line beg-line))
- (while (<= curr-line end-line)
- (goto-line curr-line)
- (beginning-of-line)
- (insert-string "\"")
- (end-of-line)
- (dotimes (counter (+ 2 (- length-line (current-column))))
- (insert-string " "))
- (if (equal curr-line end-line)
- (insert-string "\\n\";")
- (insert-string "\\n\" +"))
- (setq curr-line (1+ curr-line)))))))
-
-(defun ejc-flash-region (start end &optional timeout)
- "Temporarily highlight region from START to END."
- (let ((overlay (make-overlay start end)))
- (overlay-put overlay 'face 'secondary-selection)
- (run-with-timer (or timeout 0.2) nil 'delete-overlay overlay)))
-
-(defun ejc-flash-this-sql ()
- "Select (mark) SQL around the point."
- (interactive)
- (ejc--in-sql-boundaries
- beg end
- (ejc-flash-region beg end)))
-
-(provide 'ejc-format)
-
-;;; ejc-format.el ends here
+++ /dev/null
-;;; ejc-interaction.el -- ejc-sql interact with Clojure. -*- lexical-binding: t -*-
-
-;;; Copyright © 2013-2017 - Kostafey <kostafeyNOSPAMgmail.com>
-
-;;; This program is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 2, or (at your option)
-;;; any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program; if not, write to the Free Software Foundation,
-;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
-
-;;; Code:
-
-(require 'ejc-lib)
-(require 'ejc-format)
-(require 'clomacs)
-
-(clomacs-defun ejc-sql-set-db
- set-db
- :lib-name "ejc-sql"
- :namespace ejc-sql.connect
- :doc "Define ejc-sql.connect/db var.")
-
-(clomacs-defun ejc-jpa-connect
- ejc-sql.jpa/connect-plain
- :lib-name "ejc-sql"
- :namespace ejc-sql.jpa
- :doc "Define ejc-sql.jpa/em var.")
-
-(clomacs-defun ejc-add-classpath
- add-classpath
- :lib-name "ejc-sql"
- :namespace cemerick.pomegranate)
-
-(clomacs-defun ejc-require
- clojure.core/require
- :lib-name "ejc-sql")
-
-(clomacs-defun ejc-import
- clojure.core/import
- :lib-name "ejc-sql")
-
-(defun ejc-connect-to-db (conn-struct)
- (ejc-require `'cemerick.pomegranate)
- (cl-case (ejc-get-connection-type conn-struct)
- ;;----------------------------------------------------------------------
- ;; is JDBC/SQL
- (:sql
- (ejc-add-classpath (ejc-db-conn-classpath conn-struct))
- (ejc-import (read (ejc-db-conn-classname conn-struct)))
- (ejc-sql-set-db (ejc-connection-struct-to-plist conn-struct)))
- ;;----------------------------------------------------------------------
- ;; is JPA/JPQL
- (:jpa
- (ejc-jpa-connect (ejc-jpa-connection-name conn-struct)
- (ejc-jpa-persistent-xml-url conn-struct)
- (ejc-jpa-domain-objects-url conn-struct)
- (ejc-jpa-jdbc-driver-url conn-struct))))
- (setq-local ejc-connection-struct conn-struct))
-
-(defun ejc-get-sql-from-string (sql)
- (let* ((sql (replace-regexp-in-string ejc-clear-sql-regexp "" sql))
- (sql (replace-regexp-in-string "\"" "'" sql)))
- sql))
-
-(clomacs-defun ejc--eval-sql-and-log
- ejc-sql.connect/eval-sql-and-log
- :lib-name "ejc-sql"
- :namespace ejc-sql.connect
- :doc "Evaluate user's SQL scripts and write them to log file.")
-
-(clomacs-defun ejc--eval-sql-and-log-print
- ejc-sql.connect/eval-sql-and-log-print
- :lib-name "ejc-sql"
- :namespace ejc-sql.connect
- :return-type :string
- :return-value :stdout)
-
-(clomacs-defun ejc--eval-jpql
- ejc-sql.jpa/eval-jpql-print
- :lib-name "ejc-sql"
- :namespace ejc-sql.jpa
- :return-type :string
- :return-value :stdout)
-
-(defun ejc-eval-sql-and-log (db sql &optional call-type callback)
- "Core function to evaluate SQL queries.
-Prepare SQL string, evaluate SQL script and write them to log file"
- (if sql
- (let* ((prepared-sql (ejc-get-sql-from-string sql))
- (result (cl-case (ejc-get-connection-type ejc-connection-struct)
- (:sql
- (progn
- (if (and (equal call-type :async) callback)
- (let* ((buf (current-buffer))
- (eval-sql-and-log-async
- (clomacs-defun _
- ejc-sql.connect/eval-sql-and-log-print
- :lib-name "ejc-sql"
- :namespace ejc-sql.connect
- :call-type :async
- :callback (lambda (res)
- (funcall callback res)
- (with-current-buffer buf
- (spinner-stop)))
- :return-type :string
- :return-value :stdout)))
- (spinner-start 'rotating-line)
- (funcall eval-sql-and-log-async db prepared-sql))
- (ejc--eval-sql-and-log-print db prepared-sql))))
- (:jpa (ejc--eval-jpql prepared-sql))
- (nil "No database connection."))))
- result)))
-
-(clomacs-defun ejc--eval-sql-get-column
- ejc-sql.connect/eval-sql-internal-get-column
- :lib-name "ejc-sql"
- :return-type :list
- :namespace ejc-sql.connect
- :doc "Get `sql', return list.")
-
-(defalias 'ejc--eval-get-list 'ejc--eval-sql-get-column)
-
-(clomacs-defun ejc--get-table-meta
- ejc-sql.connect/get-table-meta
- :lib-name "ejc-sql"
- :namespace ejc-sql.connect)
-
-(clomacs-defun ejc-print
- clojure.core/print
- :lib-name "ejc-sql"
- :return-type :string
- :return-value :stdout)
-
-(defun ejc-get-table-meta (db table-name)
- (ejc-print (ejc--get-table-meta db table-name)))
-
-(clomacs-defun ejc-get-log-file-path
- print-log-file-path
- :lib-name "ejc-sql"
- :namespace ejc-sql.output
- :return-value :stdout)
-
-(clomacs-defun ejc-pretty-print
- pretty-print
- :lib-name "ejc-sql"
- :namespace ejc-sql.output
- :return-value :stdout)
-
-(clomacs-defun ejc-set-rows-limit
- set-rows-limit
- :lib-name "ejc-sql"
- :namespace ejc-sql.output
- :doc (concat "Set limit for number of records to output. "
- "When nil no limit."))
-
-(clomacs-defun ejc-get-stucture
- get-stucture
- :lib-name "ejc-sql"
- :namespace ejc-sql.structure
- :return-type :list)
-
-(clomacs-defun get-cached-tables-list
- get-tables
- :lib-name "ejc-sql"
- :namespace ejc-sql.structure
- :return-type :list
- :doc "Return cached tables list.
- Requires `ejc-db' buffer local variable as parameter.")
-
-(clomacs-defun get-cached-colomns-list
- get-colomns
- :lib-name "ejc-sql"
- :namespace ejc-sql.structure
- :return-type :list
- :doc "Return cached tables list.
- Requires `ejc-db' buffer local variable and table name as parameters.")
-
-(clomacs-defun ejc-invalidate-cache-inner
- invalidate-cache
- :lib-name "ejc-sql"
- :namespace ejc-sql.structure
- :doc (concat "Clean your current connection cache "
- "(database owners and tables list)."))
-
-(defun ejc-invalidate-cache ()
- "Clean current connection cache (database owners and tables list)."
- (interactive)
- (ejc-invalidate-cache-inner ejc-connection-struct))
-
-(clomacs-defun ejc-get-cache
- get-cache
- :lib-name "ejc-sql"
- :namespace ejc-sql.structure)
-
-(clomacs-defun ejc-select-db-meta-script
- select-db-meta-script
- :lib-name "ejc-sql"
- :namespace ejc-sql.structure)
-
-(defun ejc-quit-connection ()
- "Stop nREPL process, mark ejc-sql-mode buffers disconnected."
- (interactive)
- (when (y-or-n-p "Are you sure you want to close all jdbc connections?")
- (cider--quit-connection (clomacs-get-connection "ejc-sql"))
- ;; Update modeline of ejc-sql-mode buffers - mark as disconnected.
- (let ((buffers (buffer-list)))
- (while buffers
- (with-current-buffer (car buffers)
- (when (equal major-mode ejc-sql-mode)
- (sql-highlight-product)))
- (setq buffers (cdr buffers)))))
- (unless (cider-connected-p)
- (cider-close-ancillary-buffers)))
-
-(provide 'ejc-interaction)
-
-;;; ejc-interaction.el ends here
+++ /dev/null
-;;; ejc-lib.el -- ejc-sql shared objects (the part of ejc-sql).
-
-;;; Copyright © 2013-2016 - Kostafey <kostafeyNOSPAMgmail.com>
-
-;;; This program is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 2, or (at your option)
-;;; any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program; if not, write to the Free Software Foundation,
-;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
-
-;;; Code:
-
-(require 'dash)
-
-(defvar-local ejc-connection-name nil
- "Buffer-local connection name created with `ejc-create-connection'.")
-
-(defvar-local ejc-connection-struct nil
- "Buffer-local connection structure.")
-
-(defun ejc-string-endswith-p (s ending)
- "Return non-nil if string S ends with ENDING."
- (let ((elength (length ending)))
- (string= (substring s (- 0 elength)) ending)))
-
-(defun ejc-get-connection-type (conn-struct)
- "JDBC/SQL, JPA/JPQL or Hibernate/HQL connection type."
- (cond
- ((ejc-db-conn-p conn-struct) :sql)
- ((ejc-jpa-p conn-struct) :jpa)
- (t nil)))
-
-(cl-defstruct ejc-db-conn
- "DB connection information structure"
- ; path to jdbc jar file
- (classpath "<path>/<filename>.jar")
- ; the JDBC driver class
- (classname "<com.povider.jdbc.DataBaseDriver>")
- ; the kind of database, e.g:
- ; informix-sqli, mysql, postgresql,
- ; oracle, sqlserver, etc.
- (subprotocol "<sql-kind>")
- ; db connection path
- ; locale, like ru_RU.1251
- (database "<my-databse>")
- (subname (concat
- "://<db-host>:<db-port>:"
- "<db-server>=<server-name>;"
- "database=<db-name>;"
- "DB_LOCALE=<locale>;"
- "CLIENT_LOCALE=<locale>;"
- ))
- (user "<user-name>")
- (password "<password>")
- (connection-uri "jdbc:<povider>://[serverName[\instanceName][:portNumber]][;property=value[;property=value]]")
- (separator ";"))
-
-(cl-defstruct ejc-jpa
- "DB connection information structure for JPA"
- (type :jpa)
- (connection-name "<persistence-unit name=")
- (persistent-xml-url "path to META-INF/persistence.xml")
- (domain-objects-url "path to classes/")
- (jdbc-driver-url "<path>/<filename>.jar"))
-
-(defun ejc-connection-struct-to-plist (conn-struct)
- (-filter
- (lambda (x) (cdr x))
- (list
- `(:classname . ,(ejc-db-conn-classname conn-struct))
- `(:subprotocol . ,(ejc-db-conn-subprotocol conn-struct))
- `(:subname . ,(ejc-db-conn-subname conn-struct))
- `(:user . ,(ejc-db-conn-user conn-struct))
- `(:password . ,(ejc-db-conn-password conn-struct))
- `(:database . ,(ejc-db-conn-database conn-struct))
- `(:separator . ,(ejc-db-conn-separator conn-struct))
- `(:connection-uri . ,(ejc-db-conn-connection-uri conn-struct)))))
-
-(defun ejc-find-file-in-load-path (search-file-name &optional fail-on-error)
- "Return the full path to `file-name'.
-`file-name' is searching in the emacs `load-path'."
- (let ((result nil))
- (dolist (path load-path)
- (let ((search-file-path (expand-file-name search-file-name path)))
- (if (file-exists-p search-file-path)
- (setq result search-file-path))))
- (if (and fail-on-error (not result))
- (error (concat "Can't find file " search-file-name))
- result)))
-
-(defun ejc-strip-text-properties (txt)
- (set-text-properties 0 (length txt) nil txt)
- txt)
-
-(provide 'ejc-lib)
-
-;;; ejc-lib.el ends here
+++ /dev/null
-;;; ejc-result-mode.el
-
-;;; Copyright © 2017 - Kostafey <kostafeyNOSPAMgmail.com>
-
-;;; This program is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 2, or (at your option)
-;;; any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program; if not, write to the Free Software Foundation,
-;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
-
-;;; Code:
-
-(defface ejc-result-table-borders-face '((t :inherit font-lock-comment-face))
- "Face used to font-lock table borders."
- :group 'ejc-sql-faces)
-
-(defconst ejc-result-font-lock-keywords
- '(("|" . 'ejc-result-table-borders-face)
- ("-" . 'ejc-result-table-borders-face)
- ("+" . 'ejc-result-table-borders-face)))
-
-(defun ejc-result-mode ()
- (interactive)
- (kill-all-local-variables)
- (setq truncate-lines t)
- (setq major-mode 'ejc-result-mode
- mode-name "SQL-Result")
- (setq font-lock-defaults '(ejc-result-font-lock-keywords)))
-
-(provide 'ejc-result-mode)
-
-;;; ejc-result-mode.el ends here
+++ /dev/null
-;;; ejc-sql-autoloads.el --- automatically extracted autoloads
-;;
-;;; Code:
-(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
-\f
-;;;### (autoloads nil "ejc-autocomplete" "ejc-autocomplete.el" (22692
-;;;;;; 30293 0 0))
-;;; Generated autoloads from ejc-autocomplete.el
-
-(autoload 'ejc-candidates "ejc-autocomplete" "\
-Possible completions list according to already typed prefixes.
-
-\(fn)" nil nil)
-
-(autoload 'ejc-ac-setup "ejc-autocomplete" "\
-Add the completion sources to the front of `ac-sources'.
-This affects only the current buffer.
-
-\(fn)" t nil)
-
-;;;***
-\f
-;;;### (autoloads nil "ejc-sql" "ejc-sql.el" (22692 30293 0 0))
-;;; Generated autoloads from ejc-sql.el
-
-(autoload 'ejc-sql-mode "ejc-sql" "\
-Toggle ejc-sql mode.
-
-\(fn &optional ARG)" t nil)
-
-(autoload 'ejc-create-menu "ejc-sql" "\
-
-
-\(fn)" nil nil)
-
-;;;***
-\f
-;;;### (autoloads nil nil ("ejc-format.el" "ejc-interaction.el" "ejc-lib.el"
-;;;;;; "ejc-result-mode.el" "ejc-sql-pkg.el") (22692 30293 0 0))
-
-;;;***
-\f
-;; Local Variables:
-;; version-control: never
-;; no-byte-compile: t
-;; no-update-autoloads: t
-;; End:
-;;; ejc-sql-autoloads.el ends here
+++ /dev/null
-(define-package "ejc-sql" "20170215.321" "Emacs SQL client uses Clojure JDBC."
- '((emacs "24.4")
- (clomacs "0.0.2")
- (cider "0.14")
- (dash "2.12.1")
- (auto-complete "1.5.1")
- (spinner "1.7.1"))
- :url "https://github.com/kostafey/ejc-sql" :keywords
- '("sql" "jdbc"))
-;; Local Variables:
-;; no-byte-compile: t
-;; End:
+++ /dev/null
-;;; ejc-sql.el --- Emacs SQL client uses Clojure JDBC. -*- lexical-binding: t -*-
-
-;;; Copyright © 2012-2017 - Kostafey <kostafeyNOSPAMgmail.com>
-
-;; Author: Kostafey <kostafeyNOSPAMgmail.com>
-;; URL: https://github.com/kostafey/ejc-sql
-;; Keywords: sql, jdbc
-;; Version: 0.0.1
-;; Package-Requires: ((emacs "24.4")(clomacs "0.0.2")(cider "0.14")(dash "2.12.1")(auto-complete "1.5.1")(spinner "1.7.1"))
-
-;; This file is not part of GNU Emacs.
-
-;;; This program is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 2, or (at your option)
-;;; any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program; if not, write to the Free Software Foundation,
-;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
-
-;;; Commentary:
-
-;; ejc-sql turns Emacs into simple SQL client, it uses JDBC connection to
-;; databases via clojure/java.jdbc lib.
-
-;; See README.md for detailed description.
-
-;;; Code:
-
-(require 'sql)
-(require 'dash)
-(require 'cl-lib)
-(require 'ejc-lib)
-(require 'ejc-format)
-(require 'ejc-interaction)
-(require 'ejc-result-mode)
-(require 'ejc-autocomplete)
-
-(defvar-local ejc-db nil
- "JDBC connection info for current SQL buffer.")
-
-(defvar ejc-connections nil
- "List of existing configured jdbc connections")
-
-(defvar ejc-results-buffer nil
- "The results buffer.")
-
-(defvar ejc-results-buffer-name "*ejc-sql-output*"
- "The results buffer name.")
-
-(defvar ejc-sql-editor-buffer-name "*ejc-sql-editor*"
- "The buffer for conveniently edit ad-hoc SQL scripts.")
-
-(defvar ejc-show-results-buffer t
- "When t show results in separate buffer, use minibuffer otherwise.")
-
-(defvar ejc-sql-mode-keymap (make-keymap) "ejc-sql-mode keymap.")
-(define-key ejc-sql-mode-keymap (kbd "C-c C-c") 'ejc-eval-user-sql-at-point)
-(define-key ejc-sql-mode-keymap (kbd "C-x S") 'ejc-eval-user-sql-region)
-(define-key ejc-sql-mode-keymap (kbd "C-x <up>") 'ejc-show-last-result)
-(define-key ejc-sql-mode-keymap (kbd "C-h t") 'ejc-describe-table)
-(define-key ejc-sql-mode-keymap (kbd "C-h T") 'ejc-describe-entity)
-(define-key ejc-sql-mode-keymap (kbd "C-c t") 'ejc-show-tables-list)
-(define-key ejc-sql-mode-keymap (kbd "C-c T") 'ejc-show-user-types-list)
-(define-key ejc-sql-mode-keymap (kbd "C-c s") 'ejc-strinp-sql-at-point)
-(define-key ejc-sql-mode-keymap (kbd "C-c S") 'ejc-dress-sql-at-point)
-(define-key ejc-sql-mode-keymap (kbd "C-c p") 'ejc-pretty-print-sql-at-point)
-(define-key ejc-sql-mode-keymap (kbd "C-S-s-<up>") '(lambda() (interactive) (ejc-previous-sql t)))
-(define-key ejc-sql-mode-keymap (kbd "C-S-s-<down>") '(lambda() (interactive) (ejc-next-sql t)))
-(define-key ejc-sql-mode-keymap (kbd "C-s-<up>") 'ejc-previous-sql)
-(define-key ejc-sql-mode-keymap (kbd "C-s-<down>") 'ejc-next-sql)
-
-(defvar ejc-sql-minor-mode-exit-hook nil
- "*Functions to be called when `ejc-sql-mode' is exited.")
-
-(defvar ejc-sql-minor-mode-hook nil
- "*Functions to be called when `ejc-sql-mode' is entered.")
-
-(defvar ejc-sql-mode nil)
-
-;;;###autoload
-(define-minor-mode ejc-sql-mode
- "Toggle ejc-sql mode."
- :lighter " ejc"
- :keymap ejc-sql-mode-keymap
- :group 'ejc
- :global nil
- ;; :after-hook (ejc-create-menu)
- (if ejc-sql-mode
- (progn
- (ejc-ac-setup)
- (ejc-create-menu)
- (run-hooks 'ejc-sql-minor-mode-hook))
- (progn
- ;; (global-unset-key [menu-bar ejc-menu])
- (run-hooks 'ejc-sql-minor-mode-exit-hook))))
-
-;;;###autoload
-(defun ejc-create-menu ()
- (define-key-after
- ejc-sql-mode-keymap
- [menu-bar ejc-menu]
- (cons "ejc-sql" (make-sparse-keymap "ejc-sql mode"))
- 'tools )
- (define-key
- ejc-sql-mode-keymap
- [menu-bar ejc-menu ev]
- '("Eval SQL" . ejc-eval-user-sql-at-point))
- (define-key
- ejc-sql-mode-keymap
- [menu-bar ejc-menu fs]
- '("Format SQL" . ejc-format-sql-at-point))
- (define-key
- ejc-sql-mode-keymap
- [menu-bar ejc-menu ms]
- '("Mark SQL" . ejc-mark-this-sql))
- (define-key
- ejc-sql-mode-keymap
- [menu-bar ejc-menu tl]
- '("Show tables list" . ejc-show-tables-list))
- (define-key
- ejc-sql-mode-keymap
- [menu-bar ejc-menu cl]
- '("Show constraints list" . ejc-show-constraints-list))
- (define-key
- ejc-sql-mode-keymap
- [menu-bar ejc-menu pl]
- '("Show procedures list" . ejc-show-procedures-list))
- (define-key
- ejc-sql-mode-keymap
- [menu-bar ejc-menu ss]
- '("Strip SQL" . ejc-strinp-sql-at-point))
- (define-key
- ejc-sql-mode-keymap
- [menu-bar ejc-menu ds]
- '("Dress SQL" . ejc-dress-sql-at-point))
- (define-key
- ejc-sql-mode-keymap
- [menu-bar ejc-menu ol]
- '("Open log" . ejc-open-log))
- (define-key
- ejc-sql-mode-keymap
- [menu-bar ejc-menu sl]
- '("Show last result" . ejc-show-last-result))
- (define-key
- ejc-sql-mode-keymap
- [menu-bar ejc-menu qc]
- '("Quit connection" . ejc-quit-connection)))
-
-(cl-defun ejc-create-connection (connection-name
- &key
- classpath
- classname
- subprotocol
- subname
- subname
- user
- password
- database
- connection-uri
- separator)
- "Add new connection configuration named CONNECTION-NAME
-to `ejc-connections' list or replace existing with the same CONNECTION-NAME."
- (setq ejc-connections (-remove (lambda (x) (equal (car x) connection-name))
- ejc-connections))
- (setq ejc-connections (cons (cons
- connection-name
- (make-ejc-db-conn
- :classpath (file-truename classpath)
- :classname classname
- :subprotocol subprotocol
- :subname subname
- :user user
- :password password
- :database database
- :connection-uri connection-uri
- :separator separator))
- ejc-connections)))
-
-(defun ejc-find-connection (connection-name)
- "Return pair with name CONNECTION-NAME and db connection structure from
-`ejc-connections'."
- (-find (lambda (x) (equal (car x) connection-name))
- ejc-connections))
-
-(defvar ejc-product-assoc
- '((sqlserver . ms)))
-
-(defun ejc-configure-sql-buffer (product-name)
- (sql-mode)
- (sql-set-product (or (cdr (assoc product-name ejc-product-assoc))
- (car (assoc product-name sql-product-alist))
- "ansi"))
- (auto-complete-mode t)
- (auto-fill-mode t)
- (ejc-sql-mode)
- (ejc-sql-mode t))
-
-(defun ejc-connect (connection-name)
- "Connect to selected db."
- (interactive
- (list
- (ido-completing-read "DataBase connection name: "
- (mapcar 'car ejc-connections))))
- (let ((db (cdr (ejc-find-connection connection-name))))
- (ejc-configure-sql-buffer (ejc-db-conn-subprotocol db))
- (setq-local ejc-connection-name connection-name)
- (setq-local ejc-db (ejc-connection-struct-to-plist db))
- (message "Connection started...")
- (ejc-connect-to-db db)
- (setq mode-name (format "%s->[%s]" mode-name connection-name))
- (message "Connected.")))
-
-(defun ejc-get-word-at-point (pos)
- "Return SQL word around the point."
- (interactive "d")
- (let* ((char (char-after pos))
- (str (char-to-string char)))
- (save-excursion
- (let* ((end (if (member str '(" " ")" "<" ">" "="))
- (point)
- (progn
- (forward-sexp 1)
- (point))))
- (beg (progn
- (forward-sexp -1)
- (point)))
- (sql-word (buffer-substring beg end)))
- sql-word))))
-
-(defun ejc-get-prompt-symbol-under-point (msg)
- (let ((sql-symbol (if mark-active
- (buffer-substring (mark) (point))
- (ejc-get-word-at-point (point))))
- (enable-recursive-minibuffers t)
- val)
- (setq val (completing-read
- (if sql-symbol
- (format "%s (default %s): " msg sql-symbol)
- (format "%s: " msg))
- obarray))
- (list (if (equal val "")
- sql-symbol
- val))))
-
-(defun ejc-check-connection ()
- (unless ejc-db
- (error "Run M-x ejc-connect first!")))
-
-(defun ejc-describe-table (table-name)
- "Describe SQL table TABLE-NAME (default table name - word around the point)."
- (interactive (ejc-get-prompt-symbol-under-point "Describe table"))
- (ejc-check-connection)
- (let* ((owner (car (split-string table-name "\\.")))
- (table (cadr (split-string table-name "\\."))))
- (when (not table)
- (setq table owner)
- (setq owner nil))
- (ejc-show-last-result
- (concat
- (ejc-get-table-meta ejc-db table-name)
- "\n"
- (let ((sql (ejc-select-db-meta-script ejc-db :constraints
- :owner owner
- :table table)))
- (if (ejc-not-nil-str sql)
- (ejc-eval-sql-and-log ejc-db sql)
- ""))))))
-
-(defun ejc-describe-entity (entity-name)
- "Describe SQL entity ENTITY-NAME - function, procedure or type
- (default entity name - word around the point)."
- (interactive (ejc-get-prompt-symbol-under-point "Describe entity"))
- (ejc-check-connection)
- (ejc-show-last-result
- (ejc-eval-sql-and-log ejc-db
- (ejc-select-db-meta-script ejc-db :entity
- :entity-name entity-name))))
-
-(defun ejc-eval-user-sql (sql &optional sync)
- "Evaluate SQL by user: reload and show query results buffer, update log."
- (message "Processing SQL query...")
- (cl-labels ((msg-done () (if ejc-show-results-buffer
- (message "Done SQL query."))))
- (if sync
- (progn
- (ejc-show-last-result (ejc-eval-sql-and-log ejc-db sql))
- (msg-done))
- (ejc-eval-sql-and-log ejc-db sql
- :async (lambda (res)
- (ejc-show-last-result res)
- (msg-done))))))
-
-(defun ejc-eval-user-sql-region (beg end)
- "Evaluate SQL bounded by the selection area."
- (interactive "r")
- (ejc-check-connection)
- (let ((sql (buffer-substring beg end)))
- (ejc-eval-user-sql sql)))
-
-(cl-defun ejc-eval-user-sql-at-point (&optional sync)
- "Evaluate SQL bounded by the `ejc-sql-separator' or/and buffer
-boundaries."
- (interactive)
- (ejc-check-connection)
- (ejc-flash-this-sql)
- (ejc-eval-user-sql (ejc-get-sql-at-point) sync))
-
-(defun ejc-show-tables-list (&optional owner)
- "Output tables list."
- (interactive)
- (ejc-check-connection)
- (ejc-eval-user-sql
- (ejc-select-db-meta-script ejc-db :tables
- :owner owner)))
-
-(defun ejc-show-user-types-list (&optional owner)
- "Output user types list."
- (interactive)
- (ejc-check-connection)
- (ejc-eval-user-sql (ejc-select-db-meta-script ejc-db :types
- :owner owner)))
-
-(defun ejc-show-constraints-list (&optional owner table)
- "Output constraints list."
- (interactive)
- (ejc-check-connection)
- (ejc-eval-user-sql (ejc-select-db-meta-script ejc-db :constraints
- :owner owner
- :table table)))
-
-(defun ejc-show-procedures-list (&optional owner)
- "Output procedures list."
- (interactive)
- (ejc-eval-user-sql (ejc-select-db-meta-script ejc-db :procedures
- :owner owner)))
-
-;;-----------------------------------------------------------------------------
-;; results buffer
-;;
-(defun ejc-create-output-buffer ()
- (set-buffer (get-buffer-create ejc-results-buffer-name))
- (setq ejc-results-buffer (current-buffer))
- (setq view-read-only t)
- (ejc-result-mode)
- ejc-results-buffer)
-
-(defun ejc-get-buffer-or-create (buffer-or-name create-buffer-fn)
- "Return buffer passed in `buffer-or-name' parameter.
-If this buffer is not exists or it was killed - create buffer via
-`create-buffer-fn' function (this function must return buffer)."
- (let ((buf (if (bufferp buffer-or-name)
- buffer-or-name
- (get-buffer buffer-or-name))))
- (if (and buf (buffer-live-p buf))
- buf
- (apply create-buffer-fn nil))))
-
-(defun ejc-get-output-buffer ()
- (if (and ejc-results-buffer (buffer-live-p ejc-results-buffer))
- ejc-results-buffer
- (ejc-create-output-buffer)))
-
-(defun ejc-toggle-show-results-buffer ()
- (interactive)
- (if ejc-show-results-buffer
- (setq ejc-show-results-buffer nil)
- (setq ejc-show-results-buffer t)))
-
-(defun ejc-show-last-result (&optional result)
- "Popup buffer with last SQL execution result output."
- (interactive)
- (if ejc-show-results-buffer
- (let ((output-buffer (ejc-get-output-buffer))
- (old-split split-width-threshold))
- (set-buffer output-buffer)
- (when result
- (read-only-mode -1)
- (erase-buffer)
- (insert result))
- (read-only-mode 1)
- (beginning-of-buffer)
- (setq split-width-threshold nil)
- (display-buffer output-buffer)
- (setq split-width-threshold old-split))
- (let ((result-lines (split-string result "\n")))
- (message "%s"
- (if (<= (length result-lines) 3)
- (apply 'concat (cl-subseq result-lines 0 3))
- (concat (apply 'concat (cl-subseq result-lines 0 3))
- "... ("
- (number-to-string (- (length result-lines) 3))
- " more)"))))))
-;;
-;;-----------------------------------------------------------------------------
-
-;;-----------------------------------------------------------------------------
-;; editor buffer
-;;
-(defun ejc-create-sql-editor-buffer ()
- "Create buffer dedicated to ad-hoc edit and SQL scripts."
- (let ((sql-editor-buffer (get-buffer-create ejc-sql-editor-buffer-name)))
- (save-excursion
- (set-buffer sql-editor-buffer)
- (ejc-configure-sql-buffer "ansi"))
- sql-editor-buffer))
-
-(defun ejc-switch-to-sql-editor-buffer ()
- "Switch to buffer dedicated to ad-hoc edit and SQL scripts.
-If the buffer is not exists - create it."
- (interactive)
- (switch-to-buffer
- (ejc-get-buffer-or-create
- ejc-sql-editor-buffer-name
- 'ejc-create-sql-editor-buffer)))
-;;
-;;-----------------------------------------------------------------------------
-
-;;-----------------------------------------------------------------------------
-;; log buffer
-;;
-(defun ejc-open-log ()
- (interactive)
- (find-file-read-only (ejc-get-log-file-path))
- (end-of-buffer))
-;;
-;;-----------------------------------------------------------------------------
-
-(provide 'ejc-sql)
-
-;;; ejc-sql.el ends here
+++ /dev/null
-(defproject ejc-sql "0.0.1-SNAPSHOT"
- :description "Interact with database via java/clojure libs to run SQL/JPQL scripts"
- :url "https://github.com/kostafey/ejc-sql"
- :license {:name "GPL 2.0+"
- :url "http://www.gnu.org/licenses/old-licenses/gpl-2.0.html"}
- :dependencies [[org.clojure/clojure "1.8.0"]
- [org.clojure/clojure-contrib "1.2.0"]
- [org.clojure/java.jdbc "0.5.8"]
- [org.apache.openjpa/openjpa-all "2.2.2"]
- [org.hibernate/hibernate-core "5.2.3.Final"]
- [com.cemerick/pomegranate "0.3.0"]
- [org.apache.commons/commons-lang3 "3.2.1"]])
+++ /dev/null
-;;; connect.clj -- Core clojure functions for ejc-sql emacs extension.
-
-;;; Copyright © 2013-2016 - Kostafey <kostafeyNOSPAMgmail.com>
-
-;;; This program is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 2, or (at your option)
-;;; any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program; if not, write to the Free Software Foundation,
-;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
-
-(ns ejc-sql.connect
- (:use [clojure.java.io]
- [ejc-sql.lib]
- [ejc-sql.output])
- (:require [clojure.java.jdbc :as j]
- [clojure.java.jdbc.deprecated :as jd]
- [clojure.contrib.java-utils])
- (:import [java.sql Connection
- DriverManager
- PreparedStatement
- ResultSet
- SQLException]))
-
-(def db
- "DataBase connection properties list from the last transaction.
-For debug purpose."
- (atom nil))
-
-(defn set-db [ejc-db]
- (reset! db ejc-db))
-
-(def dml-set
- #{"SELECT"
- "INSERT"
- "UPDATE"
- "DELETE"})
-
-(def ignore-set #{"(" "["})
-
-(defn determine-dml [sql]
- "Determine if current SQL is Data Manipulation Language (DML) case."
- (let [sql (.trim sql)
- pos (loop [rest-sql sql
- pos 0]
- (let [symb (subs rest-sql 0 1)]
- (if (ignore-set symb)
- (recur (subs rest-sql 1) (inc pos))
- pos)))]
- (or
- (dml-set (.toUpperCase (subs sql pos 6)))
- (#{"SHOW"} (.toUpperCase (subs sql pos 4))))))
-
-(defn handle-special-cases [db sql]
- (case (:subprotocol db)
- "oracle" (case (clojure.string/upper-case sql)
- "SHOW ERRORS" (str "SELECT line, position, sequence, text
- FROM all_errors
- WHERE type = 'FUNCTION'
- AND name = 'FILTERDICT'
- AND attribute != 'WARNING'
- AND owner = '" (:user db) "'
- ORDER BY line, position, sequence")
- sql)
- sql))
-
-(defn eval-sql-core
- "The core SQL evaluation function."
- [& {:keys [db sql]
- :or {db @ejc-sql.connect/db}}]
- (set-db db)
- (let [statement-separator (or (:separator db) ";")]
- (last
- (for [sql-part (seq (.split (handle-special-cases db sql)
- statement-separator))]
- (try
- (let [sql-query-word (determine-dml sql-part)]
- (if (and sql-query-word (or (.equals sql-query-word "SELECT")
- (.equals sql-query-word "SHOW")))
- (list :result-set
- (j/query db (list sql-part) {:as-arrays? false}))
- (list :message
- (str "Records affected: "
- (first (j/execute! db (list sql-part)))))))
- (catch SQLException e
- (list :message
- (str "Error: "(.getMessage e)))))))))
-
-(defn eval-user-sql [db sql]
- (let [clear-sql (.trim sql)]
- (ejc-sql.output/log-sql (str clear-sql "\n"))
- (let [[result-type result] (eval-sql-core
- :db db
- :sql clear-sql)]
- (if (= result-type :result-set)
- (ejc-sql.output/print-table result)
- result))))
-
-(defn eval-sql-and-log-print
- "Write SQL to log file, evaluate it and print result."
- [db sql]
- (print (eval-user-sql db sql)))
-
-(defn eval-sql-internal-get-column [db sql]
- (let [[result-type result] (eval-sql-core :db db
- :sql sql)]
- (if (= result-type :result-set)
- (-> result rest flatten)
- result)))
-
-(defn table-meta
- [db table-name]
- (set-db db)
- (jd/with-connection db
- (let
- [connect (jd/connection)
- statement (.createStatement connect)
- execResult (try
- (list
- (.executeQuery
- statement
- (str "select * from " table-name " where 0 = 1")) true)
- (catch SQLException e
- (list (str "Error: " (.getMessage e)) false)))
- result-data (first execResult)
- success (last execResult)]
- (if success
- {:success true
- :result
- (let [resultSet result-data
- rsMeta (.getMetaData resultSet)
- colCount (.getColumnCount rsMeta)]
- (loop [i 1
- acc []]
- (if (> i colCount)
- acc
- (recur (inc i)
- (conj acc {:name (.getColumnLabel rsMeta i)
- :type (.getColumnTypeName rsMeta i)})))))}
- {:success false :result result-data}))))
-
-(defn get-table-meta
- "Discribe table."
- [db table-name]
- (let [result-map (table-meta db table-name)
- success (:success result-map)
- result-data (:result result-map)
- head (str "Table ``" table-name "`` description:\n")
- head-length (dec (.length head))]
- (if success
- (str head
- (ejc-sql.lib/simple-join head-length "-") "\n"
- (ejc-sql.output/print-table result-data))
- result-data)))
+++ /dev/null
-(ns ejc-sql.jpa
- (:require [cemerick.pomegranate :as pom])
- (:use [clojure.java.io]
- [ejc-sql.lib]
- [ejc-sql.output])
- (:import [javax.persistence Persistence
- EntityManager
- TypedQuery]
- [org.apache.commons.lang3.builder
- ReflectionToStringBuilder
- ToStringStyle]))
-
-(def em)
-
-(defn connect [{:keys [connection-name
- persistent-xml-url
- domain-objects-url
- jdbc-driver-url]}]
- (pom/add-classpath persistent-xml-url)
- (pom/add-classpath domain-objects-url)
- (pom/add-classpath jdbc-driver-url)
- (def em (-> (Persistence/createEntityManagerFactory connection-name)
- (.createEntityManager))))
-
-(defn connect-plain [connection-name
- persistent-xml-url
- domain-objects-url
- jdbc-driver-url]
- (connect
- {:connection-name connection-name
- :persistent-xml-url persistent-xml-url
- :domain-objects-url domain-objects-url
- :jdbc-driver-url jdbc-driver-url}))
-
-(defn eval-jpql [jpql]
- (-> em (.createQuery jpql) (.getResultList) (.toArray)))
-
-(defn row-to-str [row]
- (if (not (array? row))
- (ReflectionToStringBuilder/toString
- row ToStringStyle/SHORT_PREFIX_STYLE)
- (list (str row))))
-
-(defn eval-jpql-print [jpql]
- (print
- (format-output (map row-to-str (eval-jpql jpql))
- :as-arrays? true, :add-headers? false)))
-
+++ /dev/null
-;;; lib.clj -- Misc clojure functions for ejc-sql emacs extension.
-
-;;; Copyright © 2013 - Kostafey <kostafeyNOSPAMgmail.com>
-
-;;; This program is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 2, or (at your option)
-;;; any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program; if not, write to the Free Software Foundation,
-;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
-
-(ns ejc-sql.lib
- (:import (java.io File)))
-
-(def windows?
- "The value is true if it runs under the os Windows."
- (>= 0 (.indexOf (System/getProperty "os.name") "Windows")))
-
-(defn in?
- "true if seq contains elm"
- [seq elm]
- (some #(= elm %) seq))
-
-(defn array? [x]
- (-> x .getClass .isArray))
-
-(defn trim [s]
- (if (instance? java.lang.String s)
- (.trim s)
- s))
-
-(defn filter-data [rs]
- (map #(map trim %) rs))
-
-(defn get-rs-data [rs]
- (map vals rs))
-
-(defn get-rs-headers [rs]
- (for [[k _] (first rs)]
- (subs (str k) 1)))
-
-(defn transpose [m]
- (apply mapv vector m))
-
-(defn find-longest-list
- "Returns the list of the longest lengths per column."
- [lst]
- (map #(apply max %) (transpose lst)))
-
-(defn simple-join [n s]
- (clojure.string/join
- (for [x (range 0 n)] s)))
-
-(defn str-length [s]
- (.length (str s)))
-
-(defn get-rs-lengths [rs]
- (map #(map str-length %) rs))
-
-(defn get-absolute-file-path [relative-file-path]
- (-> (java.io.File. relative-file-path) .getAbsolutePath))
+++ /dev/null
-;;; output.clj -- Output & formatting clojure functions for ejc-sql.
-
-;;; Copyright © 2013, 2016 - Kostafey <kostafeyNOSPAMgmail.com>
-
-;;; This program is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 2, or (at your option)
-;;; any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program; if not, write to the Free Software Foundation,
-;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
-
-(ns ejc-sql.output
- (:use clojure.java.io
- ejc-sql.lib)
- (:require clojure.contrib.java-utils)
- (:import (java.io File)
- (java.lang.reflect Method)
- (java.util.Date)
- (java.text.SimpleDateFormat)
- (org.apache.openjpa.lib.jdbc SQLFormatter)
- (org.hibernate.engine.jdbc.internal BasicFormatterImpl)))
-
-(defn get-log-dir []
- (file (if windows?
- (System/getenv "AppData")
- "/var/log/")
- "ejc-sql"))
-
-(defn get-log-file []
- (file (get-log-dir)
- (str (.format (new java.text.SimpleDateFormat
- "yyyy-MM-dd")
- (new java.util.Date)) ".log")))
-
-(defn print-log-file-path []
- (print (.getAbsolutePath (get-log-file))))
-
-(defn log-sql [sql]
- (let [log-file (get-log-file)
- is-new-file (not (.exists log-file))]
- (when is-new-file
- (.mkdirs (File. (.getParent log-file)))
- (.createNewFile log-file))
- (with-open [wrtr (clojure.java.io/writer log-file :append true)]
- (if is-new-file
- (.write wrtr (str "-- -*- mode: sql; -*-\n"
- "-- Local Variables:\n"
- "-- eval: (ejc-sql-mode)\n"
- "-- End:\n")))
- (.write wrtr (str (simple-join 50 "-") " "
- (.format (new java.text.SimpleDateFormat
- "yyyy.MM.dd HH:mm:ss.S")
- (new java.util.Date))
- " " (simple-join 2 "-") "\n" sql "\n")))))
-
-(def rows-limit
- "Limit number of records to output."
- (atom 1000))
-
-(defn set-rows-limit [val]
- "Set limit for number of records to output. When nil no limit."
- (reset! rows-limit val))
-
-(defn print-table
- "Prints a collection of maps in a textual table. Prints table headings
- ks, and then a line of output for each row, corresponding to the keys
- in ks. If ks are not specified, use the keys of the first item in rows."
- ([ks rows]
- (when (seq rows)
- (let [row-limit @rows-limit
- [rows msg] (if (and row-limit (> (count rows) row-limit))
- [(take row-limit rows)
- (format "Too many rows. Only %s from %s is shown.\n\n"
- row-limit (count rows))]
- [rows ""])
- widths (map
- (fn [k]
- (apply max (count (name k)) (map #(count (str (get % k))) rows)))
- ks)
- headers (map name ks)
- spacers (map #(apply str (repeat % "-")) widths)
- ;; TODO: #(str "%" % "d") for numbers
- fmts (map #(str "%-" % "s") widths)
- fmt-row (fn [leader divider trailer row]
- (str leader
- (apply str (interpose divider
- (for [[col fmt] (map vector (map #(get row %) ks) fmts)]
- (format fmt (str col)))))
- trailer))
- result (new StringBuffer "")
- ;; TODO: cahnge to #(println %) when async output ready
- out #(.append result (str % "\n"))]
- (out (fmt-row "" " | " "" (zipmap ks headers)))
- (out (fmt-row "" "-+-" "" (zipmap ks spacers)))
- (doseq [row rows]
- (out (fmt-row "" " | " "" row)))
- (str msg (.toString result)))))
- ([rows] (print-table (keys (first rows)) rows)))
-
-(defn pretty-print [sql formatter]
- (if (= formatter :jpa)
- (print (.prettyPrint (SQLFormatter.) sql))
- ;; :hibernate
- (print (.format (BasicFormatterImpl.) sql))))
+++ /dev/null
-;;; structure.clj -- Receive database stucture and keep it in cache.
-
-;;; Copyright © 2016-2017 - Kostafey <kostafeyNOSPAMgmail.com>
-
-;;; This program is free software; you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 2, or (at your option)
-;;; any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program; if not, write to the Free Software Foundation,
-;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
-
-(ns ejc-sql.structure
- (:use [ejc-sql.lib])
- (:require
- [clojure.java.jdbc :as j]
- [ejc-sql.connect :as c]))
-
-(def cache (atom {}))
-
-(def queries
- {
- ;;--------
- :oracle
- ;;--------
- {:entity (fn [& {:keys [entity-name]}]
- (str " SELECT text \n"
- " FROM all_source \n"
- " WHERE name = '"entity-name"'"))
- :types (fn [& _] "SELECT * FROM USER_TYPES")
- :owners (fn [& _] (str " SELECT DISTINCT(owner) \n"
- " FROM ALL_OBJECTS \n"
- " ORDER BY owner \n"))
- :tables (fn [& {:keys [owner]}]
- (str " SELECT table_name, owner \n"
- " FROM all_tables \n"
- (if owner
- (str " WHERE owner = '"owner"'"))
- " ORDER BY table_name"))
- :columns (fn [& {:keys [table]}]
- (str " SELECT column_name \n"
- " FROM ALL_TAB_COLUMNS \n"
- " WHERE table_name = '"table"'"))
- :constraints (fn [& {:keys [owner table]}]
- (if table
- (str " SELECT * FROM all_constraints \n"
- " WHERE owner = "owner" \n"
- " AND table_name = '"table"' \n")
- "SELECT * FROM user_constraints"))
- :procedures (fn [& {:keys [owner]}]
- (str " SELECT object_name, procedure_name \n"
- " FROM all_procedures \n"
- (if owner
- (str " WHERE owner = '" owner "'")
- "")))
- :objects (fn [& _]
- (str "SELECT * FROM all_objects WHERE object_type IN "
- "('FUNCTION','PROCEDURE','PACKAGE')"))}
- ;;--------
- :informix
- ;;--------
- {:owners nil
- :tables (fn [& _]
- (str " SELECT TRIM(t.tabname) as tablesList \n"
- " FROM systables AS t \n"
- " WHERE t.tabtype = 'T' \n"
- " AND t.tabid >= 100 \n"
- " ORDER BY t.tabname; \n"))
- :columns (fn [& {:keys [table]}]
- (str " SELECT TRIM(c.colname) AS column_name \n"
- " FROM systables AS t, syscolumns AS c \n"
- " WHERE t.tabid = c.tabid \n"
- " AND t.tabtype = 'T' \n"
- " AND t.tabid >= 100 \n"
- " AND TRIM(t.tabname) = '" table "' \n"
- " ORDER BY c.colno; \n"))}
- ;;-------
- :mysql
- ;;-------
- {:owners nil
- :tables (fn [& {:keys [db-name]}]
- (str " SELECT table_name FROM INFORMATION_SCHEMA.TABLES "
- " WHERE table_schema = '" db-name "'"))
- :columns (fn [& {:keys [table]}]
- (str "SELECT column_name \n"
- "FROM INFORMATION_SCHEMA.COLUMNS \n"
- "WHERE table_name = '" table "' \n"))}
- ;;--------
- :h2
- ;;--------
- {:tables (fn [& _] (str "SELECT table_name \n"
- "FROM INFORMATION_SCHEMA.TABLES \n"
- "WHERE TABLE_SCHEMA='PUBLIC'"))
- :columns (fn [& {:keys [table]}]
- (str "SELECT column_name \n"
- "FROM INFORMATION_SCHEMA.COLUMNS \n"
- "WHERE table_name = '" table "' \n"))}
- ;;-------
- :sqlserver ; ms sql server
- ;;-------
- {:owners (fn [& _] (str " SELECT schema_owner \n"
- " FROM information_schema.schemata \n"))
- :tables (fn [& _]
- "SELECT table_name FROM information_schema.tables")
- :columns (fn [& {:keys [table]}]
- (str "SELECT column_name \n"
- "FROM information_schema.columns \n"
- "WHERE table_name='" table "' "))
- :constraints (fn [& {:keys [table]}]
- (str "SELECT type_desc AS constraint_type, \n"
- " name \n"
- "FROM sys.objects \n"
- "WHERE type_desc LIKE '%CONSTRAINT' \n"
- " AND OBJECT_NAME(parent_object_id)='" table "'"))}})
-
-(defn autocomplete-available-for-db? [db-type]
- (queries db-type))
-
-(defn get-db-name [db]
- (let [{:keys [database subname connection-uri]} db]
- (or database
- (if subname
- (let [separator (if (= (first (.split subname "/")) subname)
- ":" "/")
- raw-db-name (last (.split subname separator))
- raw-db-name (first (.split raw-db-name "\\?"))
- raw-db-name (first (.split raw-db-name ";"))]
- raw-db-name)
- ;; No subname - parse connection-uri
- (let [props-list (.split connection-uri ";")
- db-name-prop (first
- (filter
- (fn [prop]
- (=
- "databasename"
- (.toLowerCase (first (.split prop "=")))))
- props-list))]
- (if db-name-prop
- ;; "databaseName=my_db_name;"
- (second (.split db-name-prop "="))
- ;; "jdbc:jtds:sqlserver://localhost:1433/my_db_name;"
- (last (.split (first props-list) "/"))))))))
-
-(defn get-user [db]
- (let [{:keys [user connection-uri]} db]
- (or user
- (second (.split
- (let [props-list (.split connection-uri ";")]
- (first
- (filter
- (fn [prop]
- (=
- "user"
- (.toLowerCase (first (.split prop "=")))))
- props-list))) "=")))))
-
-(defn get-db-type [db]
- (let [{:keys [subprotocol connection-uri]} db]
- (keyword
- (or subprotocol
- (let [attrs (.split connection-uri ":")]
- (if (= (second attrs) "jtds")
- ;; jdbc:jtds:sqlserver://...
- (nth attrs 2)
- ;; jdbc:sqlserver://localhost\instance:1433;
- (second attrs)))))))
-
-(defn select-db-meta-script [db meta-type &
- {:keys [owner
- table
- entity-name]}]
- "Return SQL request to obtain some database structure info."
- (let [db-type (get-db-type db)
- meta-type (if (keyword? meta-type) meta-type (keyword meta-type))
- need-owners? (get-in queries [db-type :owners])
- owner (or owner (if need-owners? (get-user db)))
- sql-receiver (get-in queries [db-type meta-type])
- sql (if sql-receiver
- (sql-receiver :owner owner
- :table table
- :entity-name entity-name
- :db-name (get-db-name db)))]
- sql))
-
-(defn- get-single-row-result [db sql]
- (if sql
- (rest
- (flatten
- (j/query db (list sql) {:as-arrays? true})))))
-
-(defn- get-first-row-result [db sql]
- (if sql
- (rest
- (map first
- (j/query db (list sql) {:as-arrays? true})))))
-
-(defn- get? [obj & [force?]]
- (if (and obj (or force? (realized? obj)))
- @obj))
-
-(defn get-owners [db]
- "Return owners list from cache if already received from DB,
-check if receiveing process is not running, then start it."
- (let [db-type (get-db-type db)
- need-owners? (get-in queries [db-type :owners])]
- (if need-owners?
- (do
- (if (not (get-in @cache [db :owners]))
- (swap! cache assoc-in [db :owners]
- (future ((fn [db]
- (let [sql (select-db-meta-script db :owners)]
- (get-single-row-result db sql))) db))))
- (get? (get-in @cache [db :owners]))))))
-
-(defn get-tables [db & [owner]]
- "Return tables list for this owner from cache if already received from DB,
-check if receiveing process is not running, then start it."
- (let [;; default owner
- owner (:user db)]
- (if (not (get-in @cache [db :tables (keyword owner)]))
- (swap! cache assoc-in [db :tables (keyword owner)]
- (future ((fn [db owner]
- (let [sql (select-db-meta-script db :tables
- :owner owner)]
- (get-first-row-result db sql)))
- db owner))))
- (get? (get-in @cache [db :tables (keyword owner)]))))
-
-(defn get-colomns [db table force?]
- "Return colomns list for this table from cache if already received from DB,
-check if receiveing process is not running, then start it."
- (if (not (get-in @cache [db :colomns (keyword table)]))
- (swap! cache assoc-in [db :colomns (keyword table)]
- (future ((fn [db table]
- (let [sql (select-db-meta-script db :columns
- :table table)]
- (get-single-row-result db sql)))
- db table))))
- (get? (get-in @cache [db :colomns (keyword table)]) force?))
-
-(defn get-stucture [db prefix-1 prefix-2]
- "Return candidates autocomplete list from the database structure cache or
-async request to fill it, if not yet.
-Current completion environment near to point (cursor - #) could be:
-- `prefix-2`.`prefix-1`.#
-- `prefix-1`.#
-- something#
-The result list has the following structure:
-(pending item1 item2 ...)
-- If `pending` is some text (not nil) - the async request to get the structure
- is running and `pending` describes whether it is owners, tables or both.
-- If `pending` is nil - no request is running, return result immediately."
- (let [db-type (get-db-type db)]
- (if (not (autocomplete-available-for-db? db-type))
- ;; Do nothing
- (list "nil")
- ;; Try to create candidates autocomplete list
- (let [need-owners? (get-in queries [db-type :owners])]
- ;; Check against following cases:
- ;; prefix-2.prefix-1.#
- ;; prefix-1.#
- ;; something#
- (cond
- ;; owner.table.#<colomns-list>
- prefix-2 (let [table prefix-1
- colomns-list (get-colomns db table true)]
- (if colomns-list
- (cons "nil" colomns-list)
- ;; pending colomns...
- (list "colomns")))
- ;; [owner|table].#<tables-list|colomns-list>
- prefix-1 (letfn [(get-columns []
- (let [tables-list (get-tables db)]
- (if tables-list
- (if (in? tables-list prefix-1)
- ;; table.#<colomns-list>
- (let [table prefix-1
- ;; force columns-cache obtaining...
- columns-list (get-colomns db table true)]
- ;; ok - columns
- (cons "nil" columns-list))
- ;; unknown.# case
- ;; nothing to complete
- (list "nil"))
- ;; no tables yet
- ;; pending tables...
- (list "tables"))))]
- (if need-owners?
- (let [owners-list (get-owners db)]
- (if owners-list
- (if (in? owners-list prefix-1)
- ;; owner.#<tables-list>
- (let [owner prefix-1
- tables-list (get-tables db)]
- (if tables-list
- ;; ok - tables
- (cons "nil" tables-list)
- ;; pending tables...
- (list "tables")))
- ;; not-owner.#<tables-list>
- (get-columns))
- ;; no owners yet
- ;; pending owners...
- (list "owners")))
- ;; Do not assume owner.#<tables-list> for this database
- ;; only table.#<colomns-list>
- (get-columns)))
- ;; #<owners-list&tables-list>
- :else (let [owners-list (get-owners db)
- tables-list (get-tables db)]
- (cons (cond
- (and (not owners-list)
- (not tables-list)) "owners and tables"
- (not owners-list) "owners"
- (not tables-list) "tables"
- :else "nil")
- (distinct (concat owners-list tables-list)))))))))
-
-(defn get-cache []
- "Output actual cache."
- @cache)
-
-(defn invalidate-cache [db]
- "Clean your current connection cache (database owners and tables list)."
- (swap! cache assoc-in [db] nil))
-
+++ /dev/null
-#Leiningen
-#Thu Feb 16 10:12:19 CET 2017
-version=0.0.1-SNAPSHOT
-groupId=ejc-sql
-artifactId=ejc-sql
+++ /dev/null
-[{:dependencies {org.clojure/clojure {:vsn "1.8.0", :native-prefix nil}, org.codehaus.plexus/plexus-component-annotations {:vsn "1.5.5", :native-prefix nil}, org.apache.commons/commons-lang3 {:vsn "3.2.1", :native-prefix nil}, org.sonatype.aether/aether-util {:vsn "1.13.1", :native-prefix nil}, javax.el/el-api {:vsn "2.2", :native-prefix nil}, org.hibernate/hibernate-core {:vsn "5.2.3.Final", :native-prefix nil},&ype.sisu/sisu-guice {:vsn "3.0.3", :native-prefix nil, :native? false}, org.sonatype.aether/aether-connector-file {:vsn "1.13.1", :native-prefix nil, :native? false}, org.hibernate.common/hibernate-commons-annotations {:vsn "5.0.1.Final", :native-prefix nil, :native? false}, org.apache.maven/maven-repository-metadata {:vsn "3.0.4", :native-prefix nil, :native? false}, commons-io {:vsn "2.0.1", :native-prefix nil, :native? false}, org.apache.openjpa/openjpa-all {:vsn "2.2.2", :native-prefix nil, :native? false}}}]
\ No newline at end of file
--- /dev/null
+;;; ejc-autocomplete.el -- SQL completitions at point (the part of ejc-sql).
+
+;;; Copyright © 2013-2018 - Kostafey <kostafeyNOSPAMgmail.com>
+
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software Foundation,
+;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
+
+;;; Code:
+
+(require 'dash)
+(require 'auto-complete)
+(require 'ejc-lib)
+(require 'ejc-interaction)
+(require 'ejc-doc)
+(require 'ejc-format)
+
+(defcustom ejc-candidates-uppercase t
+ "Use uppercase candidates or downcase.
+Uppercase by default, set to nil to use downcase candidates."
+ :type 'boolean
+ :safe #'booleanp
+ :group 'ejc-sql)
+
+(defcustom ejc-use-flx nil
+ "Non-nil enables `flx' fuzzy matching engine autocompletion."
+ :group 'ejc-sql
+ :type 'boolean)
+
+(defcustom ejc-flx-threshold 3
+ "The minimum number of typed chars required to use `flx' for autocompletion."
+ :group 'ejc-sql
+ :type 'integer)
+
+(defface ejc-flx-highlight-face
+ '((t :inherit popup-isearch-match))
+ "Face used by flx for highlighting flx match characters in `ejc-sql' buffers."
+ :group 'ejc-sql)
+
+(defun ejc-get-prefix-word ()
+ "Return the word preceding dot before the typing."
+ (save-excursion
+ (let ((space-dist (or (save-excursion
+ (re-search-backward "[ \n\t\r(]+" nil t))
+ 0))
+ (dot (search-backward "." nil t))
+ (space (re-search-backward "[ \n\t\r(.]+" nil t)))
+ (if (and dot
+ space
+ (> dot space)
+ (<= space-dist space)) ; is a dot completition
+ (buffer-substring (1+ space) dot)
+ nil))))
+
+(defvar ejc-ansi-sql-words
+ '("select" "where" "and" "or" "from" "insert" "update" "delete" "join"
+ "order" "by" "distinct" "create" "alter" "drop" "like"
+ "grant" "revoke" "deny" "commit" "rollback" "savepoint"))
+
+(defvar ejc-auxulary-sql-words
+ '("show" "errors" "desc" "count" "type" "table" "function" "procedure"
+ "begin" "end" "for" "return"))
+
+(defun ejc-not-nil-str (s)
+ (not (equal s "nil")))
+
+(defmacro ejc-candidates (cand-fn)
+ `(if (ejc-buffer-connected-p)
+ (let* ((prefix-1 (ejc-get-prefix-word))
+ (prefix-2 (save-excursion
+ (search-backward "." nil t)
+ (ejc-get-prefix-word)))
+ (result (funcall ,cand-fn
+ ejc-db
+ (apply
+ 'buffer-substring
+ (ejc-get-sql-boundaries-at-point))
+ prefix-1
+ prefix-2))
+ (pending (car result))
+ (candidates-cache (cdr result)))
+ (if (ejc-not-nil-str pending)
+ (message "Receiving database structure...")
+ candidates-cache))))
+
+;;;###autoload
+(defun ejc-owners-candidates ()
+ (ejc-candidates 'ejc-get-owners-candidates))
+
+;;;###autoload
+(defun ejc-tables-candidates ()
+ (ejc-candidates 'ejc-get-tables-candidates))
+
+;;;###autoload
+(defun ejc-colomns-candidates ()
+ (ejc-candidates 'ejc-get-colomns-candidates))
+
+(defun ejc-return-point ()
+ "Return point position if point (cursor) is located next to dot char (.#)"
+ (let ((curr-char (buffer-substring
+ (save-excursion
+ (left-char 1)
+ (point))
+ (point))))
+ (if (equal curr-char ".")
+ (point)
+ nil)))
+
+(defun ejc-get-ansi-sql-words ()
+ (unless (or (ejc-return-point) (ejc-get-prefix-word))
+ (progn
+ (if ejc-candidates-uppercase
+ (append (mapcar 'upcase ejc-ansi-sql-words)
+ (mapcar 'upcase ejc-auxulary-sql-words))
+ (append ejc-ansi-sql-words
+ ejc-auxulary-sql-words)))
+ nil))
+
+(defun ac-ejc-documentation (symbol-name)
+ "Return a documentation string for SYMBOL-NAME."
+ (if (not ejc-doc-created-p)
+ (ejc-create-doc))
+ (gethash (intern (downcase symbol-name)) ejc-sql-doc))
+
+(defvar ac-source-ejc-owners
+ '((candidates . ejc-owners-candidates)
+ (symbol . "o")
+ (requires . 1)
+ (cache . t)))
+
+(defvar ac-source-ejc-tables
+ '((candidates . ejc-tables-candidates)
+ (symbol . "t")
+ (requires . 1)
+ (cache . t)))
+
+(defvar ac-source-ejc-tables-point
+ '((candidates . ejc-tables-candidates)
+ (symbol . "t")
+ (prefix . ejc-return-point)
+ (requires . 0)
+ (cache . t)))
+
+(defvar ac-source-ejc-colomns
+ '((candidates . ejc-colomns-candidates)
+ (symbol . "c")
+ (requires . 1)
+ (cache . t)))
+
+(defvar ac-source-ejc-colomns-point
+ '((candidates . ejc-colomns-candidates)
+ (symbol . "c")
+ (prefix . ejc-return-point)
+ (requires . 0)
+ (cache . t)))
+
+(defvar ac-source-ejc-ansi-sql
+ '((candidates . ejc-get-ansi-sql-words)
+ (symbol . "s")
+ (document . ac-ejc-documentation)
+ (requires . 1)
+ (cache . t)))
+
+;;;###autoload
+(defun ejc-ac-setup ()
+ "Add the completion sources to the front of `ac-sources'.
+This affects only the current buffer.
+
+Check against following cases:
+prefix-2.prefix-1.#
+prefix-1.#
+something#"
+ (interactive)
+ (add-to-list 'ac-sources 'ac-source-ejc-ansi-sql)
+ (add-to-list 'ac-sources 'ac-source-ejc-owners)
+ (add-to-list 'ac-sources 'ac-source-ejc-tables)
+ (add-to-list 'ac-sources 'ac-source-ejc-tables-point)
+ (add-to-list 'ac-sources 'ac-source-ejc-colomns)
+ (add-to-list 'ac-sources 'ac-source-ejc-colomns-point))
+
+(defun ejc-ac-hook ()
+ (if ejc-use-flx
+ (if (functionp 'flx-flex-match)
+ (setq-local ac-match-function 'ejc-flx-match-internal)
+ (error (concat "Please install flx.el and flx-ido.el "
+ "if you use fuzzy completion"))))
+ (delq 'ac-source-dictionary ac-sources)
+ (delq 'ac-source-abbrev ac-sources)
+ (delq 'ac-source-words-in-same-mode-buffers ac-sources))
+
+(add-hook 'ejc-sql-minor-mode-hook 'ejc-ac-hook)
+
+(defun ejc-flx-propertize (obj score &optional add-score)
+ "Return propertized copy of obj according to score.
+
+SCORE of nil means to clear the properties."
+ (let ((block-started (cadr score))
+ (last-char nil)
+ (str (if (consp obj)
+ (substring-no-properties (car obj))
+ (substring-no-properties obj))))
+
+ (when score
+ (dolist (char (cdr score))
+ (when (and last-char
+ (not (= (1+ last-char) char)))
+ (put-text-property block-started (1+ last-char) 'face 'ejc-flx-highlight-face str)
+ (setq block-started char))
+ (setq last-char char))
+ (put-text-property block-started (1+ last-char) 'face 'ejc-flx-highlight-face str)
+ (when add-score
+ (setq str (format "%s [%s]" str (car score)))))
+ (if (consp obj)
+ (cons str (cdr obj))
+ str)))
+
+(defun ejc-flx-decorate (things &optional clear)
+ "Add ido text properties to THINGS.
+If CLEAR is specified, clear them instead."
+ (if flx-ido-use-faces
+ (let ((decorate-count (min ido-max-prospects
+ (length things))))
+ (nconc
+ (cl-loop for thing in things
+ for i from 0 below decorate-count
+ collect (if clear
+ (ejc-flx-propertize thing nil)
+ (ejc-flx-propertize (car thing) (cdr thing))))
+ (if clear
+ (nthcdr decorate-count things)
+ (mapcar 'car (nthcdr decorate-count things)))))
+ (if clear
+ things
+ (mapcar 'car things))))
+
+(defun ejc-flx-match-internal (query items)
+ "Match QUERY against ITEMS using flx scores.
+
+If filtered item count is still greater than `flx-ido-threshold', then use flex."
+ (if (< (length query) ejc-flx-threshold)
+ (all-completions query items)
+ (let ((flex-result (flx-flex-match query items)))
+ (if (< (length flex-result) flx-ido-threshold)
+ (let* ((matches (cl-loop for item in flex-result
+ for string = (ido-name item)
+ for score = (flx-score string query flx-file-cache)
+ if score
+ collect (cons item score)
+ into matches
+ finally return matches)))
+ (ejc-flx-decorate (delete-consecutive-dups
+ (sort matches
+ (lambda (x y) (> (cadr x) (cadr y))))
+ t)))
+ flex-result))))
+
+(provide 'ejc-autocomplete)
+
+;;; ejc-autocomplete.el ends here
--- /dev/null
+;;; ejc-direx.el
+
+;;; Copyright © 2017 - Kostafey <kostafeyNOSPAMgmail.com>
+
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software Foundation,
+;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
+
+;;; Code:
+
+
+(require 'dash)
+(require 'direx)
+(require 'ejc-interaction)
+
+(defgroup ejc-direx nil
+ "Database structure visualisation tree."
+ :group 'ejc
+ :prefix "ejc-direx")
+
+
+;;; Core
+
+(defclass ejc-direx:object (direx:tree) ((cache :initarg :cache)))
+(defclass ejc-direx:database (ejc-direx:object direx:node)
+ ((buffer :initarg :buffer)
+ (file-name :initarg :file-name
+ :accessor direx:file-full-name)))
+(defclass ejc-direx:schema (ejc-direx:object direx:node) ())
+(defclass ejc-direx:table (ejc-direx:object direx:node) ())
+(defclass ejc-direx:colomn (ejc-direx:object direx:leaf) ())
+
+(defvar ejc-direx:type-class-map
+ '(("database" . ejc-direx:database)
+ ("schema" . ejc-direx:schema)
+ ("table" . ejc-direx:table)
+ ("colomn" . ejc-direx:colomn)))
+
+(defun ejc-direx:node-from-cache (cache)
+ (let* ((type (plist-get (car cache) :type))
+ (class (or (assoc-default type ejc-direx:type-class-map)
+ 'ejc-direx:colomn)))
+ (make-instance class
+ :cache cache
+ :name (plist-get (car cache) :name))))
+
+(defun ejc-direx:-filter-cache (items)
+ "Filter out cache items according to configuration."
+ (delq nil items))
+
+(defmethod direx:node-children ((node ejc-direx:object))
+ (mapcar 'ejc-direx:node-from-cache
+ (ejc-direx:-filter-cache (cdr (oref node :cache)))))
+
+
+;;; Face
+(defface ejc-direx:database
+ '((t :inherit font-lock-keyword-face))
+ "Face for database name in direx tree"
+ :group 'ejc-direx)
+
+(defface ejc-direx:schema
+ '((t :inherit font-lock-type-face))
+ "Face for schema name in direx tree"
+ :group 'ejc-direx)
+
+(defface ejc-direx:table
+ '((t :inherit font-lock-function-name-face))
+ "Face for table name in direx tree"
+ :group 'ejc-direx)
+
+(defface ejc-direx:colomn
+ '((t :inherit font-lock-variable-name-face))
+ "Face for column name in direx tree"
+ :group 'ejc-direx)
+
+
+;;; View
+
+(defclass ejc-direx:item (direx:item) ())
+
+(defmethod direx:make-item ((tree ejc-direx:object) parent)
+ (make-instance 'ejc-direx:item :tree tree :parent parent))
+
+(defmethod direx:make-item ((tree ejc-direx:colomn) parent)
+ (let ((item (call-next-method)))
+ (oset item :face 'ejc-direx:colomn)
+ item))
+
+(defmethod direx:make-item ((tree ejc-direx:table) parent)
+ (let ((item (call-next-method)))
+ (oset item :face 'ejc-direx:table)
+ item))
+
+(defmethod direx:make-item ((tree ejc-direx:schema) parent)
+ (let ((item (call-next-method)))
+ (oset item :face 'ejc-direx:schema)
+ item))
+
+(defmethod direx:make-item ((tree ejc-direx:database) parent)
+ (let ((item (call-next-method)))
+ (oset item :face 'ejc-direx:database)
+ item))
+
+(defun direx-ejc:-goto-item (item)
+ (destructuring-bind (&key line_nr column &allow-other-keys)
+ (car (oref (direx:item-tree item) :cache))
+ (ejc:goto--line-column line_nr column)))
+
+(defmethod direx:generic-find-item ((item ejc-direx:item)
+ not-this-window)
+ (let* ((root (direx:item-root item))
+ (filename (direx:file-full-name (direx:item-tree root))))
+ (if not-this-window
+ (find-file-other-window filename)
+ (find-file filename))
+ (direx-ejc:-goto-item item)))
+
+(defmethod direx:generic-display-item ((item ejc-direx:item))
+ (let* ((root (direx:item-root item))
+ (filename (direx:file-full-name (direx:item-tree root))))
+ (with-selected-window (display-buffer (find-file-noselect filename))
+ (direx-ejc:-goto-item item))))
+
+(defvar ejc-direx:item-refresh--recurring nil)
+
+(defun ejc-direx:get-structure ()
+ "Provide data - database structure for direx tree."
+ (cl-labels ((column-item (column)
+ (list :type "column" :name column))
+ (table-item (table)
+ (let ((columns
+ (ejc-get-cached-colomns-list ejc-db table t)))
+ (cons (list :type "table" :name table)
+ (-map 'list
+ (-map #'column-item columns)))))
+ (schema-item (schema)
+ (let ((tables (ejc-get-cached-tables-list
+ ejc-db schema t)))
+ (cons (list :type "schema" :name schema)
+ (-map #'table-item tables)))))
+ ;; Assume schema == owner (difference depends on exact database type).
+ (let ((schemas (ejc-get-cached-owners-list ejc-db t)))
+ (-map #'schema-item schemas))))
+
+(defmethod direx:item-refresh ((item ejc-direx:item) &key recursive)
+ "Currently it always recursively refreshes whole tree."
+ (if ejc-direx:item-refresh--recurring
+ (call-next-method)
+ (let* ((ejc-direx:item-refresh--recurring t)
+ (root (direx:item-root item))
+ (module (direx:item-tree root)))
+ (if (with-current-buffer (oref module :buffer)
+ (unless (eq (cdr (oref module :cache)) (ejc-direx:get-structure))
+ (oset module :cache (cons nil (ejc-direx:get-structure)))))
+ (call-next-method root :recursive t)
+ (message "No need to refresh")))))
+
+
+;;; Command
+
+(defun ejc-direx:make-buffer ()
+ (let ((current-ejc-db ejc-db)
+ (buf (direx:ensure-buffer-for-root
+ (make-instance 'ejc-direx:database
+ :name (format "%s" (ejc-get-db-name ejc-db))
+ :buffer (current-buffer)
+ :file-name (buffer-file-name)
+ :cache (cons nil (ejc-direx:get-structure))))))
+ (with-current-buffer buf
+ (setq-local ejc-db current-ejc-db))
+ buf))
+
+;;;###autoload
+(defun ejc-direx:pop-to-buffer ()
+ (interactive)
+ (pop-to-buffer (ejc-direx:make-buffer)))
+
+;;;###autoload
+(defun ejc-direx:switch-to-buffer ()
+ (interactive)
+ (switch-to-buffer (ejc-direx:make-buffer)))
+
+(provide 'ejc-direx)
+
+;;; ejc-direx.el ends here
--- /dev/null
+;;; ejc-doc.el -- SQL quick hints documentation.
+
+;; Copyright © wikipedia.org
+;; Creative Commons Attribution-ShareAlike license
+
+;;; Code:
+
+(require 'dash)
+
+(defconst ejc-sql-doc (make-hash-table :test 'eq))
+
+(defun ejc-fill-doc (&rest args)
+ (-reduce (lambda (key val)
+ (puthash key val ejc-sql-doc))
+ args))
+
+(defvar ejc-doc-created-p nil)
+
+(defun ejc-create-doc ()
+ (ejc-fill-doc
+ 'select
+ "The SQL SELECT statement returns a result
+set of records from one or more tables.
+
+SELECT
+ [DISTINCT | DISTINCTROW | ALL]
+ select_expression,...
+ FROM table_references
+ [WHERE where_definition]
+ [GROUP BY {unsigned_integer | col_name | formula}]
+ [HAVING where_definition]
+ [ORDER BY {unsigned_integer | col_name | formula} [ASC | DESC], ...]"
+
+ 'insert
+ "An SQL INSERT statement adds one or more records
+to any single table in a relational database.
+
+INSERT INTO table (column1 [, column2, column3 ... ])
+VALUES (value1 [, value2, value3 ... ])"
+
+ 'update
+ "An SQL UPDATE statement changes the data of one
+or more records in a table. Either all the rows can
+be updated, or a subset may be chosen using a condition.
+
+UPDATE table_name SET column_name = value [, column_name = value ...]
+[WHERE condition]"
+
+ 'delete
+ "The SQL DELETE statement removes one or more records from a table.
+
+DELETE FROM table_name [WHERE condition]"
+
+ 'alter
+ "The ALTER TABLE command modifies column definitions and table constraints
+'on the fly'. This means existing definitions are extended, changed or
+deleted or existing data is casted to a different type or existing data is
+evaluated against the new definitions.
+
+-- change column definitions
+ALTER TABLE <table_name> { ADD | ALTER } [ COLUMN ]
+ <column_name> <column_definition>;
+ALTER TABLE <table_name> { DROP } [ COLUMN ]
+ <column_name>;
+
+-- change table constraints
+ALTER TABLE <table_name> { ADD | ALTER } CONSTRAINT
+ <constraint_name> <constraint_definition>;
+ALTER TABLE <table_name> { DROP } CONSTRAINT
+ <constraint_name>;")
+ (setq ejc-doc-created-p t))
+
+(provide 'ejc-doc)
+
+;;; ejc-doc.el ends here
--- /dev/null
+;;; ejc-format.el -- SQL formatting library (the part of ejc-sql).
+
+;;; Copyright © 2012-2018 - Kostafey <kostafeyNOSPAMgmail.com>
+
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software Foundation,
+;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
+
+;;; Code:
+
+(require 'cua-base)
+(require 'ejc-lib)
+(require 'subr-x)
+
+(defvar ejc-sql-separator "/"
+ "The char with purpose to separate the SQL statement both other.")
+
+(defun ejc-sql-separator-re ()
+ (format "^\\s-*%s\\s-*" ejc-sql-separator))
+
+(defun ejc-get-sql-boundaries-at-point ()
+ "Returns list of the boundaries of the current SQL expression.
+The current SQL expression is the expression under the point.
+The boundaries are marked by `ejc-sql-separator's. If the top or
+bottom boundary is absent - it returns beginning or end of the
+buffer."
+ (save-excursion
+ (let* ((beg (progn
+ (if (re-search-backward (ejc-sql-separator-re) nil t nil)
+ (forward-char)
+ (beginning-of-buffer))
+ (point)))
+ (end (progn
+ (if (re-search-forward (ejc-sql-separator-re) nil t nil)
+ (backward-char)
+ (end-of-buffer))
+ (point))))
+ (list beg end))))
+
+(defmacro ejc--in-sql-boundaries (beg end &rest body)
+ "Inject `beg' and `end' local variables to the `body' scope.
+`beg' and `end' are the boundaries of the current sql expression."
+ `(let* ((boundaries (ejc-get-sql-boundaries-at-point))
+ (,beg (car boundaries))
+ (,end (car (cdr boundaries))))
+ ,@body))
+
+(defun ejc-mark-this-sql ()
+ "Select (mark) SQL around the point."
+ (interactive)
+ (ejc--in-sql-boundaries beg end
+ (when mark-active
+ (setq mark-active nil))
+ (goto-char beg)
+ (cua-set-mark)
+ (goto-char end)))
+
+(defun ejc-next-sql (&optional mark)
+ "Goto next SQL statement."
+ (interactive)
+ (ejc--in-sql-boundaries
+ beg end
+ (if (and mark (not mark-active))
+ (cua-set-mark))
+ (goto-char end)
+ (right-char 1)))
+
+(defun ejc-previous-sql (&optional mark)
+ "Goto previous SQL statement."
+ (interactive)
+ (ejc--in-sql-boundaries
+ beg end
+ (if (and mark (not mark-active))
+ (cua-set-mark))
+ (goto-char beg)
+ (left-char 1)))
+
+(defun ejc-apply-in-sql-boundaries (func)
+ (ejc--in-sql-boundaries beg end
+ (apply func (list beg end))))
+
+(defun ejc-get-sql-at-point ()
+ "Return SQL around the point."
+ (ejc--in-sql-boundaries beg end
+ (let ((sql (ejc-strip-text-properties (buffer-substring beg end))))
+ sql)))
+
+(defmacro ejc-ensure-sql-mode (&rest body)
+ `(if (not (equal major-mode 'sql-mode))
+ (error "SQL formatting is suitable in sql-mode only.")
+ (progn ,@body)))
+
+(defun ejc-format-sql (beg end)
+ (interactive "r")
+ (ejc-ensure-sql-mode
+ (save-excursion
+ (mapc (lambda (from-to)
+ (ejc-apply-in-sql-boundaries
+ (lambda (beg end)
+ (replace-regexp (car from-to) (cadr from-to) nil beg end))))
+ '(("\n" " ")
+ ("," ", ")
+ (" +" " ")
+ ("," ",\n ")
+ ("select" "select \n ")
+ (" from " "\nfrom \n ")
+ (" where " "\nwhere \n ")
+ (" and " "\n and ")
+ (" or " "\n or ")
+ (" order by " "\norder by \n")
+ (" inner join " "\ninner join ")
+ (" left join " "\nleft join ")
+ (" on " "\n on ")
+ (" group by " "\ngroup by "))))))
+
+(defun ejc-format-sql-at-point ()
+ (interactive)
+ (ejc--in-sql-boundaries
+ beg end
+ (ejc-format-sql beg end)))
+
+(defun ejc-pretty-print-sql-at-point ()
+ "Pretty-print SQL bounded by the `ejc-sql-separator' or/and buffer
+boundaries."
+ (interactive)
+ (ejc--in-sql-boundaries
+ beg end
+ (let ((result (ejc-pretty-print (buffer-substring beg end) :hibernate)))
+ (delete-region beg end)
+ (insert result))))
+
+(defun ejc-pretty-print-sql-region (beg end)
+ "Pretty-print SQL bounded by the selection area."
+ (interactive "r")
+ (let ((result (ejc-pretty-print (buffer-substring beg end) :hibernate)))
+ (delete-region beg end)
+ (insert result)))
+
+(defun ejc-insert-file-header ()
+ (interactive)
+ (insert (concat "-- -*- mode: sql; -*-\n"
+ "-- Local Variables:\n"
+ "-- eval: (ejc-sql-mode)\n"
+ "-- End:\n")))
+
+(defvar ejc-clear-sql-regexp
+ (concat "^\\s-*\\t*\""
+ "\\|\\\\n\"\s-*\\+$"
+ "\\|\\\\n\";$"))
+
+(defun ejc-strinp-sql-at-point ()
+ (interactive)
+ (ejc--in-sql-boundaries
+ beg end
+ (save-excursion
+ (replace-regexp ejc-clear-sql-regexp "" nil beg end)
+ (whitespace-cleanup-region beg end))))
+
+(defun ejc-longest-line-length (beg-line end-line)
+ (interactive)
+ (save-excursion
+ (let ((curr-line beg-line)
+ (max-length 0)
+ (new-length 0))
+ (while (<= curr-line end-line)
+ (goto-line curr-line)
+ (setq new-length (save-excursion
+ (end-of-line)
+ (current-column)))
+ (if (> new-length max-length)
+ (setq max-length new-length))
+ (setq curr-line (1+ curr-line)))
+ max-length)))
+
+(defun ejc-is-separator-string (pos)
+ (equal (string-trim (buffer-substring
+ pos
+ (save-excursion
+ (end-of-line)
+ (point))))
+ ejc-sql-separator))
+
+(defun ejc-dress-sql-at-point ()
+ (interactive)
+ (ejc-strinp-sql-at-point)
+ (save-excursion
+ (ejc--in-sql-boundaries
+ beg end
+ (let* ((beg-line (progn (goto-char beg)
+ (right-char)
+ (line-number-at-pos)))
+ (end-line (progn (goto-char end)
+ (if (ejc-is-separator-string end)
+ (left-char 1))
+ (line-number-at-pos)))
+ (length-line (ejc-longest-line-length beg-line end-line))
+ (curr-line beg-line))
+ (while (<= curr-line end-line)
+ (goto-line curr-line)
+ (beginning-of-line)
+ (insert "\"")
+ (end-of-line)
+ (dotimes (counter (+ 2 (- length-line (current-column))))
+ (insert " "))
+ (if (equal curr-line end-line)
+ (insert "\\n\";")
+ (insert "\\n\" +"))
+ (setq curr-line (1+ curr-line)))))))
+
+(defun ejc-flash-region (start end &optional timeout)
+ "Temporarily highlight region from START to END."
+ (let ((overlay (make-overlay start end)))
+ (overlay-put overlay 'face 'secondary-selection)
+ (run-with-timer (or timeout 0.2) nil 'delete-overlay overlay)))
+
+(defun ejc-flash-this-sql ()
+ "Select (mark) SQL around the point."
+ (interactive)
+ (ejc--in-sql-boundaries
+ beg end
+ (ejc-flash-region beg end)))
+
+(provide 'ejc-format)
+
+;;; ejc-format.el ends here
--- /dev/null
+;;; ejc-interaction.el -- ejc-sql interact with Clojure. -*- lexical-binding: t -*-
+
+;;; Copyright © 2013-2018 - Kostafey <kostafeyNOSPAMgmail.com>
+
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software Foundation,
+;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
+
+;;; Code:
+
+(require 'ejc-lib)
+(require 'ejc-format)
+(require 'clomacs)
+
+(clomacs-create-httpd-start ejc-httpd-start
+ :lib-prefix "ejc"
+ :lib-name "ejc-sql")
+
+(clomacs-create-httpd-stop ejc-httpd-stop
+ :lib-prefix "ejc"
+ :lib-name "ejc-sql")
+
+(clomacs-defun ejc-sql-set-db
+ set-db
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.connect
+ :doc "Define ejc-sql.connect/db var."
+ :httpd-starter 'ejc-httpd-start)
+
+(clomacs-defun ejc-add-classpath
+ add-classpath
+ :lib-name "ejc-sql"
+ :namespace cemerick.pomegranate)
+
+(clomacs-defun ejc-require
+ clojure.core/require
+ :lib-name "ejc-sql")
+
+(clomacs-defun ejc-import
+ clojure.core/import
+ :lib-name "ejc-sql")
+
+(defun ejc-connect-to-db (conn-struct)
+ (ejc-require `'cemerick.pomegranate)
+ (ejc-add-classpath (alist-get :classpath conn-struct))
+ (if-let ((classname (alist-get :classname conn-struct)))
+ (ejc-import (read classname)))
+ (ejc-sql-set-db conn-struct)
+ (setq-local ejc-connection-struct conn-struct))
+
+(defun ejc-get-sql-from-string (sql)
+ (let* ((sql (replace-regexp-in-string ejc-clear-sql-regexp "" sql))
+ (sql (replace-regexp-in-string "\"" "'" sql)))
+ sql))
+
+(clomacs-defun ejc--eval-sql-and-log-print
+ eval-sql-and-log-print
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.connect
+ :return-type :string
+ :doc "Core function to evaluate SQL queries.
+ Prepare SQL string, evaluate SQL script and write them to log file")
+
+(clomacs-defun ejc--is-query-running-p
+ is-query-running?
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.connect
+ :return-type :boolean)
+
+(clomacs-defun ejc--cancel-query
+ cancel-query
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.connect
+ :doc "Cancel current query."
+ :interactive t
+ :return-type :list)
+
+(clomacs-defun ejc--eval-sql-get-column
+ eval-sql-internal-get-column
+ :lib-name "ejc-sql"
+ :return-type :list
+ :namespace ejc-sql.connect
+ :doc "Get `sql', return list.")
+
+(defalias 'ejc--eval-get-list 'ejc--eval-sql-get-column)
+
+(clomacs-defun ejc-get-table-meta
+ ejc-sql.connect/get-table-meta
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.connect)
+
+(clomacs-defun ejc-print
+ clojure.core/print
+ :lib-name "ejc-sql"
+ :return-type :string
+ :return-value :stdout)
+
+(clomacs-defun ejc-write-result-file
+ write-result-file
+ :namespace ejc-sql.output
+ :lib-name "ejc-sql"
+ :return-type :string)
+
+(clomacs-defun ejc-clear-result-file
+ clear-result-file
+ :namespace ejc-sql.output
+ :lib-name "ejc-sql"
+ :return-type :string)
+
+(clomacs-defun ejc-get-log-file-path
+ print-log-file-path
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.output
+ :return-value :stdout)
+
+(clomacs-defun ejc-pretty-print
+ pretty-print
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.output
+ :return-value :stdout)
+
+(clomacs-defun ejc-set-rows-limit
+ set-rows-limit
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.output
+ :doc (concat "Set limit for number of records to output. "
+ "When nil no limit."))
+
+(clomacs-defun ejc-get-stucture
+ get-stucture
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.structure
+ :return-type :list)
+
+(clomacs-defun ejc-get-owners-candidates
+ get-owners-candidates
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.structure
+ :return-type :list)
+
+(clomacs-defun ejc-get-tables-candidates
+ get-tables-candidates
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.structure
+ :return-type :list)
+
+(clomacs-defun ejc-get-colomns-candidates
+ get-colomns-candidates
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.structure
+ :return-type :list)
+
+(clomacs-defun ejc-get-cached-owners-list
+ get-owners
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.structure
+ :return-type :list)
+
+(clomacs-defun ejc-get-cached-tables-list
+ get-tables
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.structure
+ :return-type :list
+ :doc "Return cached tables list.
+ Requires `ejc-db' buffer local variable as parameter.")
+
+(clomacs-defun ejc-get-cached-colomns-list
+ get-colomns
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.structure
+ :return-type :list)
+
+(clomacs-defun ejc-invalidate-cache-inner
+ invalidate-cache
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.structure
+ :doc (concat "Clean your current connection cache "
+ "(database owners and tables list)."))
+
+(clomacs-defun ejc-validate-connection
+ validate-connection
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.connect
+ :return-type :boolean)
+
+(defun ejc-invalidate-cache ()
+ "Clean current connection cache (database owners and tables list)."
+ (interactive)
+ (ejc-invalidate-cache-inner ejc-connection-struct))
+
+(clomacs-defun ejc-get-cache
+ get-cache
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.structure)
+
+(clomacs-defun ejc-select-db-meta-script
+ select-db-meta-script
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.structure)
+
+(clomacs-defun ejc-get-db-name
+ get-db-name
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.structure)
+
+(defun ejc-quit-connection ()
+ "Stop nREPL process, mark ejc-sql-mode buffers disconnected."
+ (interactive)
+ (when (y-or-n-p "Are you sure you want to close all jdbc connections?")
+ (ejc-httpd-stop)
+ (cider--close-connection (clomacs-get-connection "ejc-sql"))
+ ;; Update modeline of ejc-sql-mode buffers - mark as disconnected.
+ (let ((buffers (buffer-list)))
+ (while buffers
+ (with-current-buffer (car buffers)
+ (when (member 'ejc-sql-mode minor-mode-list)
+ (sql-highlight-product)
+ (spinner-stop)))
+ (setq buffers (cdr buffers)))))
+ (unless (cider-connected-p)
+ (cider-close-ancillary-buffers)))
+
+(defalias 'ejc-close-connection 'ejc-quit-connection)
+
+(defun ejc-buffer-connected-p ()
+ "Check if current buffer is connected to database."
+ (and (clomacs-get-connection "ejc-sql") (boundp 'ejc-db) ejc-db))
+
+(provide 'ejc-interaction)
+
+;;; ejc-interaction.el ends here
--- /dev/null
+;;; ejc-lib.el -- ejc-sql shared objects (the part of ejc-sql).
+
+;;; Copyright © 2013-2016 - Kostafey <kostafeyNOSPAMgmail.com>
+
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software Foundation,
+;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
+
+;;; Code:
+
+(defvar-local ejc-connection-name nil
+ "Buffer-local connection name created with `ejc-create-connection'.")
+
+(defvar-local ejc-connection-struct nil
+ "Buffer-local connection structure.")
+
+(defun ejc-string-endswith-p (s ending)
+ "Return non-nil if string S ends with ENDING."
+ (let ((elength (length ending)))
+ (string= (substring s (- 0 elength)) ending)))
+
+(defun ejc-find-file-in-load-path (search-file-name &optional fail-on-error)
+ "Return the full path to `file-name'.
+`file-name' is searching in the emacs `load-path'."
+ (let ((result nil))
+ (dolist (path load-path)
+ (let ((search-file-path (expand-file-name search-file-name path)))
+ (if (file-exists-p search-file-path)
+ (setq result search-file-path))))
+ (if (and fail-on-error (not result))
+ (error (concat "Can't find file " search-file-name))
+ result)))
+
+(defun ejc-strip-text-properties (txt)
+ (set-text-properties 0 (length txt) nil txt)
+ txt)
+
+(provide 'ejc-lib)
+
+;;; ejc-lib.el ends here
--- /dev/null
+;;; ejc-result-mode.el
+
+;;; Copyright © 2017 - Kostafey <kostafeyNOSPAMgmail.com>
+
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software Foundation,
+;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
+
+;;; Code:
+
+(defface ejc-result-table-borders-face '((t :inherit font-lock-comment-face
+ :italic nil))
+ "Face used to font-lock table borders."
+ :group 'ejc-sql-faces)
+
+(defconst ejc-result-font-lock-keywords
+ '(("|" . 'ejc-result-table-borders-face)
+ ("-" . 'ejc-result-table-borders-face)
+ ("+" . 'ejc-result-table-borders-face)))
+
+(defun ejc-result-mode ()
+ (interactive)
+ (kill-all-local-variables)
+ (setq view-read-only t)
+ (setq truncate-lines t)
+ (setq major-mode 'ejc-result-mode
+ mode-name "SQL-Result")
+ (setq font-lock-defaults '(ejc-result-font-lock-keywords)))
+
+(provide 'ejc-result-mode)
+
+;;; ejc-result-mode.el ends here
--- /dev/null
+;;; ejc-sql-autoloads.el --- automatically extracted autoloads
+;;
+;;; Code:
+
+(add-to-list 'load-path (directory-file-name
+ (or (file-name-directory #$) (car load-path))))
+
+\f
+;;;### (autoloads nil "ejc-autocomplete" "ejc-autocomplete.el" (0
+;;;;;; 0 0 0))
+;;; Generated autoloads from ejc-autocomplete.el
+
+(autoload 'ejc-owners-candidates "ejc-autocomplete" "\
+
+
+\(fn)" nil nil)
+
+(autoload 'ejc-tables-candidates "ejc-autocomplete" "\
+
+
+\(fn)" nil nil)
+
+(autoload 'ejc-colomns-candidates "ejc-autocomplete" "\
+
+
+\(fn)" nil nil)
+
+(autoload 'ejc-ac-setup "ejc-autocomplete" "\
+Add the completion sources to the front of `ac-sources'.
+This affects only the current buffer.
+
+Check against following cases:
+prefix-2.prefix-1.#
+prefix-1.#
+something#
+
+\(fn)" t nil)
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ejc-autocomplete" '("ejc-" "ac-")))
+
+;;;***
+\f
+;;;### (autoloads nil "ejc-direx" "ejc-direx.el" (0 0 0 0))
+;;; Generated autoloads from ejc-direx.el
+
+(autoload 'ejc-direx:pop-to-buffer "ejc-direx" "\
+
+
+\(fn)" t nil)
+
+(autoload 'ejc-direx:switch-to-buffer "ejc-direx" "\
+
+
+\(fn)" t nil)
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ejc-direx" '("ejc-direx:" "direx")))
+
+;;;***
+\f
+;;;### (autoloads nil "ejc-doc" "ejc-doc.el" (0 0 0 0))
+;;; Generated autoloads from ejc-doc.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ejc-doc" '("ejc-")))
+
+;;;***
+\f
+;;;### (autoloads nil "ejc-format" "ejc-format.el" (0 0 0 0))
+;;; Generated autoloads from ejc-format.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ejc-format" '("ejc-")))
+
+;;;***
+\f
+;;;### (autoloads nil "ejc-interaction" "ejc-interaction.el" (0 0
+;;;;;; 0 0))
+;;; Generated autoloads from ejc-interaction.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ejc-interaction" '("ejc-")))
+
+;;;***
+\f
+;;;### (autoloads nil "ejc-lib" "ejc-lib.el" (0 0 0 0))
+;;; Generated autoloads from ejc-lib.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ejc-lib" '("ejc-")))
+
+;;;***
+\f
+;;;### (autoloads nil "ejc-result-mode" "ejc-result-mode.el" (0 0
+;;;;;; 0 0))
+;;; Generated autoloads from ejc-result-mode.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ejc-result-mode" '("ejc-result-")))
+
+;;;***
+\f
+;;;### (autoloads nil "ejc-sql" "ejc-sql.el" (0 0 0 0))
+;;; Generated autoloads from ejc-sql.el
+
+(autoload 'ejc-sql-mode "ejc-sql" "\
+Toggle ejc-sql mode.
+
+\(fn &optional ARG)" t nil)
+
+(autoload 'ejc-create-menu "ejc-sql" "\
+
+
+\(fn)" nil nil)
+
+(autoload 'ejc-connect "ejc-sql" "\
+Connect to selected db.
+
+\(fn CONNECTION-NAME)" t nil)
+
+(autoload 'ejc-connect-existing-repl "ejc-sql" "\
+Connect to existing ejc-sql nREPL running process.
+You can `cd` to your ejc-sql project folder (typically
+'~/.emacs.d/elpa/ejc-sql-<version>') and launch nREPL via `lein repl`.
+Then run in Emacs `ejc-connect-existing-repl', type HOST and PORT
+from your `lein run` console output. Finally, use `ejc-connect' from
+any SQL buffer to connect to exact database, as always.
+
+\(fn)" t nil)
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ejc-sql" '("ejc-")))
+
+;;;***
+\f
+;;;### (autoloads nil nil ("ejc-sql-pkg.el") (0 0 0 0))
+
+;;;***
+\f
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; coding: utf-8
+;; End:
+;;; ejc-sql-autoloads.el ends here
--- /dev/null
+(define-package "ejc-sql" "20181111.2343" "Emacs SQL client uses Clojure JDBC."
+ '((emacs "25.1")
+ (clomacs "0.0.3")
+ (dash "2.12.1")
+ (auto-complete "1.5.1")
+ (spinner "1.7.1")
+ (direx "1.0.0"))
+ :keywords
+ '("sql" "jdbc")
+ :authors
+ '(("Kostafey" . "kostafeyNOSPAMgmail.com"))
+ :maintainer
+ '("Kostafey" . "kostafeyNOSPAMgmail.com")
+ :url "https://github.com/kostafey/ejc-sql")
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
--- /dev/null
+;;; ejc-sql.el --- Emacs SQL client uses Clojure JDBC. -*- lexical-binding: t -*-
+
+;;; Copyright © 2012-2018 - Kostafey <kostafeyNOSPAMgmail.com>
+
+;; Author: Kostafey <kostafeyNOSPAMgmail.com>
+;; URL: https://github.com/kostafey/ejc-sql
+;; Keywords: sql, jdbc
+;; Version: 0.0.1
+;; Package-Requires: ((emacs "25.1")(clomacs "0.0.3")(dash "2.12.1")(auto-complete "1.5.1")(spinner "1.7.1")(direx "1.0.0"))
+
+;; This file is not part of GNU Emacs.
+
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software Foundation,
+;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
+
+;;; Commentary:
+
+;; ejc-sql turns Emacs into simple SQL client, it uses JDBC connection to
+;; databases via clojure/java.jdbc lib.
+
+;; See README.md for detailed description.
+
+;;; Code:
+
+(require 'sql)
+(require 'dash)
+(require 'cl-lib)
+(require 'ejc-lib)
+(require 'ejc-direx)
+(require 'ejc-format)
+(require 'ejc-interaction)
+(require 'ejc-result-mode)
+(require 'ejc-autocomplete)
+
+(defvar-local ejc-db nil
+ "JDBC connection info for current SQL buffer.")
+
+(defvar ejc-connections nil
+ "List of existing configured jdbc connections")
+
+(defvar ejc-results-buffer nil
+ "The results buffer.")
+
+(defvar ejc-results-buffer-name "*ejc-sql-output*"
+ "The results buffer name.")
+
+(defvar ejc-result-file-path nil
+ "The results file path. Refreshed by any finished SQL evaluation.")
+
+(defvar ejc-current-buffer-query nil
+ "Current SQL edit buffer lanched query.")
+
+(defvar ejc-temp-editor-buffer-name "*ejc-sql-editor*"
+ "The buffer for conveniently edit ad-hoc SQL scripts.")
+
+(defvar ejc-temp-editor-file (expand-file-name "~/tmp/ejc-sql-editor.sql"))
+
+(defcustom ejc-keymap-prefix (kbd "C-c e")
+ "ejc-sql keymap prefix."
+ :group 'ejc-sql
+ :type 'string)
+
+(defcustom ejc-date-output-format "%d.%m.%Y %H:%M:%S"
+ "ejc-sql date output format."
+ :group 'ejc-sql
+ :type 'string)
+
+(defcustom ejc-connection-validate-timeout 5
+ "The time in seconds to wait for the database connection validation."
+ :group 'ejc-sql
+ :type 'integer)
+
+(defvar ejc-sql-mode-keymap (make-keymap) "ejc-sql-mode keymap.")
+(define-key ejc-sql-mode-keymap (kbd "C-c C-c") 'ejc-eval-user-sql-at-point)
+(define-key ejc-sql-mode-keymap (kbd "C-h t") 'ejc-describe-table)
+(define-key ejc-sql-mode-keymap (kbd "C-h T") 'ejc-describe-entity)
+(define-key ejc-sql-mode-keymap (kbd "C-M-S-b") '(lambda() (interactive) (ejc-previous-sql t)))
+(define-key ejc-sql-mode-keymap (kbd "C-M-S-f") '(lambda() (interactive) (ejc-next-sql t)))
+(define-key ejc-sql-mode-keymap (kbd "C-M-b") 'ejc-previous-sql)
+(define-key ejc-sql-mode-keymap (kbd "C-M-f") 'ejc-next-sql)
+(define-key ejc-sql-mode-keymap (kbd "C-g") 'ejc-cancel-query)
+
+(defvar ejc-command-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "<up>") #'ejc-show-last-result)
+ (define-key map (kbd "t") #'ejc-show-tables-list)
+ (define-key map (kbd "T") #'ejc-show-user-types-list)
+ (define-key map (kbd "s") #'ejc-strinp-sql-at-point)
+ (define-key map (kbd "S") #'ejc-dress-sql-at-point)
+ (define-key map (kbd "p") #'ejc-pretty-print-sql-at-point)
+ map)
+ "Keymap for ejc-sql commands after `ejc-keymap-prefix'.")
+(fset 'ejc-command-map ejc-command-map)
+
+(define-key ejc-sql-mode-keymap ejc-keymap-prefix 'ejc-command-map)
+
+(defvar ejc-sql-minor-mode-exit-hook nil
+ "*Functions to be called when `ejc-sql-mode' is exited.")
+
+(defvar ejc-sql-minor-mode-hook nil
+ "*Functions to be called when `ejc-sql-mode' is entered.")
+
+(defvar ejc-sql-mode nil)
+
+(defvar ejc-conn-statistics (list)
+ "Keep connection usage statistics and offer most frequently used first
+ when `ejc-connect' is called.")
+
+(defcustom ejc-conn-statistics-file (expand-file-name
+ "~/.ejc-sql/connection-statistics.el")
+ "Connection usage statistics data file location."
+ :group 'ejc-sql
+ :type 'string)
+
+(defface ejc-separator-face
+ '((t :inherit font-lock-function-name-face))
+ "Face used to highlight SQL statement separators."
+ :group 'ejc-sql)
+
+(defun ejc-refresh-font-lock ()
+ (funcall (if ejc-sql-mode
+ 'font-lock-add-keywords
+ 'font-lock-remove-keywords)
+ nil `((,(ejc-sql-separator-re) . 'ejc-separator-face)))
+ (if (fboundp 'font-lock-flush)
+ (font-lock-flush)
+ (when font-lock-mode
+ (with-no-warnings (font-lock-fontify-buffer))))
+ (run-hooks 'ejc-sql-minor-mode-hook))
+
+;;;###autoload
+(define-minor-mode ejc-sql-mode
+ "Toggle ejc-sql mode."
+ :lighter " ejc"
+ :keymap ejc-sql-mode-keymap
+ :group 'ejc
+ :global nil
+ ;; :after-hook (ejc-create-menu)
+ (if ejc-sql-mode
+ (progn
+ (ejc-ac-setup)
+ (ejc-create-menu)
+ (ejc-refresh-font-lock))
+ (progn
+ ;; (global-unset-key [menu-bar ejc-menu])
+ (ejc-refresh-font-lock)
+ (run-hooks 'ejc-sql-minor-mode-exit-hook))))
+
+;;;###autoload
+(defun ejc-create-menu ()
+ (define-key-after
+ ejc-sql-mode-keymap
+ [menu-bar ejc-menu]
+ (cons "ejc-sql" (make-sparse-keymap "ejc-sql mode"))
+ 'tools )
+ (define-key
+ ejc-sql-mode-keymap
+ [menu-bar ejc-menu ev]
+ '("Eval SQL" . ejc-eval-user-sql-at-point))
+ (define-key
+ ejc-sql-mode-keymap
+ [menu-bar ejc-menu fs]
+ '("Format SQL" . ejc-format-sql-at-point))
+ (define-key
+ ejc-sql-mode-keymap
+ [menu-bar ejc-menu ms]
+ '("Mark SQL" . ejc-mark-this-sql))
+ (define-key
+ ejc-sql-mode-keymap
+ [menu-bar ejc-menu tl]
+ '("Show tables list" . ejc-show-tables-list))
+ (define-key
+ ejc-sql-mode-keymap
+ [menu-bar ejc-menu cl]
+ '("Show constraints list" . ejc-show-constraints-list))
+ (define-key
+ ejc-sql-mode-keymap
+ [menu-bar ejc-menu pl]
+ '("Show procedures list" . ejc-show-procedures-list))
+ (define-key
+ ejc-sql-mode-keymap
+ [menu-bar ejc-menu ss]
+ '("Strip SQL" . ejc-strinp-sql-at-point))
+ (define-key
+ ejc-sql-mode-keymap
+ [menu-bar ejc-menu ds]
+ '("Dress SQL" . ejc-dress-sql-at-point))
+ (define-key
+ ejc-sql-mode-keymap
+ [menu-bar ejc-menu ol]
+ '("Open log" . ejc-open-log))
+ (define-key
+ ejc-sql-mode-keymap
+ [menu-bar ejc-menu sl]
+ '("Show last result" . ejc-show-last-result))
+ (define-key
+ ejc-sql-mode-keymap
+ [menu-bar ejc-menu qc]
+ '("Quit connection" . ejc-quit-connection)))
+
+(cl-defun ejc-create-connection (connection-name
+ &key
+ ;; ----------
+ ;; DriverManager (preferred):
+ dbtype
+ dbname
+ host
+ port
+ ;; others (may include :user and :password)
+ ;; ----------
+ ;; Raw:
+ connection-uri
+ ;; others (may include :user and :password)
+ ;; ----------
+ ;; DriverManager (alternative / legacy style):
+ subprotocol
+ subname
+ ;; ----------
+ ;; Others:
+ user
+ password
+ classpath
+ separator
+ ;; ----------
+ ;; Optional:
+ classname)
+ "Add new connection configuration named CONNECTION-NAME.
+It adds new connection to `ejc-connections' list or replace existing with the
+same CONNECTION-NAME.
+For more details about parameters see `get-connection' function in jdbc.clj:
+`https://github.com/clojure/java.jdbc/blob/master/src/main/clojure/clojure/java/jdbc.clj'"
+ (setq ejc-connections
+ (-remove (lambda (x) (equal (car x) connection-name))
+ ejc-connections))
+ (setq ejc-connections
+ (cons (cons
+ connection-name
+ (let ((new-connection nil))
+ (-map (lambda (arg)
+ (if (cdr arg)
+ (setq new-connection
+ (cons arg new-connection))))
+ (list
+ (cons :dbtype dbtype)
+ (cons :dbname dbname)
+ (cons :host host)
+ (cons :port port)
+ (cons :connection-uri connection-uri)
+ (cons :subprotocol subprotocol)
+ (cons :subname subname)
+ (cons :user user)
+ (cons :password password)
+ (cons :classpath classpath)
+ (cons :separator separator)
+ (cons :classname classname)))
+ new-connection))
+ ejc-connections)))
+
+(defun ejc-find-connection (connection-name)
+ "Return pair with name CONNECTION-NAME and db connection structure from
+`ejc-connections'."
+ (-find (lambda (x) (equal (car x) connection-name))
+ ejc-connections))
+
+(defvar ejc-product-assoc
+ '((sqlserver . ms)))
+
+(defun ejc-configure-sql-buffer (product-name)
+ (unless (org-src-edit-buffer-p)
+ (sql-mode))
+ (sql-set-product (or (cdr (assoc-string product-name ejc-product-assoc))
+ (car (assoc-string product-name sql-product-alist))
+ "ansi"))
+ (auto-complete-mode t)
+ (auto-fill-mode t)
+ (ejc-sql-mode)
+ (ejc-sql-mode t))
+
+(defun ejc-load-conn-statistics ()
+ "Load connection usage statistics to `ejc-conn-statistics' var."
+ (condition-case nil
+ (let ((dir (file-name-directory ejc-conn-statistics-file)))
+ (if (not (file-accessible-directory-p dir))
+ (make-directory dir))
+ (load-file ejc-conn-statistics-file))
+ (error
+ (with-temp-file ejc-conn-statistics-file
+ (insert "(setq ejc-conn-statistics (list))"))
+ (load-file ejc-conn-statistics-file)))
+ ejc-conn-statistics)
+
+(defun ejc-update-conn-statistics (connection-name)
+ "Update connection usage statistics, persist it in `ejc-conn-statistics-file'"
+ (setq ejc-conn-statistics
+ (lax-plist-put
+ ejc-conn-statistics
+ connection-name
+ (1+ (or (lax-plist-get ejc-conn-statistics connection-name) 0))))
+ (with-temp-file ejc-conn-statistics-file
+ (insert "(setq ejc-conn-statistics '")
+ (prin1 ejc-conn-statistics (current-buffer))
+ (insert ")")))
+
+;;;###autoload
+(defun ejc-connect (connection-name)
+ "Connect to selected db."
+ (interactive
+ (list
+ (ido-completing-read
+ "DataBase connection name: "
+ (let ((conn-list (mapcar 'car ejc-connections))
+ (conn-statistics (ejc-load-conn-statistics)))
+ (-sort (lambda (c1 c2)
+ (> (or (lax-plist-get conn-statistics c1) 0)
+ (or (lax-plist-get conn-statistics c2) 0)))
+ conn-list)))))
+ (let ((db (cdr (ejc-find-connection connection-name))))
+ (ejc-update-conn-statistics connection-name)
+ (ejc-configure-sql-buffer (or (alist-get :subprotocol db)
+ (alist-get :dbtype db)))
+ (setq-local ejc-connection-name connection-name)
+ (setq-local ejc-db db)
+ (message "Connection started...")
+ (ejc-connect-to-db db)
+ (when (ejc-validate-connection :db ejc-db
+ :timeout ejc-connection-validate-timeout)
+ (setq mode-name (format "%s->[%s]" mode-name connection-name))
+ (message "Connected."))))
+
+;;;###autoload
+(defun ejc-connect-existing-repl ()
+ "Connect to existing ejc-sql nREPL running process.
+You can `cd` to your ejc-sql project folder (typically
+'~/.emacs.d/elpa/ejc-sql-<version>') and launch nREPL via `lein repl`.
+Then run in Emacs `ejc-connect-existing-repl', type HOST and PORT
+from your `lein run` console output. Finally, use `ejc-connect' from
+any SQL buffer to connect to exact database, as always. "
+ (interactive)
+ (let* ((params (cider-select-endpoint))
+ (host (car params))
+ (port (cdr params))
+ (current-repl-b-name (cider-connect (list :host host :port port)))
+ (ejc-repl-b-name (nrepl-repl-buffer-name
+ (list
+ :session-name "ejc-sql"
+ :repl-type "clj"
+ :host host
+ :port port))))
+ (with-current-buffer current-repl-b-name
+ (rename-buffer ejc-repl-b-name))))
+
+(defun ejc-get-word-at-point (pos)
+ "Return SQL word around the point."
+ (interactive "d")
+ (let* ((char (char-after pos))
+ (str (char-to-string char)))
+ (save-excursion
+ (let* ((end (if (member str '(" " ")" "<" ">" "="))
+ (point)
+ (progn
+ (forward-sexp 1)
+ (point))))
+ (beg (progn
+ (forward-sexp -1)
+ (point)))
+ (sql-word (buffer-substring beg end)))
+ sql-word))))
+
+(defun ejc-get-prompt-symbol-under-point (msg)
+ (let ((sql-symbol (if mark-active
+ (buffer-substring (mark) (point))
+ (ejc-get-word-at-point (point))))
+ (enable-recursive-minibuffers t)
+ val)
+ (setq val (completing-read
+ (if sql-symbol
+ (format "%s (default %s): " msg sql-symbol)
+ (format "%s: " msg))
+ obarray))
+ (list (if (equal val "")
+ sql-symbol
+ val))))
+
+(defun ejc-check-connection ()
+ (unless (ejc-buffer-connected-p)
+ (error "Run M-x ejc-connect first!")))
+
+(cl-defun ejc-eval-sql-and-log (db sql
+ &key start-time rows-limit append sync)
+ (when sql
+ (spinner-start 'rotating-line)
+ (setq ejc-current-buffer-query (current-buffer))
+ (let* ((prepared-sql (ejc-get-sql-from-string sql)))
+ (ejc--eval-sql-and-log-print
+ db
+ prepared-sql
+ :start-time start-time
+ :rows-limit rows-limit
+ :append append
+ :sync sync))))
+
+(defun ejc-message-query-done (start-time result)
+ (message
+ "%s SQL query at %s. Exec time %.03f"
+ (case result
+ (:done (propertize "Done" 'face 'font-lock-keyword-face))
+ (:error (propertize "Error" 'face 'error))
+ (:terminated (propertize "Terminated" 'face 'font-lock-keyword-face)))
+ (format-time-string ejc-date-output-format
+ (current-time))
+ (float-time (time-since start-time))))
+
+(cl-defun ejc-complete-query (result-file-path &key start-time result)
+ (setq ejc-result-file-path result-file-path)
+ (with-current-buffer ejc-current-buffer-query
+ (spinner-stop))
+ (ejc-show-last-result nil :result-file-path ejc-result-file-path)
+ (if (and start-time result)
+ (ejc-message-query-done start-time result))
+ nil)
+
+(cl-defun ejc-cancel-query (&key start-time)
+ "Terminate current (long) running query. Aimed to cancel SELECT queries.
+Unsafe for INSERT/UPDATE/CREATE/ALTER queries."
+ (interactive)
+ (if (and (clomacs-get-connection "ejc-sql")
+ (ejc--is-query-running-p))
+ (let ((start-time (ejc--cancel-query)))
+ (with-current-buffer ejc-current-buffer-query
+ (spinner-stop))
+ (ejc-message-query-done start-time :terminated))
+ (keyboard-quit)))
+
+(defun ejc-describe-table (table-name)
+ "Describe SQL table TABLE-NAME (default table name - word around the point)."
+ (interactive (ejc-get-prompt-symbol-under-point "Describe table"))
+ (ejc-check-connection)
+ (let* ((owner (car (split-string table-name "\\.")))
+ (table (cadr (split-string table-name "\\."))))
+ (when (not table)
+ (setq table owner)
+ (setq owner nil))
+ (ejc-get-table-meta ejc-db table-name)
+ (let ((sql (ejc-select-db-meta-script ejc-db :constraints
+ :owner owner
+ :table table)))
+ (when (ejc-not-nil-str sql)
+ (ejc-write-result-file (concat "\n"
+ "Constraints:\n"
+ "------------\n")
+ :append t)
+ (ejc-eval-sql-and-log ejc-db sql :append t)))))
+
+(defun ejc-describe-entity (entity-name)
+ "Describe SQL entity ENTITY-NAME - function, procedure, type or view
+ (default entity name - word around the point)."
+ (interactive (ejc-get-prompt-symbol-under-point "Describe entity"))
+ (ejc-check-connection)
+ (ejc-show-last-result
+ (let ((entity-result
+ ;; Try to get entity source code.
+ (ejc-eval-sql-and-log
+ ejc-db
+ (ejc-select-db-meta-script ejc-db :entity
+ :entity-name entity-name))))
+ (if (not (equal entity-result "nil"))
+ ;; Show entity text.
+ ;; Assume there is no entity and view with the same names.
+ entity-result
+ ;; No entity with such name.
+ ;; Try to get view source code.
+ (ejc-eval-sql-and-log
+ ejc-db
+ (ejc-select-db-meta-script ejc-db :view
+ :entity-name entity-name))))))
+
+(cl-defun ejc-eval-user-sql (sql &key rows-limit sync)
+ "Evaluate SQL by user: reload and show query results buffer, update log."
+ (message "Processing SQL query...")
+ (ejc-eval-sql-and-log ejc-db
+ sql
+ :rows-limit rows-limit
+ :start-time (current-time)
+ :sync sync))
+
+(defun ejc-eval-user-sql-region (beg end)
+ "Evaluate SQL bounded by the selection area."
+ (interactive "r")
+ (ejc-check-connection)
+ (let ((sql (buffer-substring beg end)))
+ (ejc-eval-user-sql sql)))
+
+(cl-defun ejc-eval-user-sql-at-point (&key sync)
+ "Evaluate SQL bounded by the `ejc-sql-separator' or/and buffer
+boundaries."
+ (interactive)
+ (ejc-check-connection)
+ (ejc-flash-this-sql)
+ (ejc-eval-user-sql (ejc-get-sql-at-point) :sync sync))
+
+(defun ejc-show-tables-list ()
+ "Output tables list."
+ (interactive)
+ (ejc-check-connection)
+ (ejc-eval-user-sql
+ (ejc-select-db-meta-script ejc-db :all-tables)
+ :rows-limit 0))
+
+(defun ejc-show-user-types-list (&optional owner)
+ "Output user types list."
+ (interactive)
+ (ejc-check-connection)
+ (ejc-eval-user-sql (ejc-select-db-meta-script ejc-db :types
+ :owner owner)))
+
+(defun ejc-show-constraints-list (&optional owner table)
+ "Output constraints list."
+ (interactive)
+ (ejc-check-connection)
+ (ejc-eval-user-sql (ejc-select-db-meta-script ejc-db :constraints
+ :owner owner
+ :table table)))
+
+(defun ejc-show-procedures-list (&optional owner)
+ "Output procedures list."
+ (interactive)
+ (ejc-eval-user-sql (ejc-select-db-meta-script ejc-db :procedures
+ :owner owner)))
+
+;;-----------------------------------------------------------------------------
+;; results buffer
+;;
+(defun ejc-create-output-buffer ()
+ (set-buffer (get-buffer-create ejc-results-buffer-name))
+ (setq ejc-results-buffer (current-buffer))
+ (ejc-result-mode)
+ ejc-results-buffer)
+
+(defun ejc-get-buffer-or-create (buffer-or-name create-buffer-fn)
+ "Return buffer passed in `buffer-or-name' parameter.
+If this buffer is not exists or it was killed - create buffer via
+`create-buffer-fn' function (this function must return buffer)."
+ (let ((buf (if (bufferp buffer-or-name)
+ buffer-or-name
+ (get-buffer buffer-or-name))))
+ (if (and buf (buffer-live-p buf))
+ buf
+ (apply create-buffer-fn nil))))
+
+(defun ejc-get-output-buffer ()
+ (if (and ejc-results-buffer (buffer-live-p ejc-results-buffer))
+ ejc-results-buffer
+ (ejc-create-output-buffer)))
+
+(cl-defun ejc-show-last-result
+ (&optional result
+ &key
+ (result-file-path ejc-result-file-path))
+ "Popup buffer with last SQL execution result output."
+ (interactive)
+ (let ((output-buffer (ejc-get-output-buffer))
+ (old-split split-width-threshold))
+ (set-buffer output-buffer)
+ (if (or result result-file-path)
+ (progn
+ (read-only-mode -1)
+ (erase-buffer)
+ (if (and result (not result-file-path))
+ ;; result only
+ (insert result)
+ ;; result-file-path only
+ (insert-file-contents result-file-path))))
+ (read-only-mode 1)
+ (beginning-of-buffer)
+ (setq split-width-threshold nil)
+ (display-buffer output-buffer)
+ (setq split-width-threshold old-split)))
+
+(defun ejc-switch-to-sql-editor-buffer ()
+ "Switch to buffer dedicated to ad-hoc edit and SQL scripts.
+If the buffer is not exists - create it.
+Buffer can be saved to file with `ejc-temp-editor-file' path."
+ (interactive)
+ (if (get-buffer ejc-temp-editor-buffer-name)
+ (switch-to-buffer ejc-temp-editor-buffer-name)
+ (progn
+ (unless (file-exists-p
+ (file-name-directory ejc-temp-editor-file))
+ (make-directory (file-name-directory ejc-temp-editor-file) t))
+ (find-file ejc-temp-editor-file)
+ (rename-buffer ejc-temp-editor-buffer-name)
+ (ejc-configure-sql-buffer "ansi"))))
+
+(defun ejc-open-log ()
+ (interactive)
+ (find-file-read-only (ejc-get-log-file-path))
+ (end-of-buffer))
+
+(provide 'ejc-sql)
+
+;;; ejc-sql.el ends here
--- /dev/null
+(defproject ejc-sql "0.0.1-SNAPSHOT"
+ :description "Interact with database via java/clojure libs to run SQL/JPQL scripts"
+ :url "https://github.com/kostafey/ejc-sql"
+ :license {:name "GPL 2.0+"
+ :url "http://www.gnu.org/licenses/old-licenses/gpl-2.0.html"}
+ :dependencies [[org.clojure/clojure "1.9.0"]
+ [org.clojure/clojure-contrib "1.2.0"]
+ [org.clojure/java.jdbc "0.7.8"]
+ [org.apache.openjpa/openjpa-all "2.2.2"]
+ [org.hibernate/hibernate-core "5.2.3.Final"]
+ [com.cemerick/pomegranate "0.3.0"]
+ [org.apache.commons/commons-lang3 "3.2.1"]
+ [org.apache.httpcomponents/httpclient "4.5.5"]
+ [clomacs "0.0.3-SNAPSHOT"]])
--- /dev/null
+;;; connect.clj -- Core clojure functions for ejc-sql emacs extension.
+
+;;; Copyright © 2013-2018 - Kostafey <kostafeyNOSPAMgmail.com>
+
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software Foundation,
+;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
+
+(ns ejc-sql.connect
+ (:use [clojure.java.io]
+ [ejc-sql.lib]
+ [clomacs])
+ (:require [clojure.java.jdbc :as j]
+ [clojure.contrib.java-utils]
+ [clojure.string :as s]
+ [ejc-sql.output :as o])
+ (:import [java.sql Connection
+ DriverManager
+ PreparedStatement
+ ResultSet
+ SQLException]
+ [java.io File]))
+
+(def db
+ "DataBase connection properties list from the last transaction.
+For debug purpose."
+ (atom nil))
+
+(def current-query
+ "Current running query data."
+ (atom {}))
+
+(defn set-db [ejc-db]
+ (reset! db ejc-db))
+
+(defn clean-sql [sql]
+ (-> sql
+ (s/replace #"(--).*\n" "")
+ (s/replace #"( )|( \t)|\t" " ")
+ (s/replace "^\n" "")
+ trim))
+
+(def dml-set
+ #{"SELECT"
+ "INSERT"
+ "UPDATE"
+ "DELETE"})
+
+(def ignore-set #{\( \[})
+
+(defn determine-dml [sql]
+ "Determine if current SQL is Data Manipulation Language (DML) case."
+ (let [sql (clean-sql sql)
+ pos (loop [pos 0]
+ (if (ignore-set (get sql pos))
+ (recur (inc pos))
+ pos))]
+ (or
+ (dml-set (.toUpperCase (subs sql pos (+ 6 pos))))
+ (#{"SHOW"} (.toUpperCase (subs sql pos (+ 4 pos)))))))
+
+(defn handle-special-cases [db sql]
+ (case (:subprotocol db)
+ "oracle" (case (clojure.string/upper-case sql)
+ "SHOW ERRORS" (str "SELECT line, position, sequence, text
+ FROM all_errors
+ WHERE type = 'FUNCTION'
+ AND name = 'FILTERDICT'
+ AND attribute != 'WARNING'
+ AND owner = '" (:user db) "'
+ ORDER BY line, position, sequence")
+ sql)
+ sql))
+
+(defn clob-to-string [clob]
+ "Turn an Oracle Clob into a String"
+ (with-open [rdr (java.io.BufferedReader. (.getCharacterStream clob))]
+ (apply str (line-seq rdr))))
+
+(defn is-clob? [x]
+ (or (instance? java.sql.Clob x)
+ (and (class-exists? 'oracle.sql.CLOB)
+ (instance? (Class/forName "oracle.sql.CLOB") x))))
+
+(defn clob-to-string-row [row]
+ "Check all data in row if it's a CLOB and convert CLOB to string."
+ (loop [acc {}
+ rest-keys (keys row)]
+ (if rest-keys
+ (let [k (first rest-keys)
+ v (row k)]
+ (recur (assoc acc k (if (is-clob? v)
+ (clob-to-string v)
+ v))
+ (next rest-keys)))
+ acc)))
+
+(defn is-query-running? []
+ (let [stmt (:stmt @current-query)]
+ (and (not (nil? stmt))
+ (not (.isClosed stmt)))))
+
+(defn cancel-query []
+ "Terminate current (long) running query. Aimed to cancel SELECT queries.
+Unsafe for INSERT/UPDATE/CREATE/ALTER queries."
+ (future
+ (if (is-query-running?)
+ (let [conn (:conn @current-query)
+ runner (:runner @current-query)]
+ (try
+ (.rollback conn)
+ (finally
+ (.close conn)))
+ (if (and
+ (not (nil? runner))
+ (not (future-done? runner))
+ (not (future-cancelled? runner)))
+ (future-cancel runner)))))
+ (:start-time @current-query))
+
+(defn validate-connection [& {:keys [db timeout]
+ :or {db @ejc-sql.connect/db
+ timeout 5}}]
+ (.isValid (j/get-connection db) timeout))
+
+(defn get-separator-re [separator]
+ "Handle cases where separator is a part of string in SQL query.
+E.g. you can use default separator char `/` in this query:
+SELECT * FROM urls WHERE path like '%http://localhost%'"
+ (String/format "%s(?=(([^('|\")]*('|\")){2})*[^('|\")]*$)"
+ (into-array separator)))
+
+(defn eval-sql-core
+ "The core SQL evaluation function."
+ [& {:keys [db sql]
+ :or {db @ejc-sql.connect/db}}]
+ (set-db db)
+ (java.util.Locale/setDefault (java.util.Locale. "UK"))
+ (let [statement-separator (or (:separator db) ";")]
+ (last
+ (for [sql-part (seq (.split (handle-special-cases db sql)
+ (get-separator-re statement-separator)))]
+ (try
+ (let [sql-query-word (determine-dml sql-part)]
+ (if (and sql-query-word (or (.equals sql-query-word "SELECT")
+ (.equals sql-query-word "SHOW")))
+ (list :result-set
+ (with-open [conn (j/get-connection db)]
+ (let [stmt (j/prepare-statement conn sql-part)]
+ (swap! current-query assoc
+ :stmt stmt
+ :conn conn)
+ (j/query db stmt
+ {:as-arrays? false
+ :row-fn clob-to-string-row}))))
+ (list :message
+ (str "Records affected: "
+ (first (j/execute! db (list sql-part)))))))
+ (catch SQLException e
+ (list :message
+ (str "Error: "(.getMessage e)))))))))
+
+(clomacs-defn complete-query ejc-complete-query
+ :doc "Show file contents with SQL query evaluation results.")
+
+(defn- eval-user-sql [db sql & {:keys [rows-limit append]}]
+ (let [clear-sql (.trim sql)]
+ (o/log-sql (str clear-sql "\n"))
+ (let [[result-type result] (eval-sql-core
+ :db db
+ :sql clear-sql)]
+ (complete-query
+ (o/write-result-file (if (= result-type :result-set)
+ (o/print-table result rows-limit)
+ result)
+ :append append)
+ :start-time (:start-time @current-query)
+ :result (if (and
+ (not (= result-type :result-set))
+ (= (s/lower-case (subs result 0 (min 5 (count result))))
+ "error"))
+ (if (.contains (s/lower-case result)
+ "closed connection")
+ :terminated
+ :error)
+ :done)))))
+
+(defn eval-sql-and-log-print
+ "Write SQL to log file, evaluate it and print result."
+ [db sql & {:keys [rows-limit append start-time sync]
+ :or {append false
+ sync false}}]
+ (letfn [(run-query []
+ (eval-user-sql db sql
+ :rows-limit rows-limit
+ :append append))]
+ (if sync
+ (run-query)
+ (swap! current-query assoc
+ :runner (future (run-query))
+ :start-time start-time))))
+
+(defn eval-sql-internal-get-column [db sql]
+ (let [[result-type result] (eval-sql-core :db db
+ :sql sql)]
+ (if (= result-type :result-set)
+ (-> result rest flatten)
+ result)))
+
+(defn query-meta [db sql]
+ "Get metadata for `sql` result dataset."
+ (try
+ {:success true
+ :result (j/db-query-with-resultset
+ db
+ [(str "SELECT nodata.* "
+ "FROM (" sql ") nodata "
+ "WHERE 0 = 1")]
+ (fn [rs]
+ (let [rs-meta (.getMetaData rs)
+ col-count (.getColumnCount rs-meta)]
+ (mapv (fn [i]
+ {:name (.getColumnLabel rs-meta i)
+ :type (.getColumnTypeName rs-meta i)})
+ (range 1 (+ 1 col-count))))))}
+ (catch SQLException e
+ {:success false
+ :result (str "Error: " (.getMessage e))})))
+
+(defn table-meta
+ [db table-name]
+ (set-db db)
+ (query-meta db (str "SELECT * FROM " table-name)))
+
+(defn get-table-meta
+ "Discribe table."
+ [db table-name]
+ (let [result-map (table-meta db table-name)
+ success (:success result-map)
+ result-data (:result result-map)
+ head (str "Table \"" table-name "\" description:\n")
+ head-length (dec (.length head))]
+ (complete-query
+ (o/write-result-file
+ (if success
+ (str head
+ (ejc-sql.lib/simple-join head-length "-") "\n"
+ (o/print-table result-data))
+ result-data)))))
--- /dev/null
+(ns ejc-sql.jpa
+ (:require [cemerick.pomegranate :as pom])
+ (:use [clojure.java.io]
+ [ejc-sql.lib]
+ [ejc-sql.output])
+ (:import [javax.persistence Persistence
+ EntityManager
+ TypedQuery]
+ [org.apache.commons.lang3.builder
+ ReflectionToStringBuilder
+ ToStringStyle]))
+
+(def em)
+
+(defn connect [{:keys [connection-name
+ persistent-xml-url
+ domain-objects-url
+ jdbc-driver-url]}]
+ (pom/add-classpath persistent-xml-url)
+ (pom/add-classpath domain-objects-url)
+ (pom/add-classpath jdbc-driver-url)
+ (def em (-> (Persistence/createEntityManagerFactory connection-name)
+ (.createEntityManager))))
+
+(defn connect-plain [connection-name
+ persistent-xml-url
+ domain-objects-url
+ jdbc-driver-url]
+ (connect
+ {:connection-name connection-name
+ :persistent-xml-url persistent-xml-url
+ :domain-objects-url domain-objects-url
+ :jdbc-driver-url jdbc-driver-url}))
+
+(defn eval-jpql [jpql]
+ (-> em (.createQuery jpql) (.getResultList) (.toArray)))
+
+(defn row-to-str [row]
+ (if (not (array? row))
+ (ReflectionToStringBuilder/toString
+ row ToStringStyle/SHORT_PREFIX_STYLE)
+ (list (str row))))
+
+(defn eval-jpql-print [jpql]
+ (print
+ (format-output (map row-to-str (eval-jpql jpql))
+ :as-arrays? true, :add-headers? false)))
+
--- /dev/null
+;;; lib.clj -- Misc clojure functions for ejc-sql emacs extension.
+
+;;; Copyright © 2013-2017 - Kostafey <kostafeyNOSPAMgmail.com>
+
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software Foundation,
+;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
+
+(ns ejc-sql.lib
+ (:import (java.io File))
+ (:require [clojure.string :as s]
+ [clojure.reflect :refer [resolve-class]]))
+
+(def windows?
+ "The value is true if it runs under the os Windows."
+ (>= 0 (.indexOf (System/getProperty "os.name") "Windows")))
+
+(defn in?
+ "true if `seq` contains `elm`.
+ Search case insensitive wthen `case-sensitive` is false."
+ [seq elm & {:keys [case-sensitive] :or {case-sensitive true}}]
+ (if (and elm seq)
+ (if (not case-sensitive)
+ (in? (mapv s/lower-case seq) (s/lower-case elm))
+ (some #(= elm %) seq))))
+
+(defn get->in [obj path & {:keys [case-sensitive] :or {case-sensitive false}}]
+ "Case insensitive `get-in` for last key in sequence."
+ (if case-sensitive
+ (get-in obj path)
+ (get-in obj
+ (conj (into [] (butlast path))
+ (last path))
+ (get-in obj
+ (conj (into [] (butlast path))
+ (s/upper-case (last path)))
+ (get-in obj
+ (conj (into [] (butlast path))
+ (s/lower-case (last path))))))))
+
+(defn array? [x]
+ (-> x .getClass .isArray))
+
+(defn trim [s]
+ (if (instance? java.lang.String s)
+ (.trim s)
+ s))
+
+(defn filter-data [rs]
+ (map #(map trim %) rs))
+
+(defn get-rs-data [rs]
+ (map vals rs))
+
+(defn get-rs-headers [rs]
+ (for [[k _] (first rs)]
+ (subs (str k) 1)))
+
+(defn transpose [m]
+ (apply mapv vector m))
+
+(defn find-longest-list
+ "Returns the list of the longest lengths per column."
+ [lst]
+ (map #(apply max %) (transpose lst)))
+
+(defn simple-join [n s]
+ (clojure.string/join
+ (for [x (range 0 n)] s)))
+
+(defn str-length [s]
+ (.length (str s)))
+
+(defn get-rs-lengths [rs]
+ (map #(map str-length %) rs))
+
+(defn get-absolute-file-path [relative-file-path]
+ (-> (java.io.File. relative-file-path) .getAbsolutePath))
+
+(defn class-exists? [c]
+ (resolve-class (.getContextClassLoader (Thread/currentThread)) c))
--- /dev/null
+;;; output.clj -- Output & formatting clojure functions for ejc-sql.
+
+;;; Copyright © 2013, 2016 - Kostafey <kostafeyNOSPAMgmail.com>
+
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software Foundation,
+;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
+
+(ns ejc-sql.output
+ (:use clojure.java.io
+ ejc-sql.lib)
+ (:require clojure.contrib.java-utils
+ [clojure.string :as s])
+ (:import (java.io File)
+ (java.lang.reflect Method)
+ (java.util.Date)
+ (java.text.SimpleDateFormat)
+ (org.apache.openjpa.lib.jdbc SQLFormatter)
+ (org.hibernate.engine.jdbc.internal BasicFormatterImpl)))
+
+(def result-file-name
+ "SQL evaluation results file name."
+ "ejc-sql-result.txt")
+
+(defn get-result-file-path []
+ (.getAbsolutePath
+ (File.
+ (File. (System/getProperty "java.io.tmpdir"))
+ result-file-name)))
+
+(defn get-log-dir []
+ (file (if windows?
+ (System/getenv "AppData")
+ "/var/log/")
+ "ejc-sql"))
+
+(defn get-log-file []
+ (file (get-log-dir)
+ (str (.format (new java.text.SimpleDateFormat
+ "yyyy-MM-dd")
+ (new java.util.Date)) ".log")))
+
+(defn print-log-file-path []
+ (print (.getAbsolutePath (get-log-file))))
+
+(defn log-sql [sql]
+ (let [log-file (get-log-file)
+ is-new-file (not (.exists log-file))]
+ (when is-new-file
+ (.mkdirs (File. (.getParent log-file)))
+ (.createNewFile log-file))
+ (with-open [wrtr (clojure.java.io/writer log-file :append true)]
+ (if is-new-file
+ (.write wrtr (str "-- -*- mode: sql; -*-\n"
+ "-- Local Variables:\n"
+ "-- eval: (ejc-sql-mode)\n"
+ "-- End:\n")))
+ (.write wrtr (str (simple-join 50 "-") " "
+ (.format (new java.text.SimpleDateFormat
+ "yyyy.MM.dd HH:mm:ss.S")
+ (new java.util.Date))
+ " " (simple-join 2 "-") "\n" sql "\n")))))
+
+(def rows-limit
+ "Limit number of records to output."
+ (atom 1000))
+
+(defn set-rows-limit [val]
+ "Set limit for number of records to output. When nil no limit."
+ (reset! rows-limit val))
+
+(defn fmap [f m]
+ (reduce (fn [altered-map [k v]] (assoc altered-map k (f v))) {} m))
+
+(defn rotate-table [data]
+ "Rotate result set to show fields list vertically.
+Applied to single-record result set.
+E.g. transtofm from: a | b | c into: a | 1
+ --+---+-- b | 2
+ 1 | 2 | 3 c | 3"
+ (let [first-row (first data)
+ keys (map #(if (keyword? %) (name %) (str %))
+ (first first-row))
+ values (rest first-row)]
+ (into [] (map
+ (fn [v]
+ (into {}
+ (map #(identity
+ [%1 (if (keyword? %2) (name %2) %2)])
+ keys v)))
+ values))))
+
+(defn print-table
+ "Prints a collection of maps in a textual table. Prints table headings
+ ks, and then a line of output for each row, corresponding to the keys
+ in ks. If ks are not specified, use the keys of the first item in rows."
+ ([ks rows limit]
+ (when (seq rows)
+ (let [row-limit (or limit @rows-limit)
+ [rows msg] (if (and row-limit
+ (> row-limit 0)
+ (> (count rows) row-limit))
+ [(take row-limit rows)
+ (format "Too many rows. Only %s from %s is shown.\n\n"
+ row-limit (count rows))]
+ [rows ""])
+ [rows ks rotated] (if (and (= (count rows) 1)
+ (> (count (first rows)) 1))
+ (let [r (rotate-table rows)]
+ [r (keys (first r)) true])
+ [rows ks false])
+ rows (map (fn [row]
+ (fmap (fn [v]
+ (if (string? v)
+ (clojure.string/replace v "\n" " ")
+ v))
+ row))
+ rows)
+ widths (map
+ (fn [k]
+ (apply max (count (name k)) (map #(count (str (get % k))) rows)))
+ ks)
+ headers (map name ks)
+ spacers (map #(apply str (repeat % "-")) widths)
+ ;; TODO: #(str "%" % "d") for numbers
+ fmts (map #(str "%-" % "s") widths)
+ fmt-row (fn [leader divider trailer row]
+ (str leader
+ (apply str (interpose divider
+ (for [[col fmt] (map vector (map #(get row %) ks) fmts)]
+ (format fmt (str col)))))
+ trailer))
+ result (new StringBuffer "")
+ ;; TODO: cahnge to #(println %) when async output ready
+ out #(.append result (str % "\n"))]
+ (out (fmt-row "" " | " "" (zipmap ks headers)))
+ (if (not rotated)
+ (out (fmt-row "" "-+-" "" (zipmap ks spacers))))
+ (doseq [row rows]
+ (out (fmt-row "" " | " "" row)))
+ (str msg (.toString result)))))
+ ([rows limit] (print-table (keys (first rows)) rows limit))
+ ([rows] (print-table (keys (first rows)) rows @rows-limit)))
+
+(defn pretty-print [sql formatter]
+ (if (= formatter :jpa)
+ (print (.prettyPrint (SQLFormatter.) sql))
+ ;; :hibernate
+ (print (.format (BasicFormatterImpl.) sql))))
+
+(defn write-result-file [text & {:keys [append]
+ :or {append false}}]
+ (let [result-file-path (get-result-file-path)]
+ (spit result-file-path text :append append)
+ (s/replace result-file-path #"\\" "/")))
+
+(defn clear-result-file []
+ (write-result-file ""))
--- /dev/null
+;;; structure.clj -- Receive database stucture and keep it in cache.
+
+;;; Copyright © 2016-2018 - Kostafey <kostafeyNOSPAMgmail.com>
+
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software Foundation,
+;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
+
+(ns ejc-sql.structure
+ (:use [ejc-sql.lib])
+ (:require
+ [clojure.java.jdbc :as j]
+ [clojure.string :as s]
+ [ejc-sql.connect :as c]))
+
+(def cache (atom {}))
+
+(defn- db->column [db sql]
+ "Execute `sql`, return first column of result set as result list."
+ (if sql
+ (rest
+ (map first
+ (j/query db (list sql) {:as-arrays? true})))))
+
+(defn- db->>column [db sql]
+ "Execute `sql`, return last column of result set as result list."
+ (if sql
+ (rest
+ (map last
+ (j/query db (list sql) {:as-arrays? true})))))
+
+(defn- db->value [db sql]
+ "Execute `sql`, return first value of first column of result set as result."
+ (first (db->column db sql)))
+
+(defn get-ms-sql-server-version [db]
+ (->
+ (filter not-empty
+ (.split
+ (db->value db "SELECT @@VERSION AS 'SQL Server Version'")
+ " "))
+ (nth 3)
+ Integer/parseInt))
+
+(def default-queries
+ {:owners (fn [& _]
+ (str " SELECT schema_owner \n"
+ " FROM information_schema.schemata \n"))
+ :schemas (fn [& _]
+ (str " SELECT schema_name \n"
+ " FROM information_schema.schemata \n"))
+ :tables (fn [& {:keys [schema]}]
+ (str " SELECT table_name \n"
+ " FROM information_schema.tables \n"
+ (if schema
+ (str " WHERE table_schema = '" schema "'")
+ "")
+ " ORDER BY table_name \n"))
+ :all-tables (fn [& _]
+ (str "SELECT s.schema_owner, s.schema_name, t.table_name \n"
+ "FROM information_schema.schemata AS s, \n"
+ " information_schema.tables AS t \n"
+ "WHERE t.table_schema = s.schema_name \n"))
+ :columns (fn [& {:keys [table]}]
+ (str " SELECT column_name \n"
+ " FROM information_schema.columns \n"
+ " WHERE table_name = '" table "' \n"
+ " ORDER BY column_name \n"))})
+
+(def queries
+ {
+ ;;--------
+ :oracle
+ ;;--------
+ {:entity (fn [& {:keys [entity-name]}]
+ (str " SELECT text \n"
+ " FROM all_source \n"
+ " WHERE UPPER(name) = '"
+ (s/upper-case entity-name) "' \n"))
+ :view (fn [& {:keys [entity-name]}]
+ (str "SELECT text \n"
+ "FROM all_views \n"
+ "WHERE UPPER(view_name) = '"
+ (s/upper-case entity-name) "' \n"))
+ :types (fn [& _] "SELECT * FROM USER_TYPES")
+ :owners (fn [& _] (str " SELECT DISTINCT(owner) \n"
+ " FROM ALL_OBJECTS \n"
+ " ORDER BY owner \n"))
+ :tables (fn [& {:keys [owner]}]
+ (str " SELECT table_name, owner \n"
+ " FROM all_tables \n"
+ (if owner
+ (str " WHERE UPPER(owner) = '"
+ (s/upper-case owner)"'"))
+ " ORDER BY table_name"))
+ :all-tables (fn [& _]
+ (str " SELECT owner, table_name \n"
+ " FROM all_tables \n"
+ " WHERE owner NOT IN ('SYS', 'SYSTEM') \n"
+ " ORDER BY owner"))
+ :columns (fn [& {:keys [table]}]
+ (str " SELECT column_name \n"
+ " FROM ALL_TAB_COLUMNS \n"
+ " WHERE UPPER(table_name) = '"
+ (s/upper-case table)"'"))
+ :constraints (fn [& {:keys [owner table]}]
+ (cond
+ (and owner table)
+ (str " SELECT * FROM all_constraints \n"
+ " WHERE owner = "owner" \n"
+ " AND table_name = '"table"' \n")
+ table
+ (str " SELECT * FROM all_constraints \n"
+ " WHERE table_name = '"table"' \n")
+ :else
+ "SELECT * FROM user_constraints"))
+ :procedures (fn [& {:keys [owner]}]
+ (str " SELECT object_name, procedure_name \n"
+ " FROM all_procedures \n"
+ (if owner
+ (str " WHERE owner = '" owner "'")
+ "")))
+ :objects (fn [& _]
+ (str "SELECT * FROM all_objects WHERE object_type IN "
+ "('FUNCTION','PROCEDURE','PACKAGE')"))}
+ ;;--------
+ :informix
+ ;;--------
+ {:owners nil
+ :tables (fn [& _]
+ (str " SELECT TRIM(t.tabname) as tablesList \n"
+ " FROM systables AS t \n"
+ " WHERE t.tabtype = 'T' \n"
+ " AND t.tabid >= 100 \n"
+ " ORDER BY t.tabname; \n"))
+ :columns (fn [& {:keys [table]}]
+ (str " SELECT TRIM(c.colname) AS column_name \n"
+ " FROM systables AS t, syscolumns AS c \n"
+ " WHERE t.tabid = c.tabid \n"
+ " AND t.tabtype = 'T' \n"
+ " AND t.tabid >= 100 \n"
+ " AND TRIM(t.tabname) = '" table "' \n"
+ " ORDER BY c.colno; \n"))}
+ ;;-------
+ :mysql
+ ;;-------
+ {:owners (fn [& _]
+ (str " SELECT schema_name \n"
+ " FROM information_schema.schemata \n"))
+ :tables (default-queries :tables)
+ :all-tables (fn [& _]
+ (str "SELECT s.schema_name, t.table_name \n"
+ "FROM information_schema.schemata AS s, \n"
+ " information_schema.tables AS t \n"
+ "WHERE t.table_schema = s.schema_name \n"))
+ :columns (default-queries :columns)}
+ ;;--------
+ :h2
+ ;;--------
+ {:tables (fn [& _] ((default-queries :tables) :schema "PUBLIC"))
+ :all-tables (fn [& _]
+ (str "SELECT s.schema_owner, s.schema_name, t.table_name \n"
+ "FROM information_schema.schemata AS s, \n"
+ " information_schema.tables AS t \n"
+ "WHERE t.table_schema = s.schema_name \n"
+ " AND LCASE(s.schema_name) != 'information_schema' \n"))
+ :columns (default-queries :columns)}
+ ;;-------
+ :sqlserver ; ms sql server
+ ;;-------
+ {:owners (default-queries :owners)
+ :schemas (default-queries :schemas)
+ :tables (default-queries :tables)
+ :all-tables (default-queries :all-tables)
+ :columns (default-queries :columns)
+ :constraints (fn [& {:keys [table]}]
+ (str "SELECT type_desc AS constraint_type, \n"
+ " name \n"
+ "FROM sys.objects \n"
+ "WHERE type_desc LIKE '%CONSTRAINT' \n"
+ " AND OBJECT_NAME(parent_object_id)='" table "'"))
+ :entity (fn [& {:keys [db entity-name]}]
+ (if (> (get-ms-sql-server-version db) 2000)
+ (str
+ "SELECT definition \n"
+ "FROM sys.objects o \n"
+ "JOIN sys.sql_modules m ON m.object_id = o.object_id \n"
+ "WHERE o.object_id = object_id('" entity-name "') \n")
+ (str
+ "SELECT c.text \n"
+ "FROM sysobjects o \n"
+ "JOIN syscomments c ON c.id = o.id \n"
+ "WHERE o.name = '" entity-name "' \n")))}
+ ;;-------
+ :postgresql
+ ;;-------
+ {:owners (default-queries :owners)
+ :tables (default-queries :tables)
+ :all-tables (default-queries :all-tables)
+ :columns (default-queries :columns)}})
+
+(defn autocomplete-available-for-db? [db-type]
+ (queries db-type))
+
+(defn get-db-name [db]
+ (let [{:keys [database subname connection-uri dbname]} db]
+ (or dbname
+ database
+ (if subname
+ (let [separator (if (= (first (.split subname "/")) subname)
+ ":" "/")
+ raw-db-name (last (.split subname separator))
+ raw-db-name (first (.split raw-db-name "\\?"))
+ raw-db-name (first (.split raw-db-name ";"))]
+ raw-db-name)
+ ;; No subname - parse connection-uri
+ (let [props-list (.split connection-uri ";")
+ db-name-prop (first
+ (filter
+ (fn [prop]
+ (=
+ "databasename"
+ (.toLowerCase (first (.split prop "=")))))
+ props-list))]
+ (if db-name-prop
+ ;; "databaseName=my_db_name;"
+ (second (.split db-name-prop "="))
+ ;; "jdbc:jtds:sqlserver://localhost:1433/my_db_name;"
+ (last (.split (first props-list) "/"))))))))
+
+(defn get-user [db]
+ (or
+ (:user db)
+ (let [{:keys [user connection-uri]} db]
+ (or user
+ (second (.split
+ (let [props-list (.split connection-uri ";")]
+ (first
+ (filter
+ (fn [prop]
+ (=
+ "user"
+ (.toLowerCase (first (.split prop "=")))))
+ props-list))) "="))))))
+
+(defn get-db-type [db]
+ (let [{:keys [subprotocol connection-uri dbtype]} db]
+ (keyword
+ (or dbtype
+ subprotocol
+ (let [attrs (.split connection-uri ":")]
+ (if (= (second attrs) "jtds")
+ ;; jdbc:jtds:sqlserver://...
+ (nth attrs 2)
+ ;; jdbc:sqlserver://localhost\instance:1433;
+ (second attrs)))))))
+
+(defn- get? [obj & [force?]]
+ (if (and obj (or force? (realized? obj)))
+ @obj))
+
+(defn get-this-owner [db & [owner]]
+ "Return current owner/schema."
+ (or owner
+ (get? (get-in @cache [db :this-owner]) false)
+ (do
+ (swap! cache assoc-in [db :this-owner]
+ (future
+ ((fn [db]
+ (let [db-type (get-db-type db)]
+ (case db-type
+ :sqlserver (if (> (get-ms-sql-server-version db) 2000)
+ ;; Get default SQL Server schema for session
+ (db->value db "SELECT SCHEMA_NAME()")
+ "dbo")
+ :oracle (db->value
+ db
+ "SELECT sys_context('userenv', 'current_schema') FROM dual")
+ ;; By default
+ ;; Assume owner == schema (it can be wrong in general).
+ (get-user db)))) db)))
+ (get? (get-in @cache [db :this-owner]) true))))
+
+(defn select-db-meta-script [db meta-type &
+ {:keys [owner
+ table
+ entity-name]}]
+ "Return SQL request to obtain some database structure info."
+ (let [db-type (get-db-type db)
+ meta-type (if (keyword? meta-type) meta-type (keyword meta-type))
+ ;; owner (get-this-owner db owner)
+ sql-receiver (get-in queries [db-type meta-type])
+ sql (if sql-receiver
+ (sql-receiver :db db
+ :owner owner
+ :schema owner
+ :table table
+ :entity-name entity-name
+ :db-name (get-db-name db)))]
+ sql))
+
+(defn get-namespace [db]
+ "Find tables namespace for current database type.
+Possible cases for namespace:
+* schema is sutable (or both schema and owner)
+ for this DB type - use `:schemas`
+* only owner is sutable, so use `:owners`
+* none of them is sutable - `nil`"
+ (let [db-type (get-db-type db)]
+ (cond
+ (get-in queries [db-type :schemas]) :schemas
+ (get-in queries [db-type :owners]) :owners
+ :else nil)))
+
+(defn get-owners [db & [force?]]
+ "Return owners list from cache if already received from DB,
+check if receiveing process is not running, then start it."
+ (let [namespace (get-namespace db)]
+ (if namespace
+ (do
+ (if (not (get-in @cache [db namespace]))
+ (swap! cache assoc-in [db namespace]
+ (future ((fn [db]
+ (let [sql (select-db-meta-script
+ db namespace)]
+ (sort (db->column db sql)))) db))))
+ (get? (get-in @cache [db namespace]) force?))
+ (list))))
+
+(defn get-tables [db & [owner_ force?]]
+ "Return tables list for this owner from cache if already received from DB,
+check if receiveing process is not running, then start it."
+ (let [owner (get-this-owner db owner_)]
+ (if (not (get->in @cache [db :tables owner]))
+ (swap! cache assoc-in [db :tables owner]
+ (future ((fn [db owner]
+ (let [sql (select-db-meta-script db :tables
+ :owner owner)]
+ (db->column db sql)))
+ db owner))))
+ (if owner_
+ (get? (get->in @cache [db :tables owner]) force?)
+ (do (if (not (get-in @cache [db :all-tables]))
+ (swap! cache assoc-in [db :all-tables]
+ (future ((fn [db]
+ (let [sql (select-db-meta-script
+ db :all-tables)]
+ (sort (db->>column db sql))))
+ db))))
+ (get? (get-in @cache [db :all-tables]) force?)))))
+
+(defn get-colomns [db table force?]
+ "Return colomns list for this table from cache if already received from DB,
+check if receiveing process is not running, then start it."
+ (if (not (get->in @cache [db :colomns table]))
+ (swap! cache assoc-in [db :colomns table]
+ (future ((fn [db table]
+ (let [sql (select-db-meta-script db :columns
+ :table table)]
+ (sort (db->column db sql))))
+ db table))))
+ (get? (get->in @cache [db :colomns table])
+ force?))
+
+(defn is-owner? [db prefix]
+ (in? (get-owners db) prefix :case-sensitive false))
+
+(defn get-owners-candidates [db sql prefix-1 & _]
+ "Return owners candidates autocomplete list from the database structure
+cache, async request to fill it, if not yet.
+The result list has the following structure:
+(pending item1 item2 ...)
+If `pending` is t - the async request to get the structure is running
+if `pending` is nil - no request is running, return result immediately."
+ (let [owners (get-owners db)]
+ (if prefix-1
+ ;; Assume schema|table.#<schemas-list> is not applicable.
+ ;; So, return empty list.
+ (list "nil")
+ (if owners
+ (cons "nil" owners)
+ ;; pending owners...
+ (list "t")))))
+
+(defn get-tables-candidates [db sql prefix-1 & _]
+ "Return tables candidates autocomplete list."
+ (let [tables (if (not prefix-1)
+ ;; something#
+ (get-tables db)
+ (if (is-owner? db prefix-1)
+ ;; [owner].#<tables-list>
+ (get-tables db prefix-1)
+ ;; owners still pending or
+ ;; unknown?.# case
+ (list)))]
+ (if tables
+ (cons "nil" tables)
+ ;; pending tables...
+ (list "t"))))
+
+(defn match-alias? [sql owner table probable-alias]
+ "Check if prefix (`probable-alias`) is alias for `table` in this `sql`."
+ (let [sql (s/lower-case sql)
+ owner (if owner
+ (str (s/lower-case owner) "\\.")
+ "\\s+(\\w+\\.)?")
+ table (s/lower-case table)
+ probable-alias (s/lower-case probable-alias)
+ alias-pattern (re-pattern
+ (str owner table "(\\s+as)?"
+ "\\s+" probable-alias))]
+ (not (nil? (re-find alias-pattern sql)))))
+
+(defn get-all-tables [db]
+ "Get all tables for all owners/schemas."
+ (flatten
+ (mapv #(get-tables db % true)
+ (get-owners db true))))
+
+(defn get-colomns-candidates [db sql prefix-1 & [prefix-2]]
+ "Return colomns candidates autocomplete list."
+ ;; Possible cases:
+ ;; 1. [owner|schema.]table.#<colomns-list>
+ ;; 2. SELECT alias.#<colomns-list> FROM [owner|schema.]table AS alias
+ ;; 3. SELECT complex-alias.#<colomns-list> FROM (SELECT...) AS complex-alias
+ ;;
+ ;; In any case consider `prefix-1` as table or alias
+ ;; and optional `prefix-2` as owner or schema
+ (if (not prefix-1)
+ ;; TODO: cases for:
+ ;; INSERT INTO table (field1, #) values (123, 'text')
+ ;; UPDATE table SET field1 = 123, # = 'text' WHERE id = 1
+ (list "nil")
+ (let [owner prefix-2
+ tables-list (if owner
+ (get-tables db owner)
+ ;; In case of queries like
+ ;; "SELECT u.# FROM custom.Users as u"
+ ;; when "custom" is not the current
+ ;; schema, the full DB structure tree
+ ;; sould be built to obtain overall
+ ;; tables list for all owners/schemas.
+ (if (get-namespace db)
+ ;; Database has namespaces
+ (if (not (get-owners db))
+ ;; Not received owners list yet -
+ ;; pending...
+ (do
+ (future (get-all-tables db))
+ nil)
+ ;; Owners list is already here -
+ ;; force tables list receiving!
+ (get-all-tables db))
+ ;; Database hasn't namespaces -
+ ;; no owners needed
+ (get-tables db)))]
+ (if (and tables-list
+ (not-empty (filter not-empty tables-list)))
+ (if (in? tables-list prefix-1 :case-sensitive false)
+ ;; table.#<colomns-list>
+ (let [table prefix-1
+ ;; force columns-cache obtaining...
+ columns-list (get-colomns db table true)]
+ ;; ok - columns
+ (cons "nil" columns-list))
+ (let [sql (c/clean-sql sql)
+ table-alias (first
+ (filter
+ (fn [table]
+ (match-alias? sql owner table prefix-1))
+ tables-list))]
+ (if table-alias
+ ;; table-alias.#<colomns-list>
+ (cons "nil" (get-colomns db table-alias true))
+ ;; Check "SELECT t.# FROM (SELECT ... ) AS t" case.
+ (let [pattern (re-pattern (str "\\(.+\\)(\\s|\\s(as)\\s)"
+ prefix-1))
+ complex-alias (first (re-find pattern sql))
+ complex-alias (if complex-alias
+ (subs complex-alias 1
+ (.lastIndexOf complex-alias ")")))]
+ (if complex-alias
+ (let [{:keys [success result]} (c/query-meta db complex-alias)]
+ (if success
+ ;; complex-alias.#<colomns-list>
+ (cons "nil" (mapv :name result))
+ ;; Can't execute "blah blah" to get metadata in
+ ;; "SELECT t.# FROM (blah blah) AS t" case.
+ (list "nil")))
+ ;; unknown?.# case
+ ;; nothing to complete
+ (list "nil"))))))
+ ;; no tables yet
+ ;; pending tables...
+ (list "t")))))
+
+(defn get-cache []
+ "Output actual cache."
+ @cache)
+
+(defn invalidate-cache [db]
+ "Clean your current connection cache (database owners and tables list)."
+ (swap! cache assoc-in [db] nil))
projects / emacsconfig.git / commitdiff