+++ /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))
--- /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)
+(require 'ejc-flx)
+
+(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)
+
+(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)
+ (progn
+ (message "Receiving database structure...")
+ (list))
+ 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))
+ (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))))
+
+(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 (require 'flx-ido nil 'noerror)
+ (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)
+
+(when (require 'yasnippet nil 'noerror)
+ (setq yas-snippet-dirs
+ (nconc yas-snippet-dirs
+ (list (expand-file-name "snippets"
+ (file-name-directory
+ (locate-library "ejc-sql"))))))
+ (defun ejc-yas-downcase-key (args)
+ (if ejc-sql-mode
+ (cl-callf downcase (nth 1 args)))
+ args)
+ (advice-add 'yas--fetch :filter-args #'ejc-yas-downcase-key))
+
+(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-flx.el -- Customization flx for ejc (the part of ejc-sql).
+
+;;; Copyright © 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:
+
+(defcustom ejc-use-flx nil
+ "Non-nil enables `flx' fuzzy matching engine autocompletion."
+ :group 'ejc-sql
+ :type 'boolean)
+
+(defcustom ejc-flx-threshold 2
+ "The minimum number of typed chars required to use `flx' for autocompletion.
+When 1, enables `flx' usage from the first typed char."
+ :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-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-flx)
+
+;;; ejc-flx.el ends here
--- /dev/null
+;;; ejc-format.el -- SQL formatting library (the part of ejc-sql).
+
+;;; Copyright © 2012-2019 - 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-border-top ()
+ "Get top position of batch statement(s) seperator `ejc-sql-separator'.
+Upper position of this batch statement(s)."
+ (save-excursion
+ (if (re-search-backward (ejc-sql-separator-re) nil t nil)
+ (forward-char)
+ (beginning-of-buffer))
+ (point)))
+
+(defun ejc-get-border-bottom ()
+ "Get bottom position of batch statements seperator `ejc-sql-separator'
+Bottom position of this batch statement(s)."
+ (save-excursion
+ (if (re-search-forward (ejc-sql-separator-re) nil t nil)
+ (backward-char)
+ (end-of-buffer))
+ (if (equal (string (preceding-char)) "\n")
+ (backward-char 1))
+ (let ((sep-len (length ejc-sql-separator)))
+ (if (equal (buffer-substring (- (point) sep-len) (point))
+ ejc-sql-separator)
+ (backward-char sep-len)))
+ (point)))
+
+(defun ejc-get-org-begin ()
+ "Obtain position for begin of code snippet in `org-mode' buffers."
+ (save-excursion
+ (if (and (derived-mode-p 'org-mode)
+ (re-search-backward "^\\s-*#\\+begin_[(src)(example)].*"
+ nil t nil))
+ (line-end-position)
+ (point-min))))
+
+(defun ejc-get-org-end ()
+ "Obtain position for end of code snippet in `org-mode' buffers."
+ (save-excursion
+ (if (and (derived-mode-p 'org-mode)
+ (re-search-forward "^\\s-*#\\+end_[(src)(example)]"
+ nil t nil))
+ (line-beginning-position)
+ (point-max))))
+
+(cl-defun ejc-get-sql-boundaries-at-point (&optional beg end)
+ "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. Set BEG and END parameters to add manual boundaries restrictions."
+ (let* ((beg (max (or beg (point-min))
+ (ejc-get-border-top)
+ (ejc-get-org-begin)))
+ (end (min (or end (point-max))
+ (ejc-get-border-bottom)
+ (ejc-get-org-end))))
+ (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 (if (and (boundp ',beg) (boundp ',end))
+ (ejc-get-sql-boundaries-at-point ,beg ,end)
+ (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))))
+
+(cl-defun ejc-get-sql-at-point (&key beg end)
+ "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)))
+
+(cl-defun ejc-flash-this-sql (&key beg end)
+ "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-name "ejc-sql")
+
+(clomacs-create-httpd-stop ejc-httpd-stop
+ :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--get-result-file-path
+ get-result-file-path
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.output)
+
+(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-flx" "ejc-flx.el" (0 0 0 0))
+;;; Generated autoloads from ejc-flx.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ejc-flx" '("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)
+
+(autoload 'ejc-version "ejc-sql" "\
+Get the ejc-sql version as string.
+
+\(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" "20190121.1043" "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-2019 - 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)
+
+(defcustom ejc-org-mode-show-results t
+ "When t show SQL query results of `org-mode' code snippet in the same buffer.
+An expected behaviour for `org-mode' users. Disable popup window with SQL
+results. When nil, otherwise, provide `ejc-sql' users expected behaviour."
+ :group 'ejc-sql
+ :type 'boolean)
+
+(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 (file-truename 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)
+ (oracle:sid . oracle)))
+
+(defun ejc-configure-sql-buffer (product-name)
+ (unless (or (derived-mode-p 'org-mode) (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)
+ (unless (derived-mode-p 'org-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 ")")))
+
+(defun ejc-set-mode-name (connection-name)
+ "Show CONNECTION-NAME as part of `mode-name' in `mode-line'."
+ (setq mode-name (format "%s->[%s]"
+ (car (split-string mode-name "->\\[.+\\]"))
+ connection-name)))
+
+(defun ejc-add-connection (product-name connection-name db)
+ "Add ejc connection information to current buffer.
+Prepare buffer to operate as `ejc-sql-mode' buffer."
+ (ejc-configure-sql-buffer product-name)
+ (setq-local ejc-connection-name connection-name)
+ (setq-local ejc-db db)
+ (ejc-set-mode-name connection-name))
+
+(defun ejc-get-result-file-path ()
+ (or ejc-result-file-path
+ (setq ejc-result-file-path
+ (ejc--get-result-file-path))))
+
+(defun ejc-eval-org-snippet (body params)
+ "Used to eval SQL code in `org-mode' code snippets."
+ (let* ((beg (save-excursion
+ (goto-char (nth 5 (org-babel-get-src-block-info)))
+ (end-of-line)
+ (right-char 1)
+ (point)))
+ (end (save-excursion
+ (goto-char beg)
+ (+ beg (length body) (skip-chars-forward "\t ")))))
+ (ejc-eval-user-sql-at-point
+ :beg beg
+ :end end
+ :sync ejc-org-mode-show-results
+ :display-result (not ejc-org-mode-show-results))
+ (if ejc-org-mode-show-results
+ (with-temp-buffer
+ (insert-file-contents (ejc-get-result-file-path))
+ (buffer-string)))))
+
+(defun ejc-get-product-name (db)
+ (or (alist-get :subprotocol db)
+ (alist-get :dbtype db)))
+
+(defun ejc-org-edit-special (orig-fun &rest args)
+ (if (and (equal "sql" (car (org-babel-get-src-block-info)))
+ (boundp 'ejc-db) ejc-db
+ (boundp 'ejc-connection-name) ejc-connection-name)
+ (let* ((db ejc-db)
+ (connection-name ejc-connection-name)
+ (product-name (ejc-get-product-name db)))
+ (apply orig-fun args)
+ (ejc-add-connection product-name connection-name db))
+ (apply orig-fun args)))
+
+;;;###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)))
+ (product-name (ejc-get-product-name db)))
+ (ejc-update-conn-statistics connection-name)
+ (ejc-configure-sql-buffer product-name)
+ (when (derived-mode-p 'org-mode)
+ (defalias 'org-babel-execute:sql 'ejc-eval-org-snippet)
+ (advice-add 'org-edit-special :around #'ejc-org-edit-special))
+ (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)
+ (ejc-set-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
+ display-result)
+ (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
+ :display-result display-result))))
+
+(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))))
+
+(defun ejc-spinner-stop ()
+ "Stop spinner indicating current running query."
+ (with-current-buffer ejc-current-buffer-query
+ (spinner-stop)))
+
+(cl-defun ejc-complete-query (result-file-path
+ &key
+ start-time
+ result
+ display-result)
+ (if result-file-path
+ (setq ejc-result-file-path result-file-path))
+ (ejc-spinner-stop)
+ (if display-result
+ (ejc-show-last-result))
+ (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)))
+ (ejc-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 display-result)
+ "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
+ :display-result display-result))
+
+(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
+ beg
+ end
+ (display-result t))
+ "Evaluate SQL bounded by the `ejc-sql-separator' or/and buffer
+boundaries."
+ (interactive)
+ (ejc-check-connection)
+ (ejc-flash-this-sql :beg beg
+ :end end)
+ (ejc-eval-user-sql (ejc-get-sql-at-point :beg beg :end end)
+ :sync sync
+ :display-result display-result))
+
+(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
+ :display-result t))
+
+(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)
+ "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)
+ (read-only-mode -1)
+ (erase-buffer)
+ (if result
+ (insert result)
+ (insert-file-contents (ejc-get-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))
+
+;;;###autoload
+(defun ejc-version ()
+ "Get the ejc-sql version as string."
+ (interactive)
+ (if (require 'pkg-info nil t)
+ (message "ejc-sql %s" (pkg-info-version-info 'ejc-sql))
+ (error "Cannot determine version without package pkg-info")))
+
+(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.clojars.kostafey/java.jdbc "0.7.9-SNAPSHOT"]
+ [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
+# -*- mode: snippet -*-
+# name: begin
+# key: begin
+# --
+BEGIN
+ $0
+END;
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: delete
+# key: delete
+# --
+DELETE FROM ${1:table_name} WHERE ${2:where_stmt}
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: insert
+# key: insert
+# --
+INSERT INTO ${1:table_name} (${2:column1}, ${3:column2})
+VALUES ($0value1, value2)
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: select
+# key: select
+# --
+SELECT `(if (eq sql-product 'sqlserver) "first 20 ")`*
+FROM ${1:table_name}
+WHERE `(if (eq sql-product 'oracle) "rownum < 20\n AND ")`${2:where_stmt}
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: update
+# key: update
+# --
+UPDATE ${1:table_name}
+SET ${2:column1} = ${3:value}, ${4:column2} = ${5:value}
+WHERE ${6:some_column} = ${7:some_value}
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: where
+# key: where
+# --
+WHERE `(if (eq sql-product 'oracle) "rownum < 20\n AND ")`${2:where_stmt}
\ No newline at end of file
--- /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(?<!\\s{0,1000}--.{0,1000})(?=(([^\"']*[\"']){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.")
+
+(clomacs-defn spinner-stop ejc-spinner-stop
+ :doc "Stop spinner indicating current running query.")
+
+(defn- eval-user-sql [db sql & {:keys [rows-limit append display-result]}]
+ (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-output
+ (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)
+ :display-result display-result)]
+ (if-not (empty? complete-output)
+ ;; Elisp unexpected result
+ (spinner-stop)))))
+
+(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 display-result]
+ :or {append false
+ sync false
+ display-result true}}]
+ (letfn [(run-query []
+ (try
+ (eval-user-sql db sql
+ :rows-limit rows-limit
+ :append append
+ :display-result display-result)
+ (catch Exception e
+ (let [complete-output
+ (complete-query
+ (o/write-result-file
+ (str (.getMessage e) "\n"
+ (s/join "\n" (.getStackTrace e))))
+ :start-time (:start-time @current-query)
+ :result :error
+ :display-result true)]
+ (if-not (empty? complete-output)
+ ;; Elisp unexpected result
+ (spinner-stop))))))]
+ (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
+ "Describe 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))
+ :display-result true)))
--- /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 []
+ (s/replace
+ (.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)
+ result-file-path))
+
+(defn clear-result-file []
+ (write-result-file ""))
--- /dev/null
+;;; structure.clj -- Receive database stucture and keep it in cache.
+
+;;; Copyright © 2016-2019 - 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))) "="))))))
+
+(def product-assoc {"oracle:sid" "oracle"})
+
+(defn get-db-type [db]
+ (let [{:keys [subprotocol connection-uri dbtype]} db
+ result (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))))]
+ (keyword (or (product-assoc result) result))))
+
+(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 autocomplete-loading []
+ "Not loaded tables yet. Output pending db structure data..."
+ (list "t"))
+
+(defn autocomplete-result [result]
+ "Output autocomplete result."
+ (cons "nil" result))
+
+(defn autocomplete-nothing []
+ "Output autocomplete nothing."
+ (list "nil"))
+
+(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.
+ (autocomplete-nothing)
+ (if owners
+ (autocomplete-result owners)
+ ;; pending owners...
+ (autocomplete-loading)))))
+
+(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
+ (autocomplete-result tables)
+ ;; pending tables...
+ (autocomplete-loading))))
+
+(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))))
+
+(def insert-re
+ (re-pattern (str "(?i)\\s*INSERT\\s+INTO\\s+(\\S+)\\s+")))
+
+(defn insert-sql? [sql]
+ "If `sql` is INSERT query, return a table name used to insert new records.
+Otherwise return nil."
+ (second (re-find insert-re sql)))
+
+(def update-re
+ (re-pattern (str "(?i)\\s*UPDATE\\s(\\S+)\\s+\n*SET.*")))
+
+(defn update-sql? [sql]
+ "If `sql` is UPDATE query, return a table name used to modify the existing
+records. Otherwise return nil."
+ (second (re-find update-re sql)))
+
+(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
+ ;; 4. INSERT INTO table (field1, .#) values (123, 'text')
+ ;; 5. UPDATE table SET field1 = 123, .# = 'text' WHERE id = 1
+ ;;
+ ;; In any case, consider `prefix-1` as table or alias
+ ;; and optional `prefix-2` as owner or schema.
+ ;; When no any prefix at all, check for 4 (INSERT) or 5 (UPDATE) case.
+ (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 (not (and tables-list
+ (not-empty (filter not-empty tables-list))))
+ ;; no tables yet
+ ;; pending tables...
+ (autocomplete-loading)
+ ;; Tables list loaded:
+ (if (not prefix-1)
+ (let [insert-or-update-table (or (insert-sql? sql)
+ (update-sql? sql))]
+ (cond
+ (and (not-empty insert-or-update-table)
+ (in? tables-list insert-or-update-table
+ :case-sensitive false))
+ ;; INSERT INTO table (field1, .#) values (123, 'text')
+ ;; or
+ ;; UPDATE table SET field1 = 123, .# = 'text' WHERE id = 1
+ (autocomplete-result
+ (get-colomns db insert-or-update-table true))
+ ;; SELECT or other queries types
+ :else (autocomplete-nothing)))
+ (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
+ (autocomplete-result 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>
+ (autocomplete-result (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>
+ (autocomplete-result (mapv :name result))
+ ;; Can't execute "blah blah" to get metadata in
+ ;; "SELECT t.# FROM (blah blah) AS t" case.
+ (autocomplete-nothing)))
+ ;; unknown?.# case
+ ;; nothing to complete
+ (autocomplete-nothing))))))))))
+
+(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
-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.
projects / emacsconfig.git / commitdiff