+++ /dev/null
-;;; ejc-company.el -- SQL completitions at point by company-mode (the part of ejc-sql).
-
-;;; Copyright © 2020 - 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. */
-
-;;; Commentary:
-
-;; `ejc-company' is a `company' completion backend for `ejc-sql'.
-;; To use it, add `ejc-company-backend' to `company-backends':
-
-;; (requre 'ejc-company)
-;; (push 'ejc-company-backend company-backends)
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'dash)
-(require 'company)
-(require 'ejc-completion-common)
-
-(defun ejc-company-make-candidate (candidate)
- (let ((text (car candidate))
- (meta (cadr candidate)))
- (propertize text 'meta meta)))
-
-(defun ejc-company-add-meta (meta candidates)
- (-map (lambda (k) (list k meta))
- candidates))
-
-(defun ejc-company-candidates (prefix)
- (let* ((prefix-1 (ejc-get-prefix-word))
- (prefix-2 (save-excursion
- (search-backward "." nil t)
- (ejc-get-prefix-word)))
- (res))
- (dolist (item
- (cl-remove-if-not
- (lambda (c) (string-prefix-p prefix (car c) t))
- (append
- (ejc-append-without-duplicates
- (ejc-company-add-meta
- "ansi sql" (ejc-get-ansi-sql-words))
- (ejc-company-add-meta
- "keyword" (ejc-get-keywords))
- 'car :right)
- (ejc-company-add-meta
- "owner" (ejc-owners-candidates))
- (ejc-company-add-meta
- "table" (ejc-tables-candidates))
- (ejc-company-add-meta
- "view" (ejc-views-candidates))
- (if (not prefix-1)
- (ejc-company-add-meta
- "package" (ejc-packages-candidates)))
- (ejc-company-add-meta
- "column" (ejc-colomns-candidates)))))
- (push (ejc-company-make-candidate item) res))
- res))
-
-(defun ejc-company-annotation (candidate)
- (format " %s" (get-text-property 0 'meta candidate)))
-
-(defun ejc-company-doc-buffer (candidate)
- (company-doc-buffer (ac-ejc-documentation candidate)))
-
-(defun ejc-company-backend (command &optional arg &rest ignored)
- (interactive (list 'interactive))
- (cl-case command
- (interactive (company-begin-backend 'ejc-company-backend))
- (prefix (and (bound-and-true-p ejc-sql-mode)
- (company-grab-symbol)))
- (candidates (ejc-company-candidates arg))
- (doc-buffer (ejc-company-doc-buffer arg))
- (annotation (ejc-company-annotation arg))))
-
-(provide 'ejc-company)
-
-;;; ejc-company.el ends here
+++ /dev/null
-;;; ejc-completion-common.el -- SQL completitions common functionality (the part of ejc-sql).
-
-;;; Copyright © 2020 - 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 'ejc-interaction)
-(require 'ejc-doc)
-
-(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)
-
-(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" "between"))
-
-(defvar ejc-auxulary-sql-words
- '("show" "errors" "desc" "count" "type" "table" "function" "procedure"
- "begin" "end" "for" "return"))
-
-(defcustom ejc-complete-on-dot nil
- "When t automatically start completion after inserting a dot for
-`company-mode' despite `company-minimum-prefix-length' is bigger than 0."
- :type 'boolean
- :safe #'booleanp
- :group 'ejc-sql)
-
-(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-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))))
-
-(defun ejc-get-ansi-sql-words ()
- "Get ANSI SQL keywords."
- (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 ejc-get-keywords ()
- "Get DB-specific keywords."
- (if (ejc-buffer-connected-p)
- (unless (or (ejc-return-point) (ejc-get-prefix-word))
- (if ejc-candidates-uppercase
- (mapcar 'upcase (ejc-get-keywords-inner ejc-db nil))
- (mapcar 'downcase (ejc-get-keywords-inner ejc-db nil))))))
-
-(cl-defun ejc-complete-auto-complete (buffer-name point)
- "Called by Clojure side when db structure cache creation process completes.
-When the user typed some chars, the request for autocompletion is passed to
-Clojure side. If Clojure side has the database structure cache, autocompletion
-variants returned immediately. If not, the database structure cache creation
-process starts. It's async, so the process of Emacs is not blocked and the
-user can move point (cursor), edit SQL and so on. After Clojure side cache
-creation process finishes, it calls this `ejc-complete-auto-complete'
-function. If the user waits for autocompletion and doesn't move point
-(cursor) during this process, he will get autocompletion variants."
- (switch-to-buffer buffer-name)
- (if (equal point (point))
- (cond ((bound-and-true-p auto-complete-mode) (auto-complete))
- ((bound-and-true-p company-mode) (company-complete))))
- 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
- :db ejc-db
- :sql (apply
- 'buffer-substring
- (ejc-get-sql-boundaries-at-point))
- :prefix-1 prefix-1
- :prefix-2 prefix-2
- :buffer-name (buffer-name)
- :point (point)))
- (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-views-candidates ()
- (ejc-candidates 'ejc-get-views-candidates))
-
-;;;###autoload
-(defun ejc-packages-candidates ()
- (ejc-candidates 'ejc-get-packages-candidates))
-
-;;;###autoload
-(defun ejc-colomns-candidates ()
- (ejc-candidates 'ejc-get-colomns-candidates))
-
-(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))
-
-(defun ejc-dot-pressed ()
- (interactive)
- (insert ".")
- (if (and ejc-complete-on-dot (bound-and-true-p company-mode))
- (call-interactively 'company-complete)))
-
-(provide 'ejc-completion-common)
-
-;;; ejc-completion-common.el ends here
+++ /dev/null
-;;; ejc-doc.el -- SQL quick hints documentation (the part of ejc-sql).
-
-;;; Copyright © 2018-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 'dash)
-
-(defconst ejc-sql-doc (make-hash-table :test 'eq))
-
-(defun ejc-fill-doc (hash-const &rest args)
- (-reduce (lambda (key val)
- (puthash key val hash-const))
- args))
-
-(defvar ejc-doc-created-p nil)
-
-(defun ejc-create-doc ()
- (ejc-fill-doc
- ejc-sql-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>;"
- 'distinct
- "Return different values")
- (setq ejc-doc-created-p t))
-
-(provide 'ejc-doc)
-
-;;; ejc-doc.el ends here
+++ /dev/null
-;;; ejc-eldoc.el -- ejc-sql eldoc support (the part of ejc-sql).
-
-;;; Copyright (C) 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 'dash)
-(require 'eldoc)
-(require 'ejc-format)
-
-(defun ejc-replace-property-mark (text fmt face)
- (while (string-match fmt text)
- (let ((beg (match-beginning 0))
- (end (match-end 0)))
- (setq text (concat (substring text 0 beg)
- (substring text (1+ beg))))
- (add-face-text-property beg (1- end) face t text)))
- text)
-
-(defun ejc-propertize (text)
- (-> text
- (ejc-replace-property-mark "\\@\\(\\w+_?\\)+"
- 'font-lock-function-name-face)
- (ejc-replace-property-mark "\\%\\(\\w+_?\\)+"
- 'font-lock-keyword-face)
- (ejc-replace-property-mark "\\#\\(\\w+_?\\)+"
- 'eldoc-highlight-function-argument)))
-
-(defconst ejc-sql-expressions
- (list
- "SELECT"
- "%SELECT #field... %FROM table [%WHERE predicate]"
- "FROM"
- "%SELECT field... %FROM #table [%WHERE predicate]"
- "WHERE"
- "%WHERE #predicate [%OR predicate] [%AND predicate]"))
-
-(defun ejc-get-procedure-before-point ()
- "Return stored procedure name before the point."
- (interactive)
- (save-excursion
- (goto-char (nth 1 (syntax-ppss)))
- (thing-at-point 'symbol)))
-
-(defun ejc-get-package-before-point ()
- "Return package name of stored procedure before the point."
- (interactive)
- (save-excursion
- (goto-char (nth 1 (syntax-ppss)))
- (beginning-of-thing 'symbol)
- (when (equal (string (char-before)) ".")
- (left-char)
- (thing-at-point 'symbol))))
-
-(defun ejc-get-parameter-index ()
- "Return parameter number around the point."
- (interactive)
- (let ((index 0)
- (ch (string (preceding-char))))
- (save-excursion
- (while (nth 2 (syntax-ppss))
- (let ((pss (nth 2 (syntax-ppss))))
- (when (member ch (list " " "\t" "\n" ","))
- (setq index (1+ index))
- (setq ch nil))
- (goto-char pss)
- (setq index (1+ index)))))
- (max (1- index) 0)))
-
-(defun ejc-get-word-before-point ()
- "Return SQL word before the point."
- (interactive)
- (save-excursion
- (if (not (member (string (preceding-char)) (list " " "\t" "\n")))
- (forward-same-syntax -1))
- (goto-char (nth 2 (syntax-ppss)))
- (thing-at-point 'symbol)))
-
-(defun ejc-eldoc-function ()
- "Returns a doc string appropriate for the current context, or nil."
- (if-let ((stored-procedure (if (ejc-buffer-connected-p)
- (condition-case nil
- (ejc-get-procedure-before-point)
- (error nil)))))
- (let ((type (ejc-get-entity-type ejc-db stored-procedure))
- (package (ejc-get-package-before-point)))
- (if (or (eq type :procedure)
- (eq type :function))
- (let ((params (car (ejc-get-parameters ejc-db
- package
- stored-procedure
- t)))
- (p-index (ejc-get-parameter-index)))
- (ejc-propertize
- (format "@%s: (%s)"
- stored-procedure
- (string-join
- (-map
- (lambda (p) (if (eql (cdr p) p-index)
- (ejc-split-and-join
- (lambda (s) (concat "#" s ))
- " ")
- (car p)))
- (-zip params
- (number-sequence 0 (1- (length params)))))
- ", "))))))
- (if-let ((sql-word (condition-case nil
- (ejc-get-word-before-point)
- (error nil))))
- (if-let ((sql-expression (lax-plist-get
- ejc-sql-expressions
- sql-word)))
- (ejc-propertize sql-expression)))))
-
-;;;###autoload
-(defun ejc-eldoc-setup ()
- "Set up eldoc function and enable eldoc-mode."
- (interactive)
- (cond
- ((boundp 'eldoc-documentation-strategy)
- (setq-local eldoc-documentation-strategy #'ejc-eldoc-function))
- ((boundp 'eldoc-documentation-functions)
- (add-hook 'eldoc-documentation-functions #'ejc-eldoc-function nil t))
- (t (setq-local eldoc-documentation-function #'ejc-eldoc-function)))
- (eldoc-mode +1))
-
-(provide 'ejc-eldoc)
-
-;;; ejc-eldoc.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)
-(require 'ejc-result-buffer)
-
-(defvar ejc-sql-separator "/"
- "The char with purpose to separate the SQL statement both other.")
-
-(defun ejc-sql-separator-re ()
- (format "^\\s-*%s\\s-*" (or (alist-get :separator ejc-db)
- 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)
- (re-search-forward (ejc-sql-separator-re) nil t nil)
- (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)
- (re-search-backward (ejc-sql-separator-re) nil t nil)
- (end-of-buffer))
- (if (equal (string (preceding-char)) "\n")
- (backward-char 1))
- (let ((sep-len (length ejc-sql-separator)))
- (if (equal (buffer-substring (max (point-min) (- (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)
- (if (equal (buffer-name) ejc-results-buffer-name)
- (ejc-show-next-result)
- (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)
- (if (equal (buffer-name) ejc-results-buffer-name)
- (ejc-show-prev-result)
- (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)))
-
-(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)))
-
-(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 (arg)
- "Format SQL bounded by the `ejc-sql-separator' or/and buffer
-boundaries."
- (interactive "P")
- (save-excursion
- (ejc--in-sql-boundaries
- beg end
- (if arg
- (ejc-format-sql beg end)
- (let ((result (ejc-format-by-hibernate
- (buffer-substring beg end))))
- (delete-region beg end)
- (insert result)))
- (when (equal (char-before beg)
- (string-to-char ejc-sql-separator))
- (goto-char beg)
- (insert "\n")))
- (ejc-flash-this-sql)))
-
-(defun ejc-format-sql-region (beg end)
- "Pretty-print SQL bounded by the selection area."
- (interactive "r")
- (let ((result (ejc-format-by-hibernate (buffer-substring beg end))))
- (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)
- (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-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))))
-
-(provide 'ejc-format)
-
-;;; ejc-format.el ends here
+++ /dev/null
-;;; ejc-interaction.el -- ejc-sql interact with Clojure. -*- lexical-binding: t -*-
-
-;;; Copyright © 2013-2020 - 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 '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 ejc-sql.classpath)
-
-(clomacs-defun ejc-require
- clojure.core/require
- :lib-name "ejc-sql")
-
-(clomacs-defun ejc-import
- clojure.core/import
- :lib-name "ejc-sql")
-
-(clomacs-defun ejc-class-for-name
- Class/forName
- :lib-name "ejc-sql")
-
-(clomacs-defun ejc-get-dependeces-files-list
- get-dependeces-files-list
- :lib-name "ejc-sql"
- :namespace ejc-sql.deps-resolver
- :return-type :list)
-
-(clomacs-defun ejc-resolve-dependencies
- resolve-dependencies
- :lib-name "ejc-sql"
- :namespace cemerick.pomegranate.aether)
-
-(defun ejc-connect-to-db (conn-struct)
- (let* ((jars-to-load
- (if-let (dependencies (alist-get :dependencies conn-struct))
- ;; Resolve dependencies and prepare jars paths list to load.
- (ejc-get-dependeces-files-list dependencies)
- (let* ((classpath (alist-get :classpath conn-struct))
- (dependency-jars (-map
- (lambda (jar-path)
- (ejc-get-dependeces-files-list
- (ejc-path-to-lein-artifact jar-path)))
- classpath)))
- ;; Join jar files paths from `:classpath' vector of
- ;; `ejc-create-connection' and dependencies for this jars.
- (delq nil
- (delete-dups
- (append
- (-flatten dependency-jars)
- (append classpath nil))))))))
- (-map 'ejc-add-classpath jars-to-load))
- (when-let ((classname (alist-get :classname conn-struct)))
- (ejc-class-for-name classname)
- (ejc-import (read classname)))
- (ejc-sql-set-db conn-struct))
-
-(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--describe-table
- describe-table
- :lib-name "ejc-sql"
- :namespace ejc-sql.structure)
-
-(clomacs-defun ejc-get-entity-type
- get-entity-type-fmt
- :lib-name "ejc-sql"
- :namespace ejc-sql.structure
- :return-type :eval)
-
-(clomacs-defun ejc-get-parameters
- get-parameters
- :lib-name "ejc-sql"
- :namespace ejc-sql.structure
- :return-type :list)
-
-(clomacs-defun ejc-get-entity-description
- get-entity-description
- :lib-name "ejc-sql"
- :namespace ejc-sql.structure)
-
-(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-format-by-hibernate
- format-sql-print
- :lib-name "ejc-sql"
- :namespace ejc-sql.output
- :return-value :stdout)
-
-(clomacs-defun ejc-set-fetch-size
- set-fetch-size
- :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-set-show-too-many-rows-message
- set-show-too-many-rows-message
- :lib-name "ejc-sql"
- :namespace ejc-sql.output
- :doc (concat "Show 'Too many rows...' message in case"
- "of ResultSet is bigger than `fetch-size'."))
-
-(clomacs-defun ejc-set-max-rows
- set-max-rows
- :lib-name "ejc-sql"
- :namespace ejc-sql.output
- :doc (concat "Set limit for number of records to contain "
- "in ResultSet. When nil no limit."))
-
-(clomacs-defun ejc-set-column-width-limit
- set-column-width-limit
- :lib-name "ejc-sql"
- :namespace ejc-sql.output
- :doc (concat "Set limit for number of chars per column to "
- "output to output. When nil no limit."))
-
-(clomacs-defun ejc-set-use-unicode
- set-use-unicode
- :lib-name "ejc-sql"
- :namespace ejc-sql.output
- :doc "Set using unicode for grid borders.")
-
-(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-views-candidates
- get-views-candidates
- :lib-name "ejc-sql"
- :namespace ejc-sql.structure
- :return-type :list)
-
-(clomacs-defun ejc-get-packages-candidates
- get-packages-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-get-keywords-inner
- get-keywords
- :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.cache
- :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 :eval)
-
-(defun ejc-invalidate-cache ()
- "Clean current connection cache (database owners and tables list)."
- (interactive)
- (ejc-invalidate-cache-inner ejc-db))
-
-(clomacs-defun ejc-output-cache
- output-cache
- :lib-name "ejc-sql"
- :namespace ejc-sql.cache
- :return-type :eval)
-
-(defun ejc-print-cache ()
- "Print current database connection cache when run from connected SQL buffer.
-Print all connections cache otherwise."
- (interactive)
- (pprint (ejc-output-cache ejc-db)))
-
-(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)
-
-(clomacs-defun ejc-get-this-owner
- get-this-owner
- :lib-name "ejc-sql"
- :namespace ejc-sql.structure)
-
-(defun ejc-unset-mode-name ()
- (if (derived-mode-p 'org-mode)
- (setq mode-name "Org")
- (if (derived-mode-p 'sql-mode)
- (setq mode-name "SQL"))))
-
-(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)
- (ejc-unset-mode-name)
- (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-2023 - 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 's)
-(require 'dash)
-(require 'sql)
-
-(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-lein-artifact-to-path (artifact)
- "Get ~/.m2 jar file path of artifact."
- (if (not (vectorp artifact))
- (error
- "Expect leiningen artifact, e.g. [com.h2database/h2 \"1.4.199\"]."))
- (let* ((group (car (split-string
- (ejc-strip-text-properties (symbol-name (elt artifact 0)))
- "/")))
- (name (or (cadr (split-string
- (ejc-strip-text-properties
- (symbol-name (elt artifact 0))) "/"))
- group))
- (version (elt artifact 1)))
- (format "~/.m2/repository/%s/%s/%s/%s-%s.jar"
- (mapconcat 'identity (split-string group "\\.") "/")
- name
- version
- name
- version)))
-
-(defun ejc-path-to-lein-artifact (path)
- "Get leiningen artifact from ~/.m2 jar file path."
- (if (not (stringp path))
- (error
- "Expect jar file path."))
- (let* ((path (s-replace "\\" "/" path))
- (path (nth 1 (s-split ".m2/repository/" path)))
- (path-elements (s-split "/" path))
- (version (nth (- (length path-elements) 2) path-elements))
- (name (nth (- (length path-elements) 3) path-elements))
- (group (s-join "." (-> path-elements -butlast -butlast -butlast))))
- (read
- (format "[[%s/%s \"%s\"]]"
- group
- name
- version))))
-
-(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)
-
-(defvar ejc-product-assoc
- '((sqlserver . ms)
- (oracle:sid . oracle)))
-
-(defun ejc-get-product-name (db)
- "Get database type from db connection info."
- (let ((product-name (or (alist-get :subprotocol db)
- (alist-get :dbtype db))))
- (or (cdr (assoc-string product-name ejc-product-assoc))
- (car (assoc-string product-name sql-product-alist))
- 'ansi)))
-
-(defun ejc-ensure-file-directory-exists (file-path)
- (let ((dir (file-name-directory file-path)))
- (if (not (file-accessible-directory-p dir))
- (make-directory dir))))
-
-(defun ejc-save-to-file (file-path data)
- "Save Elisp variable DATA to FILE-PATH."
- (ejc-ensure-file-directory-exists file-path)
- (with-temp-file file-path
- (prin1 data (current-buffer))))
-
-(cl-defun ejc-load-from-file (file-path &key default check)
- "Read Elisp variable from FILE-PATH."
- (ejc-ensure-file-directory-exists file-path)
- (condition-case nil
- (with-temp-buffer
- (insert-file-contents file-path)
- (let ((value (read (current-buffer))))
- (if (and check (funcall check value))
- value
- (error "File contents don't match function check."))))
- (error (ejc-save-to-file file-path default)
- default)))
-
-(defun ejc-plist-p (lst)
- "Check if LST is a plist."
- (condition-case nil
- (progn
- (lax-plist-get lst nil)
- t)
- (error nil)))
-
-(defun ejc-flatten-index (imenu-index)
- "Flatten imenu index into a plain list.
-IMENU-INDEX - imenu index tree."
- (-mapcat
- (lambda (x)
- (if (imenu--subalist-p x)
- (mapcar (lambda (y) (cons (car y) (cdr y)))
- (ejc-flatten-index (cdr x)))
- (list x)))
- imenu-index))
-
-(defun ejc-split-and-join (fn split &optional join)
- "Split string by SPLIT, apply FN to each substring, than join by JOIN."
- (let ((join (or join split)))
- (string-join
- (-map fn (split-string (car p) split))
- join)))
-
-(defun ejc-not-nil-str (s)
- (not (equal s "nil")))
-
-(defun ejc-append-without-duplicates (list-left list-right comparator lead)
- "Unite LIST-LEFT and LIST-RIGHT without duplicates items.
-Check items equality by COMPARATOR function.
-In case if some item presents in both lists (in terms of COMPARATOR
-equality) get the item from LIST-LEFT if LEAD param is `:left'or
-get it from LIST-RIGHT if LEAD param is `:right'."
- (let* ((a (if (eq lead :left) list-left list-right))
- (b (if (eq lead :left) list-right list-left))
- (a-results (-map comparator a)))
- (append a
- (-filter
- (lambda (b-item)
- (not (-contains-p a-results
- (funcall comparator b-item))))
- b))))
-
-(provide 'ejc-lib)
-
-;;; ejc-lib.el ends here
+++ /dev/null
-;;; ejc-result-buffer.el
-
-;;; Copyright © 2019-2020 - 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-result-mode)
-
-(defvar ejc-results-buffer nil
- "The results buffer.")
-
-(defvar ejc-results-buffer-name "*ejc-sql-output*"
- "The results buffer name.")
-
-(defvar ejc-result-file-template "ejc-sql-result-%d.txt"
- "SQL evaluation results file name template.")
-
-(defvar ejc-result-file-path nil
- "The current result file path. Refreshed by any finished SQL evaluation.")
-
-(defcustom ejc-results-path temporary-file-directory
- "SQL evaluation result files location."
- :group 'ejc-sql
- :type 'string)
-
-(defcustom ejc-ring-length 10
- "The number of SQL evaluation results to keep."
- :group 'ejc-sql
- :type 'integer)
-
-(defcustom ejc-show-result-bottom nil
- "When t show result output buffer in the bottom window."
- :group 'ejc-sql
- :type 'boolean)
-
-(defvar ejc-ring-position 0
- "Current SQL evaluation result position in ring.")
-
-(defvar ejc-modes-ring (list)
- "List of SQL evaluation result modes.")
-
-(defcustom ejc-modes-ring-file (expand-file-name
- "ejc-modes-ring.el"
- ejc-results-path)
- "Previous SQL evaluation result modes file location."
- :group 'ejc-sql
- :type 'string)
-
-(defun ejc-update-modes-ring (mode)
- "Update SQL evaluation result modes list, persist it in `ejc-modes-ring-file'."
- (setf (alist-get ejc-ring-position ejc-modes-ring) mode)
- (ejc-save-to-file ejc-modes-ring-file ejc-modes-ring))
-
-(defun ejc-load-modes-ring ()
- "Load SQL evaluation result modes list `ejc-modes-ring' var."
- (setq ejc-modes-ring
- (ejc-load-from-file ejc-modes-ring-file :default (list))))
-
-(defun ejc-get-result-file-path ()
- "Get current SQL evaluation result file path."
- (expand-file-name (format ejc-result-file-template ejc-ring-position)
- ejc-results-path))
-
-(defun ejc-inc-ring-position ()
- (setq ejc-ring-position (1+ ejc-ring-position)
- ejc-ring-position (if (>= ejc-ring-position ejc-ring-length)
- 0
- ejc-ring-position)))
-
-(defun ejc-dec-ring-position ()
- (setq ejc-ring-position (1- ejc-ring-position)
- ejc-ring-position (if (< ejc-ring-position 0)
- (1- ejc-ring-length)
- ejc-ring-position)))
-
-(defun ejc-iterate-ring (inc-or-dec &optional should-exist)
- (funcall inc-or-dec)
- (if should-exist
- (let ((idx 0))
- (while (and (not (file-exists-p (ejc-get-result-file-path)))
- (if (< idx ejc-ring-length)
- t
- (progn
- (setq ejc-ring-position 0)
- nil)))
- (setq idx (1+ idx))
- (funcall inc-or-dec))))
- (setq ejc-result-file-path (ejc-get-result-file-path)))
-
-(defun ejc-next-result-file-path (&optional should-exist)
- (ejc-iterate-ring 'ejc-inc-ring-position should-exist))
-
-(defun ejc-prev-result-file-path (&optional should-exist)
- (ejc-iterate-ring 'ejc-dec-ring-position should-exist))
-
-(defun ejc-get-output-buffer ()
- "Get or create buffer for output SQL evaluation results.
-It can be result sets, record affected messages, SQL definition of entities
-or error messages."
- (when (not (and ejc-results-buffer
- (buffer-live-p ejc-results-buffer)))
- (setq ejc-results-buffer (get-buffer-create
- ejc-results-buffer-name))
- (with-current-buffer ejc-results-buffer
- (ejc-result-mode)))
- (with-current-buffer ejc-results-buffer
- ;; Clear undo history
- (setq buffer-undo-list nil))
- ejc-results-buffer)
-
-(defun ejc-output-mode-specific-customization ()
- (cl-case ejc-result-table-impl
- (orgtbl-mode (when (org-table-p) (org-table-align)))
- (ejc-result-mode (read-only-mode 1))))
-
-(defun ejc-show-result-buffer (output-buffer)
- (if ejc-show-result-bottom
- (display-buffer output-buffer '(display-buffer-at-bottom . ()))
- (display-buffer output-buffer)))
-
-;;;###autoload
-(cl-defun ejc-show-last-result (&key result
- mode
- connection-name
- db
- goto-symbol)
- "Popup buffer with last SQL execution result output."
- (interactive)
- (let ((output-buffer (ejc-get-output-buffer)))
- (with-current-buffer output-buffer
- (read-only-mode -1)
- (erase-buffer)
- (when mode
- (ejc-update-modes-ring mode)
- (funcall mode))
- (ejc-add-connection connection-name db)
- (if result
- ;; SQL evaluation result passed directly to fn
- (insert result)
- ;; SQL evaluation result rendered to file
- (insert-file-contents (ejc-get-result-file-path)))
- (ejc-output-mode-specific-customization)
- (beginning-of-buffer)
- (let* ((window (or (get-buffer-window output-buffer t)
- (progn
- (ejc-show-result-buffer output-buffer)
- (get-buffer-window output-buffer t))))
- (frame (window-frame window)))
- (if (not (eq frame (selected-frame)))
- (make-frame-visible frame))
- (if goto-symbol
- ;; Reversed, since if the result buffer is a package, it can
- ;; contain 2 concatenated parts: header and implementation.
- ;; Assume user wants to locate a point (cursor) in
- ;; procedure implementation.
- (if-let* ((items-list (reverse (delq imenu--rescan-item
- (ejc-flatten-index
- (condition-case nil
- (imenu--make-index-alist)
- (error nil))))))
- ;; Find symbol position (typically to locate the
- ;; beginning of procedure implementation in the package).
- (pos (alist-get goto-symbol items-list nil nil 'equal)))
- (set-window-point window pos)))))))
-
-(cl-defun ejc-show-ring-result (prev-or-next)
- (let ((output-buffer (ejc-get-output-buffer)))
- (set-buffer output-buffer)
- (read-only-mode -1)
- (erase-buffer)
- (ejc-add-connection ejc-connection-name ejc-db)
- (let ((file-path (funcall prev-or-next t))
- (mode (alist-get ejc-ring-position (or ejc-modes-ring
- (ejc-load-modes-ring)))))
- (if mode
- (funcall mode))
- (insert-file-contents file-path)
- (ejc-output-mode-specific-customization)
- (beginning-of-buffer)
- (ejc-show-result-buffer output-buffer)
- (message file-path))))
-
-;;;###autoload
-(cl-defun ejc-show-prev-result ()
- "Change `ejc-results-buffer' contents: show previous SQL evaluation result."
- (interactive)
- (ejc-show-ring-result 'ejc-prev-result-file-path))
-
-;;;###autoload
-(cl-defun ejc-show-next-result ()
- "Change `ejc-results-buffer' contents: show next SQL evaluation result."
- (interactive)
- (ejc-show-ring-result 'ejc-next-result-file-path))
-
-(provide 'ejc-result-buffer)
-
-;;; ejc-result-buffer.el ends here
+++ /dev/null
-;;; ejc-result-mode.el
-
-;;; Copyright © 2017-2020 - 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)
- ("│" . 'ejc-result-table-borders-face)
- ("─" . 'ejc-result-table-borders-face)
- ("┼" . 'ejc-result-table-borders-face)))
-
-(defvar ejc-result-mode-hook nil
- "Functions to be called when `ejc-result-mode' is entered.")
-
-(defun ejc-result-mode ()
- (interactive)
- (kill-all-local-variables)
- (setq truncate-lines t)
- (setq major-mode 'ejc-result-mode
- mode-name "SQL-Result")
- (cl-case ejc-result-table-impl
- (orgtbl-mode (orgtbl-mode 1))
- (ejc-result-mode (setq view-read-only t)))
- (setq font-lock-defaults '(ejc-result-font-lock-keywords))
- (run-hooks 'ejc-result-mode-hook))
-
-(provide 'ejc-result-mode)
-
-;;; ejc-result-mode.el ends here
+++ /dev/null
-;;; ejc-sql-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
-;;
-;;; 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-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#" t nil)
-
-(register-definition-prefixes "ejc-autocomplete" '("ac-source-ejc-" "ejc-ac-hook"))
-
-;;;***
-\f
-;;;### (autoloads nil "ejc-company" "ejc-company.el" (0 0 0 0))
-;;; Generated autoloads from ejc-company.el
-
-(register-definition-prefixes "ejc-company" '("ejc-company-"))
-
-;;;***
-\f
-;;;### (autoloads nil "ejc-completion-common" "ejc-completion-common.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from ejc-completion-common.el
-
-(autoload 'ejc-owners-candidates "ejc-completion-common" nil nil nil)
-
-(autoload 'ejc-tables-candidates "ejc-completion-common" nil nil nil)
-
-(autoload 'ejc-views-candidates "ejc-completion-common" nil nil nil)
-
-(autoload 'ejc-packages-candidates "ejc-completion-common" nil nil nil)
-
-(autoload 'ejc-colomns-candidates "ejc-completion-common" nil nil nil)
-
-(register-definition-prefixes "ejc-completion-common" '("ac-ejc-documentation" "ejc-"))
-
-;;;***
-\f
-;;;### (autoloads nil "ejc-doc" "ejc-doc.el" (0 0 0 0))
-;;; Generated autoloads from ejc-doc.el
-
-(register-definition-prefixes "ejc-doc" '("ejc-"))
-
-;;;***
-\f
-;;;### (autoloads nil "ejc-eldoc" "ejc-eldoc.el" (0 0 0 0))
-;;; Generated autoloads from ejc-eldoc.el
-
-(autoload 'ejc-eldoc-setup "ejc-eldoc" "\
-Set up eldoc function and enable eldoc-mode." t nil)
-
-(register-definition-prefixes "ejc-eldoc" '("ejc-"))
-
-;;;***
-\f
-;;;### (autoloads nil "ejc-flx" "ejc-flx.el" (0 0 0 0))
-;;; Generated autoloads from ejc-flx.el
-
-(register-definition-prefixes "ejc-flx" '("ejc-"))
-
-;;;***
-\f
-;;;### (autoloads nil "ejc-format" "ejc-format.el" (0 0 0 0))
-;;; Generated autoloads from ejc-format.el
-
-(register-definition-prefixes "ejc-format" '("ejc-"))
-
-;;;***
-\f
-;;;### (autoloads nil "ejc-interaction" "ejc-interaction.el" (0 0
-;;;;;; 0 0))
-;;; Generated autoloads from ejc-interaction.el
-
-(register-definition-prefixes "ejc-interaction" '("ejc-"))
-
-;;;***
-\f
-;;;### (autoloads nil "ejc-lib" "ejc-lib.el" (0 0 0 0))
-;;; Generated autoloads from ejc-lib.el
-
-(register-definition-prefixes "ejc-lib" '("ejc-"))
-
-;;;***
-\f
-;;;### (autoloads nil "ejc-result-buffer" "ejc-result-buffer.el"
-;;;;;; (0 0 0 0))
-;;; Generated autoloads from ejc-result-buffer.el
-
-(autoload 'ejc-show-last-result "ejc-result-buffer" "\
-Popup buffer with last SQL execution result output.
-
-\(fn &key RESULT MODE CONNECTION-NAME DB GOTO-SYMBOL)" t nil)
-
-(autoload 'ejc-show-prev-result "ejc-result-buffer" "\
-Change `ejc-results-buffer' contents: show previous SQL evaluation result." t nil)
-
-(autoload 'ejc-show-next-result "ejc-result-buffer" "\
-Change `ejc-results-buffer' contents: show next SQL evaluation result." t nil)
-
-(register-definition-prefixes "ejc-result-buffer" '("ejc-"))
-
-;;;***
-\f
-;;;### (autoloads nil "ejc-result-mode" "ejc-result-mode.el" (0 0
-;;;;;; 0 0))
-;;; Generated autoloads from ejc-result-mode.el
-
-(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.
-
-This is a minor mode. If called interactively, toggle the
-`ejc-Sql mode' mode. If the prefix argument is positive, enable
-the mode, and if it is zero or negative, disable the mode.
-
-If called from Lisp, toggle the mode if ARG is `toggle'. Enable
-the mode if ARG is nil, omitted, or is a positive number.
-Disable the mode if ARG is a negative number.
-
-To check whether the minor mode is enabled in the current buffer,
-evaluate `ejc-sql-mode'.
-
-The mode's hook is called both when the mode is enabled and when
-it is disabled.
-
-\(fn &optional ARG)" t nil)
-
-(autoload 'ejc-create-menu "ejc-sql" nil nil nil)
-
-(autoload 'ejc-insert-connection-data "ejc-sql" "\
-Insert configured connection data to keep it between Emacs restarts.
-Assume to be evaluated somewhere in .emacs or any file, loaded as Emacs
-configuration.
-
-\(fn CONNECTION-NAME)" t nil)
-
-(autoload 'ejc-connect-interactive "ejc-sql" "\
-Create new connection interactively and connect to it.
-
-\(fn CONNECTION-NAME)" t 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. " t nil)
-
-(autoload 'ejc-eval-user-sql-region "ejc-sql" "\
-Evaluate SQL bounded by the selection area.
-
-\(fn BEG END)" t nil)
-
-(autoload 'ejc-eval-user-sql-at-point "ejc-sql" "\
-Evaluate SQL bounded by the `ejc-sql-separator' or/and buffer
-boundaries.
-
-\(fn &key SYNC BEG END (DISPLAY-RESULT t))" t nil)
-
-(autoload 'ejc-show-tables-list "ejc-sql" "\
-Output tables list." t nil)
-
-(autoload 'ejc-show-views-list "ejc-sql" "\
-Output views list." t nil)
-
-(autoload 'ejc-show-user-types-list "ejc-sql" "\
-Output user types list.
-
-\(fn &optional OWNER)" t nil)
-
-(autoload 'ejc-show-constraints-list "ejc-sql" "\
-Output constraints list.
-
-\(fn &optional OWNER TABLE)" t nil)
-
-(autoload 'ejc-show-procedures-list "ejc-sql" "\
-Output procedures list." t nil)
-
-(autoload 'ejc-get-temp-editor-buffer "ejc-sql" "\
-
-
-\(fn &optional NUM)" t nil)
-
-(autoload 'ejc-version "ejc-sql" "\
-Get the ejc-sql version as string." t nil)
-
-(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" "20230702.2048" "Emacs SQL client uses Clojure JDBC."
- '((emacs "26.3")
- (clomacs "0.0.5")
- (dash "2.16.0")
- (spinner "1.7.3"))
- :commit "cfb2a3b00d16c6b8575b84d4963ac0c21f91fa05" :authors
- '(("Kostafey" . "kostafeyNOSPAMgmail.com"))
- :maintainers
- '(("Kostafey" . "kostafeyNOSPAMgmail.com"))
- :maintainer
- '("Kostafey" . "kostafeyNOSPAMgmail.com")
- :keywords
- '("sql" "jdbc")
- :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-2020 - Kostafey <kostafeyNOSPAMgmail.com>
-
-;; Author: Kostafey <kostafeyNOSPAMgmail.com>
-;; URL: https://github.com/kostafey/ejc-sql
-;; Keywords: sql, jdbc
-;; Version: 0.4.1
-;; Package-Requires: ((emacs "26.3")(clomacs "0.0.5")(dash "2.16.0")(spinner "1.7.3"))
-
-;; 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 'org-table)
-(require 'ejc-lib)
-(require 'ejc-eldoc)
-(require 'ejc-format)
-(require 'ejc-interaction)
-(require 'ejc-result-mode)
-(require 'ejc-result-buffer)
-(require 'ejc-completion-common)
-
-(defvar-local ejc-db nil
- "JDBC connection info for current SQL buffer.")
-
-(defvar ejc-connections nil
- "List of existing configured jdbc connections")
-
-(defvar ejc-current-buffer-query nil
- "Current SQL edit buffer lanched query.")
-
-(defcustom ejc-temp-editor-buffer-name "ejc-sql-editor"
- "Template name for buffers used to ad-hoc edit SQL scripts."
- :group 'ejc-sql
- :type 'string)
-
-(defcustom ejc-temp-editor-file-path (expand-file-name "~/tmp/ejc-sql/")
- "Directory to save temp ad-hoc SQL edit buffers contents."
- :group 'ejc-sql
- :type 'string)
-
-(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-result-table-impl 'orgtbl-mode
- "Set mode for result-set table. Possible values are one of:
-'orgtbl-mode
-'ejc-result-mode."
- :group 'ejc-sql
- :type 'symbol)
-
-(defcustom ejc-org-mode-babel-wrapper t
- "Add wrapper around org-mode default `org-babel-execute:sql'."
- :type 'boolean
- :safe #'booleanp
- :group 'ejc-sql)
-
-(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)
-
-(defcustom ejc-jdbc-drivers
- '("sqlite" [org.xerial/sqlite-jdbc "3.23.1"]
- "h2" [com.h2database/h2 "1.4.199"]
- "mysql" [mysql/mysql-connector-java "5.1.44"]
- "postgresql" [postgresql/postgresql "9.3-1102.jdbc41"]
- "sqlserver" [com.microsoft.sqlserver/mssql-jdbc "6.2.2.jre8"]
- "oracle" [com.oracle.jdbc/ojdbc8 "12.2.0.1"])
- "Artifacts used as JDBC drivers for each database type in Leiningen format."
- :group 'ejc-sql
- :type '(plist :key-type string :value-type (vector symbol string)))
-
-(defcustom ejc-completion-system 'standard
- "The completion system used by `ejc-connect'."
- :group 'ejc-sql
- :type '(radio
- (const :tag "Ido" ido)
- (const :tag "Standard" standard)
- (function :tag "Custom function")))
-
-(defvar-local ejc-replace-double-quotes nil
- "When t replace double quotes with single ones in SQL before evaluation.")
-
-(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-c C-r") 'ejc-eval-user-sql-region)
-(define-key ejc-sql-mode-keymap (kbd "C-h t") 'ejc-describe-table)
-(define-key ejc-sql-mode-keymap (kbd "C-h d") '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)
-(define-key ejc-sql-mode-keymap (kbd "M-.") 'ejc-describe-entity)
-(define-key ejc-sql-mode-keymap (kbd "M-,") 'ejc-show-prev-result)
-(define-key ejc-sql-mode-keymap (kbd ".") 'ejc-dot-pressed)
-
-(defvar ejc-command-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "c") #'ejc-connect)
- (define-key map (kbd "i") #'ejc-connect-interactive)
- (define-key map (kbd "<up>") #'ejc-show-last-result)
- (define-key map (kbd "t") #'ejc-show-tables-list)
- (define-key map (kbd "v") #'ejc-show-views-list)
- (define-key map (kbd "p") #'ejc-show-procedures-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 "f") #'ejc-format-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-connected-hook nil
- "Hook run when nREPL started and some buffer connected to DataBase.")
-
-(defvar ejc-sql-complete-query-hook nil
- "Hook run when SQL query executed and the result is outputted.")
-
-(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)))))
-
-;;;###autoload
-(define-minor-mode ejc-sql-mode
- "Toggle ejc-sql mode."
- :lighter " ejc"
- :keymap ejc-sql-mode-keymap
- :group 'ejc
- :global nil
- (if ejc-sql-mode
- (progn
- (ejc-create-menu)
- (ejc-refresh-font-lock)
- (run-hooks 'ejc-sql-minor-mode-hook))
- (progn
- (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
- dependencies
- classpath
- separator
- sslmode
- ;; ----------
- ;; 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 :dependencies dependencies)
- (cons :classpath
- (when classpath
- (if (vectorp classpath)
- (apply 'vector
- (-map 'file-truename classpath))
- (vector (file-truename classpath)))))
- (cons :separator separator)
- (cons :sslmode sslmode)
- (cons :classname classname)))
- new-connection))
- ejc-connections)))
-
-(cl-defun ejc-completing-read (prompt choices &key initial-input)
- "Present a PROMPT with CHOICES and optional INITIAL-INPUT."
- (cond
- ((eq ejc-completion-system 'ido)
- (ido-completing-read prompt choices nil nil initial-input))
- ((eq ejc-completion-system 'standard)
- (completing-read prompt choices nil nil initial-input))
- (t (funcall ejc-completion-system prompt choices))))
-
-(defun ejc-read-file-name (prompt)
- "Read file name, prompting with PROMPT."
- (cond
- ((eq ejc-completion-system 'ido)
- (ido-read-file-name prompt))
- (t
- (read-file-name prompt))))
-
-(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))
-
-(defun ejc-load-conn-statistics ()
- "Load connection usage statistics to `ejc-conn-statistics' var."
- (setq ejc-conn-statistics
- (ejc-load-from-file ejc-conn-statistics-file
- :default (list)
- :check 'ejc-plist-p)))
-
-(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))))
- (ejc-save-to-file ejc-conn-statistics-file ejc-conn-statistics))
-
-(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
- (if (listp mode-name)
- (car mode-name)
- mode-name)
- "->\\[.+\\]"))
- connection-name)))
-
-(cl-defun ejc-add-connection (&optional connection-name db)
- "Add ejc connection information to current buffer.
-If the current mode is `sql-mode' prepare buffer to operate as `ejc-sql-mode'."
- (when (derived-mode-p 'sql-mode)
- (sql-set-product (if db
- (ejc-get-product-name db)
- "ansi"))
- (ejc-sql-mode t))
- (setq-local ejc-connection-name connection-name)
- (setq-local ejc-db db)
- (ejc-set-mode-name connection-name))
-
-(defun ejc-eval-org-snippet (&optional orig-fun body params)
- "Used to eval SQL code in `org-mode' code snippets."
- (if (or (not ejc-org-mode-babel-wrapper)
- (and (cdr (assq :engine params))
- (not
- (yes-or-no-p
- (concat "ejc-sql is enabled, ignore source block connection"
- " header arguments and use ejc-sql to execute it? ")))))
- (funcall orig-fun body params)
- (cl-multiple-value-bind (beg end) (save-mark-and-excursion
- (org-babel-mark-block)
- (list (point) (mark)))
- (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-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))
- (apply orig-fun args)
- (ejc-add-connection connection-name db))
- (apply orig-fun args)))
-
-(defun ejc-read-connection-name ()
- "Read connection-name in minibuffer."
- (ejc-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))))
-
-;;;###autoload
-(defun ejc-insert-connection-data (connection-name)
- "Insert configured connection data to keep it between Emacs restarts.
-Assume to be evaluated somewhere in .emacs or any file, loaded as Emacs
-configuration."
- (interactive
- (list (or (and (boundp 'connection-name) connection-name)
- (ejc-read-connection-name))))
- (let ((connection-params (cdr (ejc-find-connection connection-name))))
- (insert
- (format "(ejc-create-connection\n \"%s\"%s)"
- connection-name
- (-reduce-from
- (lambda (result x)
- (concat result
- (format "\n %s \"%s\""
- (symbol-name (car x))
- (cdr x))))
- ""
- connection-params)))))
-
-(defalias 'ejc-save-connection-data 'ejc-insert-connection-data)
-
-(defun ejc-resolve-jdbc-driver (dbtype)
- "Resolve and download artifacts (JDBC drivers) for DBTYPE.
-Apropriate artifacts list located in `ejc-jdbc-drivers'."
- (let* ((artifact (lax-plist-get ejc-jdbc-drivers dbtype))
- (jar-path (ejc-lein-artifact-to-path artifact)))
- (if (not (and (file-exists-p jar-path)
- (if (> (file-attribute-size (file-attributes jar-path))
- 0)
- t
- ;; If JDBC driver jar file is accidentally empty - it
- ;; should be deleted and reinstalled.
- (progn (delete-file jar-path)
- nil))))
- (ejc-resolve-dependencies
- :coordinates (vector artifact)
- :repositories '(("central" . "https://repo1.maven.org/maven2/")
- ("clojars" . "https://clojars.org/repo"))))
- jar-path))
-
-;;;###autoload
-(defun ejc-connect-interactive (connection-name)
- "Create new connection interactively and connect to it."
- (interactive
- (list
- (or (and (boundp 'connection-name) connection-name)
- (read-string "DataBase new connection name: "))))
- (let* ((db-types '(("MySQL" . "mysql")
- ("Oracle" . "oracle")
- ("MS SQL Server" . "sqlserver")
- ("H2" . "h2")
- ("SQLite" . "sqlite")
- ("PostgreSQL" . "postgresql")))
- (dbtype (cdr (assoc-string
- (ejc-completing-read
- "Database type: "
- (cl-sort (-map 'car db-types)
- 'string-lessp :key 'downcase))
- db-types)))
- (properties
- (-concat
- (pcase dbtype
- ("sqlite"
- `((:subprotocol . "sqlite")
- (:subname . "")))
- ("h2"
- `((:subprotocol . "h2")
- (:subname . "")))
- ("mysql"
- `((:dbtype . "mysql")
- (:classname . "com.mysql.jdbc.Driver")
- (:dbname . "")
- (:host . "localhost")
- (:port . "3306")))
- ("postgresql"
- `((:dbtype . "postgresql")
- (:dbname . "")
- (:host . "localhost")
- (:port . "5432")))
- ("sqlserver"
- `((:dbtype . "sqlserver")
- (:dbname . "")
- (:host . "localhost")
- (:port . "1433")))
- ("oracle"
- `((:dbtype . "oracle")
- (:dbname . "")
- (:host . "localhost")
- (:port . "1521"))))
- '((:classpath . "")
- (:user . "")
- (:password . ""))))
- (args
- (-reduce-from
- (lambda (memo p)
- (-concat
- memo
- (list
- (car p)
- (cl-case (car p)
- (:dbtype (cdr p))
- (:classpath (ejc-resolve-jdbc-driver dbtype))
- (:classname (cdr p))
- (:subprotocol (cdr p))
- (:subname (if (member dbtype '("h2" "sqlite"))
- (let ((fpath
- (file-truename
- (ejc-read-file-name "DB file: "))))
- (if (equal "h2" dbtype)
- (concat "file://"
- (file-name-sans-extension
- (file-name-sans-extension
- fpath))
- ";AUTO_SERVER=TRUE")
- fpath))
- (read-string "DataBase subname: " (cdr p))))
- (:dbname (read-string "DataBase name: " (cdr p)))
- (:host (read-string "Host: " (cdr p)))
- (:port (read-string "Port: " (cdr p)))
- (:user (read-string "User: "))
- (:password (read-passwd "Password: "))))))
- (list connection-name)
- properties)))
- (apply 'ejc-create-connection args)
- (ejc-connect connection-name)))
-
-;;;###autoload
-(defun ejc-connect (connection-name)
- "Connect to selected db."
- (interactive (list
- (or (and (boundp 'connection-name) connection-name)
- (ejc-read-connection-name))))
- (if-let ((db (cdr (ejc-find-connection connection-name))))
- (progn
- (ejc-update-conn-statistics connection-name)
- (ejc-add-connection connection-name db)
- (when (derived-mode-p 'org-mode)
- (require 'ob-sql)
- (advice-add 'org-babel-execute:sql :around 'ejc-eval-org-snippet)
- (advice-add 'org-edit-special :around #'ejc-org-edit-special))
- (message "Connection started...")
- (clomacs-with-nrepl "ejc-sql"
- (lambda (db connection-name)
- (ejc-connect-to-db db)
- (let ((validation-result
- (ejc-validate-connection
- :db db
- :timeout ejc-connection-validate-timeout)))
- (when (alist-get :status validation-result)
- (ejc-set-mode-name connection-name)
- (run-hooks 'ejc-sql-connected-hook)
- (message (let ((msg (alist-get :message validation-result)))
- (if (equal "Connected." msg)
- (format
- "Connected -> %s."
- (propertize connection-name
- 'face 'font-lock-keyword-face))
- msg))))))
- :params (list db connection-name)))
- (ejc-connect-interactive connection-name)))
-
-;;;###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-check-connection ()
- (unless (ejc-buffer-connected-p)
- (error "Run M-x ejc-connect first!")))
-
-(defun ejc-get-sql-from-string (sql)
- (let* ((sql (replace-regexp-in-string ejc-clear-sql-regexp "" sql))
- (sql (if ejc-replace-double-quotes
- (replace-regexp-in-string "\"" "'" sql)
- sql)))
- sql))
-
-(defun ejc-add-outside-borders-p ()
- (cl-case ejc-result-table-impl
- (orgtbl-mode t)
- (ejc-result-mode nil)))
-
-(defun ejc-message-query-done (start-time status)
- (message
- "%s SQL query at %s. Exec time %.03f"
- (cl-case status
- (: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."
- (if ejc-current-buffer-query
- (with-current-buffer ejc-current-buffer-query
- (spinner-stop))))
-
-(cl-defun ejc-complete-query (result-file-path
- &key
- start-time
- status
- display-result
- mode
- connection-name
- db
- goto-symbol)
- "Called by Clojure side, when SQL evaluation thread completes."
- (ejc-spinner-stop)
- (if result-file-path
- (setq ejc-result-file-path result-file-path))
- (if display-result
- (ejc-show-last-result :mode mode
- :connection-name connection-name
- :db db
- :goto-symbol goto-symbol))
- (if (and start-time status)
- (ejc-message-query-done start-time status))
- (run-hooks 'ejc-sql-complete-query-hook)
- 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)
- (ejc-spinner-stop)
- (if (and (clomacs-get-connection "ejc-sql")
- (ejc--is-query-running-p))
- (let ((start-time (or start-time (ejc--cancel-query))))
- (ejc-message-query-done start-time :terminated))
- (keyboard-quit)))
-
-(defun ejc-get-prompt-symbol-under-point (msg)
- "Read user typed string from minibuffer.
-MSG is a first part of the prompt message. The second optional part in
-brackets is a symbol under point (cursor). Return a list of two items:
-(schema|owner db-entity)."
- (let* ((prefix (if (not mark-active)
- (ejc-get-prefix-word)))
- (sql-symbol (if mark-active
- (buffer-substring (mark) (point))
- (ejc-get-word-at-point (point))))
- (enable-recursive-minibuffers t)
- (typed-string (read-string
- (if sql-symbol
- (format "%s (default %s): "
- msg
- (if prefix
- (format "%s.%s" prefix sql-symbol)
- sql-symbol))
- (format "%s: " msg)))))
- (if (equal typed-string "")
- (list prefix sql-symbol)
- (let ((split-typed-string (split-string typed-string "\\.")))
- (if (cadr split-typed-string)
- split-typed-string
- (list nil typed-string))))))
-
-(defun ejc-describe-table (prefix 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)
- (ejc--describe-table :db ejc-db
- :connection-name ejc-connection-name
- :table table-name
- :owner prefix
- :result-file (ejc-next-result-file-path)
- :add-outside-borders (ejc-add-outside-borders-p)))
-
-(defun ejc-describe-entity (prefix 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-get-entity-description :db ejc-db
- :connection-name ejc-connection-name
- :prefix prefix
- :entity-name entity-name
- :result-file (ejc-next-result-file-path)))
-
-(cl-defun ejc-eval-user-sql (sql &key
- db
- rows-limit
- fetch-size
- column-width-limit
- append
- sync
- display-result
- result-file)
- "User starts SQL evaluation process."
- (message "Processing SQL query...")
- (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
- (or db ejc-db)
- prepared-sql
- :start-time (current-time)
- :rows-limit rows-limit
- :fetch-size fetch-size
- :column-width-limit column-width-limit
- :append append
- :sync sync
- :display-result display-result
- :result-file (or result-file
- (ejc-next-result-file-path))
- :add-outside-borders (ejc-add-outside-borders-p)))))
-
-;;;###autoload
-(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
- :display-result t))
- (if (region-active-p)
- (deactivate-mark)))
-
-;;;###autoload
-(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))
-
-;;;###autoload
-(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
- :fetch-size 0
- :column-width-limit 0
- :display-result t))
-
-;;;###autoload
-(defun ejc-show-views-list ()
- "Output views list."
- (interactive)
- (ejc-check-connection)
- (ejc-eval-user-sql
- (ejc-select-db-meta-script ejc-db :views)
- :rows-limit 0
- :column-width-limit 0
- :display-result t))
-
-;;;###autoload
-(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)))
-
-;;;###autoload
-(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)))
-
-;;;###autoload
-(defun ejc-show-procedures-list ()
- "Output procedures list."
- (interactive)
- (ejc-check-connection)
- (ejc-eval-user-sql
- (ejc-select-db-meta-script ejc-db :procedures
- :owner (ejc-get-this-owner ejc-db))
- :rows-limit 0
- :column-width-limit 0
- :display-result t))
-
-;;;###autoload
-(defun ejc-get-temp-editor-buffer (&optional num)
- (interactive "P")
- "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."
- (let* ((tmp-file-name (if num
- (format "%s-%s"
- ejc-temp-editor-buffer-name
- (if (numberp num)
- (int-to-string num)
- num))
- ejc-temp-editor-buffer-name))
- (tmp-file-path (progn
- (unless (file-exists-p ejc-temp-editor-file-path)
- (make-directory ejc-temp-editor-file-path t))
- (expand-file-name (concat tmp-file-name ".sql")
- ejc-temp-editor-file-path)))
- (tmp-buffer-name (format "*%s*" tmp-file-name)))
- (if (get-buffer tmp-buffer-name)
- (switch-to-buffer tmp-buffer-name)
- (progn
- (find-file tmp-file-path)
- (rename-buffer tmp-buffer-name)
- (sql-mode)
- (ejc-add-connection)
- (get-buffer tmp-buffer-name)))))
-
-(defun ejc-open-log ()
- (interactive)
- (find-file-read-only (ejc-get-log-file-path))
- (goto-char (point-max)))
-
-;;;###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.4.1-SNAPSHOT"
- :description "Interact with database via java/clojure libs to run SQL 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.11.1"]
- [org.clojure/java.jdbc "0.7.10"]
- [org.hibernate/hibernate-core "5.4.1.Final"]
- [com.cemerick/pomegranate "1.1.0"]
- [leiningen-core "2.9.3"]
- [org.apache.commons/commons-lang3 "3.5"]
- [org.apache.httpcomponents/httpclient "4.5.5"]
- [clomacs "0.0.5-SNAPSHOT"]])
+++ /dev/null
-# -*- mode: snippet -*-
-# name: altertable
-# key: altertable
-# --
-ALTER TABLE ${1:table}
- ADD ${2:column_name} ${3:column_definition}
+++ /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: grant
-# key: grant
-# --
-GRANT ALL PRIVILEGES
- ON ${1:object_type}
- TO ${2:user};
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: inner
-# key: inner
-# --
-INNER JOIN ${1:table_name} ON $2
\ 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: left
-# key: left
-# --
-LEFT JOIN ${1:table_name} ON $2
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: revoke
-# key: revoke
-# --
-REVOKE ALL PRIVILEGES
- ON ${1:object_type}
- FROM ${2:user};
\ No newline at end of file
+++ /dev/null
-# -*- mode: snippet -*-
-# name: right
-# key: right
-# --
-RIGHT JOIN ${1:table_name} ON $2
\ 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
-;;; cache.clj -- Keep database stucture cache.
-
-;;; Copyright © 2019-2023 - 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.cache
- (:require [clomacs :as clomacs]))
-
-(def cache
- "Keep information about structure of databases used for autocomplete & eldoc.
- This data contains (depends on database type):
- ├── owners/schemas
- | ├── tables
- | | └── columns
- | └── views
- ├── packages
- | └── stored procedures & functions
- | └── parameters
- └── keywords
- It's global: same database structure information shared beetween
- different buffers connected to the same database."
- (atom {}))
-
-(def cache-creation-promises
- "Signs of database structure cache created."
- (atom {}))
-
-(defn get-cache
- "Get actual cache."
- []
- @cache)
-
-(defn deref-cache [db]
- [db
- (into
- {}
- (map
- (fn [entity-k]
- [entity-k
- (let [item (get-in (get-cache) [db entity-k])]
- (if (future? item)
- (deref item)
- (if (map? item)
- (into
- {}
- (map
- (fn [sub-entity-k]
- [sub-entity-k
- (let [sub-item (get-in (get-cache)
- [db entity-k sub-entity-k])]
- (if (future? sub-item)
- (deref sub-item)
- sub-item))])
- (keys item)))
- item)))])
- (keys
- ((get-cache) db))))])
-
-(defn output-cache
- "Output actual cache to printable format."
- [db]
- (clomacs/format-result
- (if db
- (second (deref-cache db))
- (into {} (map deref-cache (keys (get-cache)))))))
-
-(defn invalidate-cache
- "Clean your current connection cache (database owners and tables list)."
- [db]
- (swap! cache assoc-in [db] nil)
- (swap! cache-creation-promises assoc-in [db] nil))
+++ /dev/null
-;; Version of `add-classpath` imlementation from Kaocha project.
-;; https://github.com/lambdaisland/kaocha/blob/master/src/kaocha/classpath.clj
-
-(ns ejc-sql.classpath
- "This is the add-classpath function from Pomegranate 1.0.0, extracted so we
- don't need to pull in Aether."
- (:refer-clojure :exclude [add-classpath])
- (:require [dynapath.util :as dp]
- [clojure.java.io :as io]))
-
-(def new-jdk
- (>= (BigDecimal. (System/getProperty "java.specification.version")) 1.9))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Pomegranate
-
-(defn ensure-compiler-loader
- "Ensures the clojure.lang.Compiler/LOADER var is bound to a DynamicClassLoader,
- so that we can add to Clojure's classpath dynamically."
- []
- (when-not (bound? Compiler/LOADER)
- (.bindRoot Compiler/LOADER (clojure.lang.DynamicClassLoader. (clojure.lang.RT/baseLoader)))))
-
-(defn- classloader-hierarchy
- "Returns a seq of classloaders, with the tip of the hierarchy first.
- Uses the current thread context ClassLoader as the tip ClassLoader
- if one is not provided."
- ([]
- (if new-jdk
- (ensure-compiler-loader)
- (classloader-hierarchy (.. Thread currentThread getContextClassLoader)))
- (classloader-hierarchy (deref clojure.lang.Compiler/LOADER)))
- ([tip]
- (->> tip
- (iterate #(.getParent %))
- (take-while boolean))))
-
-(defn- modifiable-classloader?
- "Returns true iff the given ClassLoader is of a type that satisfies
- the dynapath.dynamic-classpath/DynamicClasspath protocol, and it can
- be modified."
- [cl]
- (dp/addable-classpath? cl))
-
-(defn add-classpath
- "A corollary to the (deprecated) `add-classpath` in clojure.core. This implementation
- requires a java.io.File or String path to a jar file or directory, and will attempt
- to add that path to the right classloader (with the search rooted at the current
- thread's context classloader)."
- ([jar-or-dir classloader]
- (when-not (dp/add-classpath-url classloader (.toURL (.toURI (io/file jar-or-dir))))
- (throw (IllegalStateException. (str classloader " is not a modifiable classloader")))))
- ([jar-or-dir]
- (let [classloaders (classloader-hierarchy)]
- (if-let [cl (if new-jdk
- (filter modifiable-classloader? classloaders)
- (last (filter modifiable-classloader? classloaders)))]
- ;; Add to all classloaders that allow it. Brute force but doesn't hurt.
- (if new-jdk
- (run! #(add-classpath jar-or-dir %) cl)
- (add-classpath jar-or-dir cl))
- (throw (IllegalStateException. (str "Could not find a suitable classloader to modify from "
- classloaders)))))))
-
-;; /Pomegranate
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+++ /dev/null
-;;; connect.clj -- Core clojure functions for ejc-sql emacs extension.
-
-;;; Copyright © 2013-2023 - 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
- (:require [clojure.java.jdbc :as j]
- [clojure.java.io :as io]
- [clojure.string :as s]
- [clomacs :refer [clomacs-defn]]
- [ejc-sql.output :as o]
- [ejc-sql.lib :refer [select? ddl? clob-to-string-row *max-column-width*]]
- [ejc-sql.cache :refer [invalidate-cache]])
- (:import [java.sql SQLException]))
-
-(def db
- "DataBase connection properties list from the last transaction.
-For debug purpose."
- (atom nil))
-
-(defn set-db [ejc-db]
- (reset! db ejc-db))
-
-(def current-query
- "Current running query data."
- (atom {}))
-
-(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 is-statement-not-closed? []
- (let [stmt (:stmt @current-query)]
- (and (not (nil? stmt))
- (not (.isClosed stmt)))))
-
-(defn is-query-process-running? []
- (let [runner (:runner @current-query)]
- (and
- (not (nil? runner))
- (not (future-done? runner))
- (not (future-cancelled? runner)))))
-
-(defn is-query-running? []
- (or (is-statement-not-closed?)
- (is-query-process-running?)))
-
-(defn cancel-query
- "Terminate current (long) running query. Aimed to cancel SELECT queries.
- Unsafe for INSERT/UPDATE/CREATE/ALTER queries."
- []
- (future
- (when (is-statement-not-closed?)
- (let [conn (:conn @current-query)]
- (try
- (.rollback conn)
- (finally
- (.close conn)))))
- (when (is-query-process-running?)
- (future-cancel (:runner @current-query))))
- (:start-time @current-query))
-
-(defn validate-connection [& {:keys [db timeout]
- :or {db @ejc-sql.connect/db
- timeout 5}}]
- (letfn [(abstract-is-valid [msg]
- (clomacs/format-result
- {:status true
- :message (str "Warning: can't validate connection. "
- "Please, update your JDBC driver and "
- "restart the REPL.\n"
- msg)}))]
- (try
- (clomacs/format-result
- {:status (.isValid (j/get-connection db) timeout)
- :message "Connected."})
- (catch AbstractMethodError e
- (abstract-is-valid (.getMessage e)))
- (catch java.sql.SQLFeatureNotSupportedException e
- (abstract-is-valid (.getMessage e))))))
-
-(defn get-separator-re
- "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%'"
- [separator]
- (re-pattern
- (format
- "%s(?<!\\s{0,1000}--.{0,1000})(?=(([^\"']*[\"']){2})*[^\"']*$)"
- ;; Escape chars for `$$` separators.
- (.replace separator "$" "\\$"))))
-
-(def delimiter-re
- "Regex to search a `delimiter` command in SQL expression."
- (re-pattern "(?i)delimiter\\s+(.+)"))
-
-(def comments-re
- "Regex to search comments in SQL expression."
- (java.util.regex.Pattern/compile
- "(?:/\\*.*?\\*/)|(?:--.*?$)",
- (bit-or java.util.regex.Pattern/DOTALL
- java.util.regex.Pattern/MULTILINE)))
-
-(clomacs-defn complete-query 'ejc-complete-query
- :doc "Show file contents with SQL query evaluation results.")
-
-(defn complete
- "Complete query and display `text` as a result."
- [text & {:keys [display-result
- result-file
- append
- mode
- start-time
- status
- connection-name
- db
- goto-symbol]
- :or {display-result true
- append false
- mode 'ejc-result-mode}}]
- (complete-query
- (when text
- (o/write-result-file text :result-file result-file :append append))
-
- :start-time start-time
- :status status
- :display-result display-result
- :mode mode
- :connection-name connection-name
- :db db
- :goto-symbol goto-symbol))
-
-(defn eval-sql-core
- "The core SQL evaluation function."
- [& {:keys [db sql fetch-size max-rows]
- :or {db @ejc-sql.connect/db}}]
- (set-db db)
- (java.util.Locale/setDefault (java.util.Locale. "UK"))
- (try
- (if (select? sql)
- (list
- :result-set
- (with-open [conn (j/get-connection db)]
- (let [stmt (j/prepare-statement
- conn sql
- {:fetch-size (or fetch-size @o/fetch-size 0)
- :max-rows (or max-rows
- (if (and (> @o/max-rows 0)
- @o/show-too-many-rows-message)
- ;; Get one more row to recognize that
- ;; the actual number of records from this
- ;; query is bigger than `max-rows`.
- (+ @o/max-rows 1)
- @o/max-rows)
- 0)})]
- (swap! current-query assoc
- :stmt stmt
- :conn conn)
- (j/query db stmt
- {:as-arrays? true
- :result-set-fn
- (fn [rs]
- (let [single-record?
- (not (next (next rs)))]
- (mapv
- #(clob-to-string-row
- % single-record?)
- rs)))}))))
- (let [result (first (j/execute! db (list sql)))
- msg (if (> result 0)
- (str "Records affected: " result)
- "Executed")]
- (when (ddl? sql)
- (invalidate-cache db))
- (list :message msg)))
- (catch SQLException e
- (list :message
- (o/unify-str "Error: " (.getMessage e))))))
-
-(defn- eval-user-sql
- "Receive raw SQL from the user, log it, divide by statements and eval them."
- [db sql & {:keys [rows-limit
- fetch-size
- append
- display-result
- result-file]}]
- (let [sql (s/trim sql)
- _ (do (o/log-sql (str sql "\n"))
- (o/clear-result-file :result-file result-file))
- [sql
- manual-separator] (if (s/starts-with? (s/lower-case sql) "delimiter")
- ;; User defined statement separator manually
- ;; before SQL expression.
- ;; Remove `delimiter` command from SQL expression.
- [(s/trim (s/replace-first sql delimiter-re ""))
- (second (re-find delimiter-re sql))]
- [sql nil])
- sql (handle-special-cases db sql)
- statement-separator-re (get-separator-re (or manual-separator ";"))
- results (doall
- (for [sql-part (filter
- ;; Remove parts contains comments only.
- (fn [part]
- (seq (s/trim
- (s/replace part comments-re ""))))
- (if (or (not (:separator db)) manual-separator)
- (s/split sql statement-separator-re)
- [sql]))]
- (let [[result-type result] (eval-sql-core :db db
- :sql sql-part
- :max-rows rows-limit
- :fetch-size fetch-size)]
- (if (= result-type :result-set)
- (o/print-table result fetch-size)
- (println result))
- [result-type result])))]
- (complete
- nil
- :start-time (:start-time @current-query)
- :status (if (or
- (every? (fn [[result-type _]]
- (= result-type :result-set))
- results)
- (not (some (fn [[result-type result]]
- (and
- (not (= result-type :result-set))
- (s/starts-with? (s/lower-case result)
- "error")))
- results)))
- :done
- (if (and
- (= (count results) 1)
- (some (fn [[_ result]]
- (.contains (s/lower-case result)
- "closed connection"))
- results))
- :terminated
- :error))
- :display-result display-result
- :result-file result-file)))
-
-(defn eval-sql-and-log-print
- "Write SQL to log file, evaluate it and print result."
- [db sql & {:keys [rows-limit
- fetch-size
- column-width-limit
- append
- start-time
- sync
- display-result
- result-file
- add-outside-borders]
- :or {append false
- sync false
- display-result true
- add-outside-borders true}}]
- (letfn [(run-query []
- (try
- (with-open [out (io/writer result-file)]
- (binding [*out* out
- o/*add-outside-borders* add-outside-borders
- *max-column-width* (or column-width-limit
- @o/column-width-limit)]
- (eval-user-sql db sql
- :rows-limit rows-limit
- :fetch-size fetch-size
- :append append
- :display-result display-result
- :result-file result-file)))
- (catch Exception e
- (complete
- (str (.getMessage e) "\n"
- (s/join "\n" (.getStackTrace e)))
- :start-time (:start-time @current-query)
- :status :error
- :display-result true
- :result-file result-file))))]
- (if sync
- (run-query)
- (swap! current-query assoc
- :runner (future (run-query))
- :start-time start-time))))
-
-(defn query-meta
- "Get metadata for `sql` result dataset."
- [db sql]
- (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)))
+++ /dev/null
-;;; deps_resolver.clj -- Discover required jar artifacts.
-
-;;; Copyright © 2020-2023 - 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.deps-resolver
- (:require
- [cemerick.pomegranate.aether :as aether]
- [leiningen.core.project :refer [default-repositories]]))
-
-(defn get-hierarchy [artifacts-list]
- (aether/dependency-hierarchy
- artifacts-list
- (aether/resolve-dependencies
- :coordinates artifacts-list
- :repositories default-repositories)))
-
-(def artifacts (atom (list)))
-
-(defn art-wanderer [art]
- (if (and
- (coll? art)
- (vector? art)
- (not (coll? (nth art 0))))
- (swap! artifacts conj art)
- (dorun (map art-wanderer art))))
-
-(defn run-wanderer [art]
- (reset! artifacts (list))
- (dorun (map art-wanderer art))
- @artifacts)
-
-(defn get-dependeces-list
- "Get artifacts dependeces hierarchy as a flatten list."
- [artifacts-list]
- (-> artifacts-list get-hierarchy run-wanderer))
-
-(defn get-dependeces-files-list
- "Resolve dependeces and return a list of all requred jar files paths.
- `artifacts-list` is a leningen dependeces vector.
- E.g. '[[com.ibm.informix/jdbc \"4.50.3\"]]."
- [artifacts-list]
- (try
- (map
- (fn [dep-file] (.getPath dep-file))
- (flatten
- (map
- aether/dependency-files
- (map
- (fn [dep] (get-hierarchy (vector dep)))
- (get-dependeces-list artifacts-list)))))
- (catch Exception _
- nil)))
+++ /dev/null
-;;; keywords.clj -- Keep database-specific keywords.
-
-;;; Copyright © 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.keywords)
-
-(def keywords
- {:sqlite
- ["ABORT" "ACTION" "ADD" "AFTER" "ALL" "ALTER" "ANALYZE" "AND" "AS" "ASC" "ATTACH"
- "AUTOINCREMENT" "BEFORE" "BEGIN" "BETWEEN" "BY" "CASCADE" "CASE" "CAST" "CHECK"
- "COLLATE" "COLUMN" "COMMIT" "CONFLICT" "CONSTRAINT" "CREATE" "CROSS" "CURRENT"
- "CURRENT_DATE" "CURRENT_TIME" "CURRENT_TIMESTAMP" "DATABASE" "DEFAULT"
- "DEFERRABLE" "DEFERRED" "DELETE" "DESC" "DETACH" "DISTINCT" "DO" "DROP" "EACH"
- "ELSE" "END" "ESCAPE" "EXCEPT" "EXCLUSIVE" "EXISTS" "EXPLAIN" "FAIL" "FILTER"
- "FOLLOWING" "FOR" "FOREIGN" "FROM" "FULL" "GLOB" "GROUP" "HAVING" "IF" "IGNORE"
- "IMMEDIATE" "IN" "INDEX" "INDEXED" "INITIALLY" "INNER" "INSERT" "INSTEAD"
- "INTERSECT" "INTO" "IS" "ISNULL" "JOIN" "KEY" "LEFT" "LIKE" "LIMIT" "MATCH"
- "NATURAL" "NO" "NOT" "NOTHING" "NOTNULL" "NULL" "OF" "OFFSET" "ON" "OR" "ORDER"
- "OUTER" "OVER" "PARTITION" "PLAN" "PRAGMA" "PRECEDING" "PRIMARY" "QUERY" "RAISE"
- "RANGE" "RECURSIVE" "REFERENCES" "REGEXP" "REINDEX" "RELEASE" "RENAME" "REPLACE"
- "RESTRICT" "RIGHT" "ROLLBACK" "ROW" "ROWS" "SAVEPOINT" "SELECT" "SET" "TABLE"
- "TEMP" "TEMPORARY" "THEN" "TO" "TRANSACTION" "TRIGGER" "UNBOUNDED" "UNION"
- "UNIQUE" "UPDATE" "USING" "VACUUM" "VALUES" "VIEW" "VIRTUAL" "WHEN" "WHERE"
- "WINDOW" "WITH" "WITHOUT"]})
+++ /dev/null
-;;; lib.clj -- Misc clojure functions for ejc-sql emacs extension.
-
-;;; Copyright © 2013-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.lib
- (:require [clojure.string :as s]
- [clojure.reflect :refer [resolve-class]]))
-
-(def ^:dynamic *max-column-width* 30)
-
-(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}}]
- (when (and elm seq)
- (if (not case-sensitive)
- (in? (mapv s/lower-case seq) (s/lower-case elm))
- (some #(= elm %) seq))))
-
-(defn get->in
- "Case insensitive `get-in` for last key in sequence."
- [obj path & {:keys [case-sensitive] :or {case-sensitive false}}]
- (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 simple-join [n s]
- (s/join
- (for [_ (range 0 n)] s)))
-
-(defn class-exists? [c]
- (resolve-class (.getContextClassLoader (Thread/currentThread)) c))
-
-(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
- "Turn an Oracle Clob into a String"
- ([clob]
- (clob-to-string clob true))
- ([clob single-record?]
- (with-open [rdr (java.io.BufferedReader. (.getCharacterStream clob))]
- (if (or single-record? (not *max-column-width*))
- (apply str (line-seq rdr))
- ;; Show only first `*max-column-width*` (30 by default) symbols
- ;; of Clob field. If longer, replace last 3 symbols by dots.
- (let [result (apply str (take (+ *max-column-width* 1)
- (mapcat seq (line-seq rdr))))]
- (if (> (count result) *max-column-width*)
- (str (subs result 0 (- *max-column-width* 3)) "...")
- result))))))
-
-(defn clob-to-string-row
- "Check all data in row if it's a CLOB and convert CLOB to string."
- [row single-record?]
- (mapv (fn [field]
- (if (is-clob? field)
- (clob-to-string field single-record?)
- field))
- row))
-
-(defn clean-sql [sql]
- (-> sql
- (s/replace #"(--).*\n" "")
- (s/replace #"( )|( \t)|\t" " ")
- (s/replace "^\n" "")
- s/trim))
-
-(def select-words
- '("SELECT"
- "SHOW"
- "WITH"
- "EXPLAIN"))
-
-(def dml-words
- (concat
- select-words
- '("INSERT"
- "UPDATE"
- "DELETE")))
-
-(def ddl-words
- '("CREATE"
- "ALTER"
- "DROP"
- "RENAME"))
-
-(defn determine-query
- "Determine if current SQL starts with one of the words from `words` list."
- [sql words]
- (let [sql (clean-sql sql)
- ignore-set #{\( \[}
- pos (loop [pos 0]
- (if (ignore-set (get sql pos))
- (recur (inc pos))
- pos))
- sql (s/upper-case (subs sql pos))]
- (first (filter (fn [w] (s/starts-with? sql w)) words))))
-
-(defn select? [sql]
- (determine-query sql select-words))
-
-(defn dml?
- "Determine if current SQL is Data Manipulation Language (DML) case."
- [sql]
- (determine-query sql dml-words))
-
-(defn ddl?
- "Determine if current SQL is Data Definition Language (DDL) case."
- [sql]
- (determine-query sql ddl-words))
+++ /dev/null
-;;; output.clj -- Output & formatting clojure functions for ejc-sql.
-
-;;; Copyright © 2013-2023 - 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
- (:require [clojure.string :as s]
- [clojure.java.io :refer [file writer]]
- [ejc-sql.lib :refer [*max-column-width* dml? simple-join windows?]])
- (:import (java.io File)
- (java.lang Character$UnicodeBlock)
- (org.apache.commons.lang3 StringUtils)
- (org.hibernate.engine.jdbc.internal BasicFormatterImpl
- DDLFormatterImpl)))
-
-(def ^:dynamic *add-outside-borders* true)
-
-(defn get-log-dir []
- (file (if windows?
- (System/getenv "AppData")
- "/var/log/")
- "ejc-sql"))
-
-(defn get-log-file [& [create-new]]
- (loop [xs (take 100 (range))]
- (when xs
- (let [prev-day (first xs)
- log-file (file
- (get-log-dir)
- (format "%s.log"
- (.format
- (new java.text.SimpleDateFormat
- "yyyy-MM-dd")
- (let [cal (java.util.Calendar/getInstance)]
- (.setTime cal (new java.util.Date))
- (.add cal java.util.Calendar/DATE
- (if prev-day (- prev-day) 0))
- (.getTime cal)))))]
- (if (or create-new (.exists log-file))
- log-file
- (recur (next xs)))))))
-
-(defn print-log-file-path []
- (print (.getAbsolutePath (or (get-log-file) (get-log-dir)))))
-
-(defn log-sql [sql]
- (let [log-file (get-log-file true)
- is-new-file (not (.exists log-file))]
- (when is-new-file
- (.mkdirs (File. (.getParent log-file)))
- (.createNewFile log-file))
- (with-open [wrtr (writer log-file :append true)]
- (when 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 fetch-size
- "Limit number of records to output."
- (atom 50))
-
-(def max-rows
- "Limit number of records to contain in ResultSet."
- (atom 99))
-
-(def show-too-many-rows-message
- "Output message in case of ResultSet is bigger than `fetch-size`."
- (atom true))
-
-(def column-width-limit
- "Limit number of chars per column to output."
- (atom 30))
-
-(defn set-fetch-size
- "Set limit for number of records to output. When nil no limit.
- Passed to the JDBC driver a hint as to the number of rows that should be
- fetched from the database when more rows are needed for ResultSet objects
- generated by a Statement."
- [val]
- (reset! fetch-size (or val 0)))
-
-(defn set-max-rows
- "Set limit for number of records to contain in ResultSet. When nil no limit.
- Sets the limit for the maximum number of rows that any ResultSet object
- generated by a Statement object can contain to the given number."
- [val]
- (reset! max-rows (or val 0)))
-
-(defn set-show-too-many-rows-message
- [val]
- (reset! show-too-many-rows-message (or val false)))
-
-(defn set-column-width-limit
- "Set limit for number of chars per column to output. When nil no limit."
- [val]
- (reset! column-width-limit val))
-
-(defn rotate-table
- "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"
- [data]
- (apply mapv vector data))
-
-(def use-unicode (atom false))
-
-(defn set-use-unicode
- "Set using unicode for grid borders."
- [val]
- (reset! use-unicode val))
-
-(defn u? [unicode-str ascii-str]
- (if @use-unicode unicode-str ascii-str))
-
-(defn print-maps
- "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 add-borders]
- (when (seq rows)
- (let [widths (map
- (fn [k]
- (apply max (count (str k))
- (map #(count (str (get % k))) rows)))
- ks)
- spacers (map #(apply str (repeat % (u? "─" "-"))) widths)
- fmts (map #(str "%-" % "s") widths)
- fmt-row (fn [leader divider trailer row]
- (str (if add-borders leader "")
- (apply str
- (interpose
- divider
- (for [[col fmt]
- (map vector (map #(get row %) ks) fmts)]
- (format fmt (str col)))))
- (if add-borders trailer "")))
- aob *add-outside-borders*]
- (println (fmt-row (if aob (u? "│ " "| ") "") (u? " │ " " | ") (if aob (u? " │" " |") "")
- (zipmap ks (map name ks))))
- (println (fmt-row (if aob (u? "├─" "|-") "") (u? "─┼─" "-+-") (if aob (u? "─┤" "-|") "")
- (zipmap ks spacers)))
- (doseq [row rows]
- (println (fmt-row (if aob (u? "│ " "| ") "") (u? " │ " " | ") (if aob (u? " │" " |") "") row))))))
- ([rows add-borders]
- (print-maps (keys (first rows)) rows add-borders)))
-
-(defn trim-max-width [x]
- (let [s (str x)]
- (if (and *max-column-width*
- (> *max-column-width* 0)
- (> (count s) *max-column-width*))
- (str (subs s 0 (- *max-column-width* 3)) "...")
- s)))
-
-(defn min-not-zero [x y]
- (min (if (> x 0) x y)
- (if (> y 0) y x)))
-
-(defn- cjk-char?
- "Return true if argument char is CJK character."
- [char]
- (= (Character$UnicodeBlock/of char)
- Character$UnicodeBlock/CJK_UNIFIED_IDEOGRAPHS))
-
-(defn- cjk-chars-count
- "Return count of CJK characters in string."
- [text]
- (count (filter cjk-char? text)))
-
-(defn- string-length
- "Return string length, given that CJK characters have a length of 2."
- [text]
- (loop [string text
- length 0]
- (if (= (count string) 0)
- length
- (recur (next string) (+ length
- (if (cjk-char? (first string)) 2 1))))))
-
-(defn print-table
- "Converts a seq of seqs to a textual table. Uses the first seq as the table
- headings and the remaining seqs as rows."
- ([rows limit]
- (when (seq rows)
- (let [row-limit (or limit (min-not-zero @max-rows @fetch-size))
- [rows msg] (if (and row-limit
- (> row-limit 0)
- ;; Since `rows` parameter contains a header
- ;; `row` 1 should be added to `row-limit`.
- (> (count rows) (+ row-limit 1)))
- [(take (+ row-limit 1) rows)
- (when @show-too-many-rows-message
- (format "Too many rows. Only %s from %s%s are shown."
- row-limit
- (min-not-zero @max-rows (- (count rows) 1))
- (if (and @max-rows
- (> @max-rows 0)
- (> (- (count rows) 1) @max-rows))
- "+" "")))]
- [rows ""])
- [headers rows] [(map name (first rows)) (rest rows)]
- aob *add-outside-borders*
- [rows rotated] (if (and (not aob)
- (= (count rows) 1)
- (> (count (first rows)) 1))
- ;; Rotatate result set table representation
- ;; if it has 1 row and many columns.
- [(rotate-table [headers (first rows)]) true]
- [rows false])
- [single-column-and-row
- cell-value] (when-let [single-cell? (and (= (count rows) 1)
- (= (count (first rows)) 1))]
- [single-cell? (ffirst rows)])
- [headers rows] (if (or rotated single-column-and-row)
- ;; Do not restrict column width if result
- ;; set has only 1 row or 1 column & 1 row.
- [headers rows]
- [(map trim-max-width headers)
- (map #(map trim-max-width %) rows)])
- rn #"(\r\n)|\n|\r"
- nl (System/getProperty "line.separator")
- rows (for [row rows]
- (map #(if (string? %)
- (if single-column-and-row
- ;; In case of only 1 column & 1 row unify
- ;; newline separators to system line break.
- (s/replace % rn nl)
- (-> %
- (s/replace rn " ")
- ;; Tabs to spaces to align columns widths.
- (s/replace #"\t" " ")))
- ;; Do not remove newline separators if result
- ;; set cell is not a string.
- %)
- row))
- widths (if single-column-and-row
- (list
- (apply max
- (cons
- (string-length (first headers))
- (if (string? cell-value)
- (map string-length (s/split cell-value rn))
- (list (string-length (str cell-value)))))))
- (for [col (rotate-table (conj rows headers))]
- (apply max (map #(string-length (str %)) col))))
- spacers (map #(apply str (repeat % (u? "─" "-"))) widths)
- ;; TODO: #(str "%" % "d") for numbers
- fmts (if (and rotated (not aob))
- ;; Remove trailing spaces for data column of single-row
- ;; result if no outer borders required.
- (list (fn [text] (let [width (- (first widths)
- (cjk-chars-count text))
- pattern (str "%-" width "s")]
- (format pattern text)))
- (fn [text] (let [pattern "%s"]
- (format pattern text))))
- (map (fn [w]
- (fn [text] (let [width (- w (cjk-chars-count text))
- pattern (str "%-" width "s")]
- (format pattern text))))
- widths))
- fmt-row (fn [leader divider trailer row]
- (str leader
- (apply str (interpose
- divider
- (for [[col fmt] (map vector row fmts)]
- (fmt (str col)))))
- trailer))]
- (when (not-empty msg)
- (println msg)
- (println))
- (when (not rotated)
- (println (fmt-row (if aob (u? "│ " "| ") "") (u? " │ " " | ") (if aob (u? " │" " |") "") headers))
- (println (fmt-row (if aob (u? "├─" "|-") "") (u? "─┼─" "-+-") (if aob (u? "─┤" "-|") "") spacers)))
- (doseq [row (if (and aob single-column-and-row (string? cell-value))
- (map list (s/split cell-value (re-pattern nl)))
- rows)]
- (println (fmt-row (if aob (u? "│ " "| ") "") (u? " │ " " | ") (if aob (u? " │" " |") "") row))))))
- ([rows] (print-table rows @fetch-size)))
-
-(defn unify-str
- "Concatenate stings, unify newline separators to the system line break."
- [& s]
- (if (empty? (filter not-empty s))
- ""
- (apply str (map #(s/replace %
- #"(\r\n)|\n|\r"
- (System/getProperty "line.separator"))
- s))))
-
-(defn format-sql [sql]
- (s/trim
- (let [sql (s/trim sql)]
- (.format (if (dml? sql)
- (BasicFormatterImpl.)
- (DDLFormatterImpl.))
- sql))))
-
-(defn format-sql-print
- "SQL should be printed to provide cross-platform newline handling."
- [sql]
- (print (format-sql sql)))
-
-(defn format-sql-if-required [sql]
- (if (> (StringUtils/countMatches sql "\n") 1)
- sql
- (format-sql sql)))
-
-(defn write-result-file [text & {:keys [result-file
- append]
- :or {append false}}]
- (spit result-file text :append append)
- result-file)
-
-(defn clear-result-file [& {:keys [result-file]}]
- (write-result-file "" :result-file result-file))
+++ /dev/null
-;;; structure.clj -- Receive database stucture and keep it in cache.
-
-;;; Copyright © 2016-2023 - 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
- (:require
- [clojure.java.jdbc :as j]
- [clojure.string :as s]
- [clojure.java.io :as io]
- [clomacs :refer [clomacs-defn]]
- [ejc-sql.lib :refer [is-clob? clob-to-string clean-sql in? get->in]]
- [ejc-sql.cache :refer [cache cache-creation-promises]]
- [ejc-sql.connect :as c]
- [ejc-sql.output :as o]
- [ejc-sql.keywords :as k]))
-
-(defn- safe-query
- "Return `sql` query result or nil in case of error."
- [db sql & {:keys [row-fn column-name]
- :or {row-fn identity}}]
- (try
- (if column-name
- [[(keyword column-name)]
- (mapv (keyword column-name)
- (row-fn (j/query db (list sql) {:as-arrays? false})))]
- (j/query db (list sql) {:as-arrays? true
- :row-fn row-fn}))
- (catch Exception _)))
-
-(defn- db->column
- "Execute `sql`, return `column-name` or first column
- (if `column-name` is not passed) of result set as result list."
- [db sql & {:keys [row-fn column-name]
- :or {row-fn identity}}]
- (when sql
- (rest (map first (safe-query db sql
- :row-fn row-fn
- :column-name column-name)))))
-
-(defn- db->>column
- "Execute `sql`, return last column of result set as result list."
- [db sql]
- (when sql
- (rest
- (map last
- (j/query db (list sql) {:as-arrays? true})))))
-
-(defn- db->value
- "Execute `sql`, return first value of first column of result set as result."
- [db sql & {:keys [row-fn]
- :or {row-fn identity}}]
- (first (db->column db sql :row-fn row-fn)))
-
-(defn get-ms-sql-server-version [ver]
- (->
- (filter not-empty (.split ver " "))
- (nth 3)
- Integer/parseInt))
-
-(defn is-modern-sql-server? [db]
- (let [ver (db->value db "SELECT @@VERSION AS 'SQL Server Version'")]
- (if (.startsWith ver "Microsoft SQL Azure")
- true
- (> (get-ms-sql-server-version ver) 2000))))
-
-(def queries
- "Database - specific queries used for obtain data about database structure."
- (let [default-queries
- {:owners (fn [& _] "
- SELECT schema_owner
- FROM information_schema.schemata ")
- :schemas (fn [& _] "
- SELECT schema_name
- FROM information_schema.schemata ")
- :tables (fn [& {:keys [schema]}]
- (format "
- SELECT table_name
- FROM information_schema.tables
- %s
- ORDER BY table_name "
- (if schema
- (format " WHERE table_schema = '%s'" schema)
- "")))
- :views (fn [& _] "
- SELECT table_name
- FROM information_schema.views ")
- :all-tables (fn [& _] "
- SELECT s.schema_owner, s.schema_name, t.table_name
- FROM information_schema.schemata AS s,
- information_schema.tables AS t
- WHERE t.table_schema = s.schema_name ")
- :columns (fn [& {:keys [table]}]
- (format "
- SELECT column_name
- FROM information_schema.columns
- WHERE UPPER(table_name) = '%s'
- ORDER BY column_name "
- (s/upper-case table)))
- :view (fn [& {:keys [entity-name]}]
- (format "
- SELECT v.view_definition
- FROM information_schema.views AS v
- WHERE UPPER(v.table_name) = '%s' "
- (s/upper-case entity-name)))}
- ;;--------
- oracle
- ;;--------
- {:entity (fn [& {:keys [entity-name]}]
- (format "
- SELECT text
- FROM all_source
- WHERE UPPER(name) = '%s' "
- (s/upper-case entity-name)))
- :entity-type (fn [& {:keys [entity-name]}]
- (format "
- SELECT object_type
- FROM all_objects
- WHERE UPPER(OBJECT_NAME) = '%s'
- AND object_type NOT IN ('SYNONYM', 'PACKAGE BODY')
- UNION
- SELECT 'PROCEDURE' FROM all_procedures
- WHERE UPPER(OBJECT_NAME) = '%s'
- AND object_type = 'PROCEDURE'
- AND rownum = 1"
- (s/upper-case entity-name)
- (s/upper-case entity-name)))
- :view (fn [& {:keys [entity-name]}]
- (format "
- SELECT text
- FROM all_views
- WHERE UPPER(view_name) = '%s' "
- (s/upper-case entity-name)))
- :types (fn [& _] "
- SELECT * FROM USER_TYPES ")
- :owners (fn [& _] "
- SELECT DISTINCT(owner)
- FROM ALL_OBJECTS
- ORDER BY owner ")
- :tables (fn [& {:keys [owner]}]
- (format "
- SELECT table_name, owner
- FROM all_tables
- %s
- ORDER BY table_name "
- (if owner
- (format " WHERE UPPER(owner) = '%s' "
- (s/upper-case owner))
- "")))
- :views (fn [& {:keys [owner]}]
- (format "
- SELECT view_name
- FROM all_views
- %s
- ORDER BY view_name "
- (if owner
- (format " WHERE UPPER(owner) = '%s' "
- (s/upper-case owner))
- "")))
- :all-tables (fn [& _] "
- SELECT owner, table_name
- FROM all_tables
- WHERE owner NOT IN ('SYS', 'SYSTEM')
- ORDER BY owner ")
- :columns (fn [& {:keys [table]}]
- (format "
- SELECT column_name
- FROM ALL_TAB_COLUMNS
- WHERE UPPER(table_name) = '%s' "
- (s/upper-case table)))
- :constraints (fn [& {:keys [owner table]}]
- (cond
- (and owner table)
- (format "
- SELECT * FROM all_constraints
- WHERE owner = '%s'
- AND table_name = '%s' "
- owner table)
- table
- (format "
- SELECT * FROM all_constraints
- WHERE table_name = '%s' " table)
- :else
- "SELECT * FROM user_constraints"))
- :procedures (fn [& {:keys [owner]}]
- (format "
- SELECT object_name, procedure_name
- FROM all_procedures
- %s " (if owner
- (format "WHERE owner = '%s' " owner)
- "")))
- :parameters (fn [& {:keys [package entity-name]}]
- (format "
- SELECT data_type, argument_name
- FROM SYS.ALL_ARGUMENTS
- WHERE object_name = '%s'
- AND in_out = 'IN'
- %s "
- (s/upper-case entity-name)
- (if package
- (format "AND package_name = '%s'" package)
- "")))
- :package (fn [& {:keys [entity-name]}]
- ;; entity-name is a package name here
- (format "
- SELECT text FROM
- (
- SELECT text AS text,
- 1 AS ordered,
- line AS line
- FROM all_source
- WHERE UPPER(name) = '%s'
- AND type = 'PACKAGE'
- UNION SELECT '\n\n', 2, 1 from dual
- UNION SELECT ' ------------------\n', 3, 1 from dual
- UNION SELECT ' -- PACKAGE BODY --\n', 4, 1 from dual
- UNION SELECT ' ------------------\n', 5, 1 from dual
- UNION SELECT '\n', 6, 1 from dual
- UNION
- SELECT text,
- 7,
- line
- FROM all_source
- WHERE UPPER(name) = '%s'
- AND type = 'PACKAGE BODY'
- )
- ORDER BY ordered, line "
- (s/upper-case entity-name)
- (s/upper-case entity-name)))
- :table (fn [& {:keys [entity-name]}]
- (format "
- SELECT dbms_metadata.get_ddl('TABLE','%s')
- FROM dual " (s/upper-case entity-name)))
- :objects (fn [& _] "
- SELECT * FROM all_objects
- WHERE object_type IN ('FUNCTION','PROCEDURE','PACKAGE') ")
- :keywords (fn [& _] "
- SELECT * FROM V$RESERVED_WORDS ORDER BY keyword ")}
- ;;--------
- informix
- ;;--------
- {:owners nil
- :tables (fn [& _] "
- SELECT TRIM(t.tabname) as tablesList
- FROM systables AS t
- WHERE t.tabtype = 'T'
- AND t.tabid >= 100
- ORDER BY t.tabname; ")
- :columns (fn [& {:keys [table]}]
- (format "
- SELECT TRIM(c.colname) AS column_name
- FROM systables AS t, syscolumns AS c
- WHERE t.tabid = c.tabid
- AND t.tabtype = 'T'
- AND t.tabid >= 100
- AND TRIM(t.tabname) = '%s'
- ORDER BY c.colno; " table))}
- ;;-------
- mysql
- ;;-------
- {:owners (fn [& _] "
- SELECT schema_name
- FROM information_schema.schemata ")
- :tables (default-queries :tables)
- :all-tables (fn [& _] "
- SELECT s.schema_name, t.table_name
- FROM information_schema.schemata AS s,
- information_schema.tables AS t
- WHERE t.table_schema = s.schema_name ")
- :columns (default-queries :columns)
- :keywords (fn [& _] "
- SELECT name FROM mysql.help_keyword")
- :entity-type (fn [& {:keys [entity-name]}]
- (format "
- SELECT routine_type
- FROM information_schema.routines
- WHERE UPPER(routine_name) = '%s'
- UNION
- SELECT 'standard-function' FROM mysql.help_topic t
- INNER JOIN mysql.help_category AS c
- ON c.help_category_id = t.help_category_id
- AND c.parent_category_id IN (SELECT help_category_id
- FROM mysql.help_category
- WHERE name = 'Functions')
- WHERE UPPER(t.name) = '%s'
- UNION
- SELECT 'table' as table_name
- FROM information_schema.tables
- WHERE UPPER(table_name) = '%s'"
- (s/upper-case entity-name)
- (s/upper-case entity-name)
- (s/upper-case entity-name)))
- :constraints (fn [& {:keys [owner table]}]
- (cond
- (and owner table)
- (format "
- SELECT column_name, constraint_name,
- referenced_column_name, referenced_table_name
- FROM information_schema.key_column_usage
- WHERE constraint_schema = '%s'
- AND table_name = '%s' "
- owner table)
- table
- (format "
- SELECT column_name, constraint_name,
- referenced_column_name, referenced_table_name
- FROM information_schema.key_column_usage
- WHERE table_name = '%s' " table)
- :else
- "SELECT * FROM information_schema.key_column_usage"))
- :procedures (fn [& _] "
- SELECT routine_schema, routine_name
- FROM information_schema.routines ")
- :procedure (fn [& {:keys [entity-name]}]
- (format "
- SHOW CREATE PROCEDURE %s "
- entity-name))
- :function (fn [& {:keys [entity-name]}]
- (format "
- SHOW CREATE FUNCTION %s "
- entity-name))
- :table (fn [& {:keys [entity-name]}]
- (format "SHOW CREATE TABLE %s " entity-name))
- :standard-function (fn [& {:keys [entity-name]}]
- (format "
- SELECT description FROM mysql.help_topic
- WHERE UPPER(name) = '%s' "
- (s/upper-case entity-name)))
- :parameters (fn [& {:keys [entity-name]}]
- (format "
- SELECT data_type, parameter_name
- FROM information_schema.parameters
- WHERE parameter_mode = 'IN'
- AND UPPER(specific_name) = '%s'"
- (s/upper-case entity-name)))}
- ;;--------
- h2
- ;;--------
- {:tables (fn [& _] ((default-queries :tables) :schema "PUBLIC"))
- :views (default-queries :views)
- :all-tables (fn [& _] "
- SELECT s.schema_owner, s.schema_name, t.table_name
- FROM information_schema.schemata AS s,
- information_schema.tables AS t
- WHERE t.table_schema = s.schema_name
- AND LCASE(s.schema_name) != 'information_schema' ")
- :columns (default-queries :columns)
- :keywords (fn [& _]
- "SELECT topic FROM information_schema.help")
- :entity-type (fn [& {:keys [entity-name]}]
- (format "
- SELECT t.table_type
- FROM information_schema.tables AS t
- WHERE UPPER(t.table_name) = '%s' "
- (s/upper-case entity-name)))
- :view (fn [& {:keys [entity-name]}]
- ((default-queries :view) :entity-name entity-name))}
- ;;--------
- sqlite
- ;;--------
- {:tables (fn [& _] "SELECT name FROM sqlite_master WHERE type='table'")
- :views (fn [& _] "SELECT name FROM sqlite_master WHERE type='view'")
- :all-tables (fn [& _] "SELECT name FROM sqlite_master WHERE type='table'")
- :columns (fn [& {:keys [table]}]
- (format "
- SELECT p.name as columnName
- FROM sqlite_master m
- LEFT OUTER JOIN pragma_table_info((m.name)) p
- ON m.name <> p.name
- WHERE m.name = '%s'
- ORDER BY columnName " table))
- :keywords (:sqlite k/keywords)
- :entity-type (fn [& {:keys [entity-name]}]
- (format "
- SELECT type FROM sqlite_master
- WHERE UPPER(name) = '%s' "
- (s/upper-case entity-name)))
- :view (fn [& {:keys [entity-name]}]
- (format "
- SELECT sql FROM sqlite_master
- WHERE UPPER(name) = '%s' "
- (s/upper-case entity-name)))}
- ;;-------
- 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]}]
- (format "
- SELECT type_desc AS constraint_type,
- name
- FROM sys.objects
- WHERE type_desc LIKE '%CONSTRAINT'
- AND OBJECT_NAME(parent_object_id)='%s' " table))
- :entity (fn [& {:keys [db entity-name]}]
- (if (is-modern-sql-server? db)
- (format "
- SELECT definition
- FROM sys.objects o
- JOIN sys.sql_modules m ON m.object_id = o.object_id
- WHERE o.object_id = object_id('%s') " entity-name)
- (format "
- SELECT c.text
- FROM sysobjects o
- JOIN syscomments c ON c.id = o.id
- WHERE o.name = '%s' " entity-name)))}
- ;;-------
- postgresql
- ;;-------
- {:procedure (fn [& {:keys [entity-name]}]
- (format "
- SELECT pg_get_functiondef(p.oid)
- FROM pg_catalog.pg_proc p
- WHERE upper(p.proname) = '%s' "
- (s/upper-case entity-name)))
- :table (fn [& {:keys [entity-name]}]
- (format "
- SELECT 'CREATE TABLE %s (\n' ||
- string_agg(column_list.column_expr, ', \n') ||
- '\n);'
- FROM (
- SELECT ' ' || column_name || ' ' || data_type ||
- coalesce('(' || character_maximum_length || ')', '') ||
- case when is_nullable = 'YES'
- then ''
- else ' NOT NULL'
- end as column_expr
- FROM information_schema.columns
- WHERE table_schema = 'public'
- AND upper(table_name) = '%s'
- ORDER BY ordinal_position) column_list"
- entity-name
- (s/upper-case entity-name)))
- :owners (default-queries :owners)
- :schemas (default-queries :schemas)
- :tables (default-queries :tables)
- :all-tables (default-queries :all-tables)
- :columns (default-queries :columns)
- :procedures (fn [& _] "
- SELECT p.proname
- FROM pg_catalog.pg_namespace n
- JOIN pg_catalog.pg_proc p
- ON p.pronamespace = n.oid
- ORDER BY proname ")
- :entity-type (fn [& {:keys [entity-name]}]
- (format "
- SELECT 'namespace'
- FROM pg_catalog.pg_namespace n
- WHERE upper(n.nspname) = '%s'
- UNION
- SELECT 'table'
- FROM information_schema.tables
- WHERE upper(table_name) = '%s'
- UNION
- SELECT 'view'
- FROM information_schema.views
- WHERE upper(table_name) = '%s'
- UNION
- SELECT 'procedure'
- FROM pg_catalog.pg_namespace n
- JOIN pg_catalog.pg_proc p
- ON p.pronamespace = n.oid
- WHERE upper(p.proname) = '%s' "
- (s/upper-case entity-name)
- (s/upper-case entity-name)
- (s/upper-case entity-name)
- (s/upper-case entity-name)))
- :parameters (fn [& {:keys [entity-name]}]
- (format "
- SELECT pg_catalog.pg_get_function_identity_arguments(
- p.oid)
- FROM pg_catalog.pg_proc p
- WHERE p.proname = '%s'" entity-name))
- :keywords (fn [& _]
- "SELECT word FROM pg_get_keywords()")}]
- {:oracle oracle
- :informix informix
- :mysql mysql
- :mariadb mysql
- :h2 h2
- :sqlite sqlite
- :sqlserver sqlserver
- :postgresql postgresql}))
-
-(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
- (if connection-uri
- (second (.split
- (let [props-list (.split connection-uri ";")]
- (first
- (filter
- (fn [prop]
- (=
- "user"
- (.toLowerCase (first (.split prop "=")))))
- props-list))) "="))
- :undefined-user)))))
-
-(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?]]
- (when (and obj (or force? (realized? obj)))
- @obj))
-
-(defn get-this-owner
- "Return current owner/schema."
- [db & [owner]]
- (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 (is-modern-sql-server? db)
- ;; 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
- "Return SQL request to obtain some database structure info."
- [db meta-type &
- {:keys [owner
- table
- package
- entity-name]}]
- (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 (when sql-receiver
- (sql-receiver :db db
- :owner owner
- :schema owner
- :table table
- :package package
- :entity-name entity-name
- :db-name (get-db-name db)))]
- sql))
-
-(defn get-namespace
- "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`"
- [db]
- (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-or-create-cache
- "Fill `cache` atom with database structure data, then get data from it.
- Parameters:
- - `db` - database connection map
- - `path` - the keys used to define the place to store data in `cache` atom
- - `sql` - query to obtain the desired data from the database
- - `force?` - when true, eval `sql` immediately and return data
- - `direct-value` - sometimes there is no need to eval `sql` to obtain some
- data,and value of this parameter, if it's defined, can be
- used as-is
- - `exec-fn` - SQL execution function (`db->column` by default)
- - `filter-fn` - filer function applied to SQL execution results
- - `handler-fn` - additional processing applied to SQL execution results."
- [& {:keys [db
- path
- sql
- force?
- direct-value
- exec-fn
- filter-fn
- handler-fn]
- :or {exec-fn db->column}}]
- (let [full-path (into [db] path)]
- (if (not (get->in @cache full-path))
- (let [flat-path [db (keyword (s/join "-" (map name path)))]
- c-promise (promise)]
- (swap! cache-creation-promises assoc-in flat-path c-promise)
- (swap! cache assoc-in full-path
- (if direct-value
- (future (deliver c-promise :ok)
- direct-value)
- (future (try
- (let [result (exec-fn db sql)
- result (distinct result)
- result (if filter-fn
- (filter filter-fn result)
- result)
- result (if handler-fn
- (mapv handler-fn result)
- result)
- result (if (vector? result)
- (sort result)
- result)]
- (deliver c-promise :ok)
- result)
- (catch Exception e
- (deliver c-promise e)
- (list))))))))
- (get? (get-in @cache full-path) force?)))
-
-(defn get-owners
- "Return owners list from cache if already received from DB,
- check if receiveing process is not running, then start it."
- [db & [force?]]
- (let [namespace (get-namespace db)]
- (if namespace
- (get-or-create-cache :db db
- :path [namespace]
- :sql (select-db-meta-script db namespace)
- :force? force?)
- ;; Schemas or owners are not applicable to this database type.
- (list))))
-
-(defn get-tables
- "Return tables list for this owner from cache if already received from DB,
- check if receiveing process is not running, then start it."
- [db & [owner_ force?]]
- (let [owner (get-this-owner db owner_)]
- (if owner_
- (get-or-create-cache :db db
- :path [:tables owner]
- :sql (select-db-meta-script db :tables :owner owner)
- :force? force?)
- (get-or-create-cache :db db
- :path [:all-tables]
- :sql (select-db-meta-script db :all-tables)
- :force? force?
- :exec-fn db->>column))))
-
-(defn get-views
- "Return views list from cache if already received from DB,
- check if receiveing process is not running, then start it."
- [db & [owner_ force?]]
- (let [owner (get-this-owner db owner_)]
- (get-or-create-cache :db db
- :path [:views owner]
- :sql (select-db-meta-script db :views :owner owner)
- :force? force?)))
-
-(defn get-colomns
- "Return colomns list for this table from cache if already received from DB,
- check if receiveing process is not running, then start it."
- [db table force?]
- (when (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 (distinct (db->column db sql)))))
- db table))))
- (get? (get->in @cache [db :colomns table])
- force?))
-
-(def postgresql-type-aliases
- "Some of PostgreSQL type aliases used for show in eldoc."
- {"character varying" "varchar"
- "bit varying" "varbit"})
-
-(defn get-parameters
- "Return parameters list of `stored-procedure` from cache if already received
- from DB, check if receiveing process is not running, then start it."
- [db package stored-procedure & [force?]]
- (let [db-type (get-db-type db)]
- (get-or-create-cache
- :db db
- :path (if package
- [:stored-procedures package stored-procedure]
- [:stored-procedures stored-procedure])
- :sql (select-db-meta-script db :parameters
- :package package
- :entity-name stored-procedure)
- :force? force?
- :exec-fn
- (case db-type
- :postgresql (fn [db sql]
- ;; Use only first possible list of parameters if many.
- (list (db->value db sql)))
- :mysql (fn [db sql]
- (list (rest (safe-query db sql))))
- :oracle (fn [db sql]
- (list
- (map
- (fn [[param-type param-name]]
- (format "%s %s" param-type param-name))
- (rest
- (safe-query db
- sql
- :row-fn identity
- :column-name nil)))))
- nil)
- :handler-fn
- (case db-type
- :postgresql (fn [types]
- (map
- (fn [type]
- (let [type (s/trim type)]
- (or (postgresql-type-aliases type)
- type)))
- (s/split types #",")))
- :mysql (fn [types]
- (map #(s/join " " %) types))
- nil))))
-
-(defn get-keywords
- "Return keywords list for this database type from cache if already received
- from DB, check if receiveing process is not running, then start it."
- [db force?]
- (when-let [keywords-query (get-in queries [(get-db-type db) :keywords])]
- (get-or-create-cache :db db
- :path [:keywords]
- :direct-value (when (vector? keywords-query)
- keywords-query)
- :sql (select-db-meta-script db :keywords)
- :force? force?
- :filter-fn #(not (nil? %)))))
-
-(defn get-packages
- "Return packages list for this owner from cache if already received from DB,
- check if receiveing process is not running, then start it."
- [db & [owner_ force?]]
- (let [owner (get-this-owner db owner_)]
- (get-or-create-cache :db db
- :path [:packages owner]
- :sql (select-db-meta-script db :procedures
- :owner owner)
- :force? force?)))
-
-(defn is-owner? [db prefix]
- (in? (get-owners db) prefix :case-sensitive false))
-
-(clomacs-defn
- complete-auto-complete
- 'ejc-complete-auto-complete
- :doc "Call Emacs auto-complete if point is the same as before loading.")
-
-(defn run-autocomplete [db buffer-name point]
- (future
- ;; Wait for all cache building promises ready.
- (mapv deref (vals (get-in @cache-creation-promises [db])))
- ;; Remove them from memory.
- (swap! cache-creation-promises assoc-in [db] nil)
- ;; Pass to Emacs a note that db structure cache ready (try to autocomplete).
- (complete-auto-complete buffer-name point)))
-
-(defn autocomplete-loading
- "Not loaded tables yet. Output pending db structure data..."
- ([db buffer-name point]
- (run-autocomplete db buffer-name point)
- (autocomplete-loading))
- ([]
- (list "t")))
-
-(defn autocomplete-result
- "Output autocomplete result."
- [result]
- (cons "nil" result))
-
-(defn autocomplete-nothing
- "Output autocomplete nothing."
- []
- (list "nil"))
-
-(defn get-owners-candidates
- "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."
- [& {:keys [db sql prefix-1 buffer-name point]}]
- (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 db buffer-name point)))))
-
-(defn get-tables-candidates
- "Return tables candidates autocomplete list."
- [& {:keys [db sql prefix-1 buffer-name point]}]
- (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 get-views-candidates
- "Return views candidates autocomplete list."
- [& {:keys [db sql prefix-1 buffer-name point]}]
- (if-let [views (if (not prefix-1)
- ;; something#
- (get-views db)
- (if (is-owner? db prefix-1)
- ;; [owner].#<views-list>
- (get-views db prefix-1)
- ;; owners still pending or
- ;; unknown?.# case
- (list)))]
- (autocomplete-result views)
- ;; pending views...
- (autocomplete-loading)))
-
-(defn get-packages-candidates
- "Return packages candidates autocomplete list."
- [& {:keys [db sql buffer-name point]}]
- (if-let [packages (get-packages db)]
- (autocomplete-result packages)
- ;; pending packages...
- (autocomplete-loading)))
-
-(defn match-alias?
- "Check if prefix (`probable-alias`) is alias for `table` in this `sql`."
- [sql owner table probable-alias]
- (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
- "Get all tables for all owners/schemas."
- [db]
- (or (get-tables db nil true)
- (flatten
- (mapv #(get-tables db % true)
- (distinct (get-owners db true))))))
-
-(def select-re
- (re-pattern (str "(?i)\\s*SELECT\\s+(.*\\s+)?FROM\\s+(\\S+)")))
-
-(defn select-sql?
- "If `sql` is SELECT query, return a table name used in FROM clause.
- Otherwise return nil."
- [sql]
- (nth (re-find select-re sql) 2))
-
-(def insert-re
- (re-pattern (str "(?i)\\s*INSERT\\s+INTO\\s+(\\S+)\\s+")))
-
-(defn insert-sql?
- "If `sql` is INSERT query, return a table name used to insert new records.
- Otherwise return nil."
- [sql]
- (second (re-find insert-re sql)))
-
-(def update-re
- (re-pattern (str "(?i)\\s*UPDATE\\s(\\S+)\\s+\n*SET.*")))
-
-(defn update-sql?
- "If `sql` is UPDATE query, return a table name used to modify the existing
- records. Otherwise return nil."
- [sql]
- (second (re-find update-re sql)))
-
-(defn get-colomns-candidates
- "Return colomns candidates autocomplete list."
- [& {:keys [db sql prefix-1 prefix-2
- buffer-name point]}]
- ;; 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 (concat
- (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)))
- (get-views 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 (select-sql? sql)
- (insert-sql? sql)
- (update-sql? sql))]
- (cond
- (and (not-empty insert-or-update-table)
- (in? tables-list insert-or-update-table
- :case-sensitive false))
- ;; SELECT # FROM table
- ;; or
- ;; 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 (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 (when 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-entity-type
- "Determine DB entity type, whether it is a `:view`, `:type`,
- `:package`, `:namespace` or `:procedure`."
- [db entity-name]
- (when-let [sql (and entity-name
- (select-db-meta-script db :entity-type
- :entity-name entity-name))]
- (when-let [found-type (db->value db sql)]
- (-> (.split found-type " ")
- first
- s/lower-case
- keyword))))
-
-(defn get-entity-type-fmt [db entity-name]
- (clomacs/format-result (get-entity-type db entity-name)))
-
-(def creation-headers
- {:oracle {:view (fn [db view]
- (format "CREATE OR REPLACE VIEW %%s\n(%s)\nAS\n%%s"
- (s/join ", "
- (map #(-> % :name s/lower-case)
- (:result
- (c/query-meta db view))))))
- :package (fn [db _] "CREATE OR REPLACE %2$s\n")}})
-
-(defn add-creation-header [db entity-type entity-name sql]
- (let [db-type (get-db-type db)]
- (if-let [header-creator (get-in creation-headers [db-type entity-type])]
- (let [header-format (header-creator db entity-name)]
- (format header-format entity-name sql))
- sql)))
-
-(defn get-entity-description
- "Get DB entity creation SQL.
- Database entity types:
- - `:table`
- - `:view`
- - `:package`
- - `:function`
- - `:procedure`
- - `:standard-function`."
- [& {:keys [db
- connection-name
- prefix
- entity-name
- result-file]}]
- (let [sql-object (or prefix entity-name)
- db-type (get-db-type db)]
- (if-let [type (get-entity-type db sql-object)]
- (if (and prefix (= :namespace type))
- ;; Omit prefix if it's a `:namespace`.
- (get-entity-description :db db
- :connection-name connection-name
- :prefix nil
- :entity-name entity-name
- :result-file result-file)
- (if-let [entity-obtainig-sql (select-db-meta-script
- db
- type
- :entity-name sql-object)]
- (if-let [entity-sql (s/join
- ""
- (db->column
- db
- entity-obtainig-sql
- :row-fn (fn [row]
- (mapv #(if (is-clob? %)
- (clob-to-string %)
- %)
- row))
- :column-name
- (case (get-db-type db)
- :mysql (case type
- :function "create function"
- :procedure "create procedure"
- :table "create table"
- nil)
- nil)))]
- (c/complete (o/unify-str
- (add-creation-header
- db
- type
- sql-object
- (o/format-sql-if-required entity-sql)))
- :mode (if (and (= type :standard-function)
- (= db-type :mysql))
- 'rst-mode
- 'sql-mode)
- :connection-name connection-name
- :db db
- :result-file result-file
- :goto-symbol (when prefix entity-name))
- (c/complete (format "Can't find %s named %s."
- (name type) sql-object)
- :result-file result-file))
- (c/complete (format (str "Script for obtaining DB entity of type %s "
- "was not added for this database type.")
- (name type))
- :result-file result-file)))
- (c/complete (format "Can't determine type of %s." sql-object)
- :result-file result-file))))
-
-(defn print-table-meta [db table-name]
- (let [result-map (c/table-meta db table-name)
- success (:success result-map)
- result-data (:result result-map)]
- (if success
- (do (println (format "Table \"%s\" description:" table-name))
- (println)
- (o/print-maps result-data true))
- (println result-data))
- success))
-
-(defn describe-table [& {:keys [db
- connection-name
- table
- owner
- result-file
- add-outside-borders]}]
- (with-open [out (io/writer result-file)]
- (binding [*out* out
- o/*add-outside-borders* add-outside-borders]
- (when (print-table-meta db (if owner (str owner "." table) table))
- (when-let [sql (select-db-meta-script db :constraints
- :owner owner
- :table table)]
- (println)
- (println "Constraints:")
- (println)
- (o/print-table (second (c/eval-sql-core :db db
- :sql sql
- :fetch-size 0
- :max-rows 0)))))))
- (c/complete
- nil
- :display-result true
- :connection-name connection-name
- :db db
- :result-file result-file))
--- /dev/null
+;;; ejc-autocomplete.el -- SQL completitions at point by auto-complete (the part of ejc-sql).
+
+;;; Copyright © 2013-2020 - 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 'auto-complete)
+(require 'ejc-completion-common)
+(require 'ejc-flx)
+
+(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-views
+ '((candidates . ejc-views-candidates)
+ (symbol . "v")
+ (requires . 1)
+ (cache . t)))
+
+(defvar ac-source-ejc-packages
+ '((candidates . ejc-packages-candidates)
+ (symbol . "p")
+ (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)))
+
+(defvar ac-source-ejc-keywords
+ '((candidates . ejc-get-keywords)
+ (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-keywords)
+ (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-views)
+ (add-to-list 'ac-sources 'ac-source-ejc-packages)
+ (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-company.el -- SQL completitions at point by company-mode (the part of ejc-sql).
+
+;;; Copyright © 2020 - 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. */
+
+;;; Commentary:
+
+;; `ejc-company' is a `company' completion backend for `ejc-sql'.
+;; To use it, add `ejc-company-backend' to `company-backends':
+
+;; (requre 'ejc-company)
+;; (push 'ejc-company-backend company-backends)
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'dash)
+(require 'company)
+(require 'ejc-completion-common)
+
+(defun ejc-company-make-candidate (candidate)
+ (let ((text (car candidate))
+ (meta (cadr candidate)))
+ (propertize text 'meta meta)))
+
+(defun ejc-company-add-meta (meta candidates)
+ (-map (lambda (k) (list k meta))
+ candidates))
+
+(defun ejc-company-candidates (prefix)
+ (let* ((prefix-1 (ejc-get-prefix-word))
+ (prefix-2 (save-excursion
+ (search-backward "." nil t)
+ (ejc-get-prefix-word)))
+ (res))
+ (dolist (item
+ (cl-remove-if-not
+ (lambda (c) (string-prefix-p prefix (car c) t))
+ (append
+ (ejc-append-without-duplicates
+ (ejc-company-add-meta
+ "ansi sql" (ejc-get-ansi-sql-words))
+ (ejc-company-add-meta
+ "keyword" (ejc-get-keywords))
+ 'car :right)
+ (ejc-company-add-meta
+ "owner" (ejc-owners-candidates))
+ (ejc-company-add-meta
+ "table" (ejc-tables-candidates))
+ (ejc-company-add-meta
+ "view" (ejc-views-candidates))
+ (if (not prefix-1)
+ (ejc-company-add-meta
+ "package" (ejc-packages-candidates)))
+ (ejc-company-add-meta
+ "column" (ejc-colomns-candidates)))))
+ (push (ejc-company-make-candidate item) res))
+ res))
+
+(defun ejc-company-annotation (candidate)
+ (format " %s" (get-text-property 0 'meta candidate)))
+
+(defun ejc-company-doc-buffer (candidate)
+ (company-doc-buffer (ac-ejc-documentation candidate)))
+
+(defun ejc-company-backend (command &optional arg &rest ignored)
+ (interactive (list 'interactive))
+ (cl-case command
+ (interactive (company-begin-backend 'ejc-company-backend))
+ (prefix (and (bound-and-true-p ejc-sql-mode)
+ (company-grab-symbol)))
+ (candidates (ejc-company-candidates arg))
+ (doc-buffer (ejc-company-doc-buffer arg))
+ (annotation (ejc-company-annotation arg))))
+
+(provide 'ejc-company)
+
+;;; ejc-company.el ends here
--- /dev/null
+;;; ejc-completion-common.el -- SQL completitions common functionality (the part of ejc-sql).
+
+;;; Copyright © 2020 - 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 'ejc-interaction)
+(require 'ejc-doc)
+
+(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)
+
+(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" "between"))
+
+(defvar ejc-auxulary-sql-words
+ '("show" "errors" "desc" "count" "type" "table" "function" "procedure"
+ "begin" "end" "for" "return"))
+
+(defcustom ejc-complete-on-dot nil
+ "When t automatically start completion after inserting a dot for
+`company-mode' despite `company-minimum-prefix-length' is bigger than 0."
+ :type 'boolean
+ :safe #'booleanp
+ :group 'ejc-sql)
+
+(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-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))))
+
+(defun ejc-get-ansi-sql-words ()
+ "Get ANSI SQL keywords."
+ (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 ejc-get-keywords ()
+ "Get DB-specific keywords."
+ (if (ejc-buffer-connected-p)
+ (unless (or (ejc-return-point) (ejc-get-prefix-word))
+ (if ejc-candidates-uppercase
+ (mapcar 'upcase (ejc-get-keywords-inner ejc-db nil))
+ (mapcar 'downcase (ejc-get-keywords-inner ejc-db nil))))))
+
+(cl-defun ejc-complete-auto-complete (buffer-name point)
+ "Called by Clojure side when db structure cache creation process completes.
+When the user typed some chars, the request for autocompletion is passed to
+Clojure side. If Clojure side has the database structure cache, autocompletion
+variants returned immediately. If not, the database structure cache creation
+process starts. It's async, so the process of Emacs is not blocked and the
+user can move point (cursor), edit SQL and so on. After Clojure side cache
+creation process finishes, it calls this `ejc-complete-auto-complete'
+function. If the user waits for autocompletion and doesn't move point
+(cursor) during this process, he will get autocompletion variants."
+ (switch-to-buffer buffer-name)
+ (if (equal point (point))
+ (cond ((bound-and-true-p auto-complete-mode) (auto-complete))
+ ((bound-and-true-p company-mode) (company-complete))))
+ 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
+ :db ejc-db
+ :sql (apply
+ 'buffer-substring
+ (ejc-get-sql-boundaries-at-point))
+ :prefix-1 prefix-1
+ :prefix-2 prefix-2
+ :buffer-name (buffer-name)
+ :point (point)))
+ (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-views-candidates ()
+ (ejc-candidates 'ejc-get-views-candidates))
+
+;;;###autoload
+(defun ejc-packages-candidates ()
+ (ejc-candidates 'ejc-get-packages-candidates))
+
+;;;###autoload
+(defun ejc-colomns-candidates ()
+ (ejc-candidates 'ejc-get-colomns-candidates))
+
+(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))
+
+(defun ejc-dot-pressed ()
+ (interactive)
+ (insert ".")
+ (if (and ejc-complete-on-dot (bound-and-true-p company-mode))
+ (call-interactively 'company-complete)))
+
+(provide 'ejc-completion-common)
+
+;;; ejc-completion-common.el ends here
--- /dev/null
+;;; ejc-doc.el -- SQL quick hints documentation (the part of ejc-sql).
+
+;;; Copyright © 2018-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 'dash)
+
+(defconst ejc-sql-doc (make-hash-table :test 'eq))
+
+(defun ejc-fill-doc (hash-const &rest args)
+ (-reduce (lambda (key val)
+ (puthash key val hash-const))
+ args))
+
+(defvar ejc-doc-created-p nil)
+
+(defun ejc-create-doc ()
+ (ejc-fill-doc
+ ejc-sql-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>;"
+ 'distinct
+ "Return different values")
+ (setq ejc-doc-created-p t))
+
+(provide 'ejc-doc)
+
+;;; ejc-doc.el ends here
--- /dev/null
+;;; ejc-eldoc.el -- ejc-sql eldoc support (the part of ejc-sql).
+
+;;; Copyright (C) 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 'dash)
+(require 'eldoc)
+(require 'ejc-format)
+
+(defun ejc-replace-property-mark (text fmt face)
+ (while (string-match fmt text)
+ (let ((beg (match-beginning 0))
+ (end (match-end 0)))
+ (setq text (concat (substring text 0 beg)
+ (substring text (1+ beg))))
+ (add-face-text-property beg (1- end) face t text)))
+ text)
+
+(defun ejc-propertize (text)
+ (-> text
+ (ejc-replace-property-mark "\\@\\(\\w+_?\\)+"
+ 'font-lock-function-name-face)
+ (ejc-replace-property-mark "\\%\\(\\w+_?\\)+"
+ 'font-lock-keyword-face)
+ (ejc-replace-property-mark "\\#\\(\\w+_?\\)+"
+ 'eldoc-highlight-function-argument)))
+
+(defconst ejc-sql-expressions
+ (list
+ "SELECT"
+ "%SELECT #field... %FROM table [%WHERE predicate]"
+ "FROM"
+ "%SELECT field... %FROM #table [%WHERE predicate]"
+ "WHERE"
+ "%WHERE #predicate [%OR predicate] [%AND predicate]"))
+
+(defun ejc-get-procedure-before-point ()
+ "Return stored procedure name before the point."
+ (interactive)
+ (save-excursion
+ (goto-char (nth 1 (syntax-ppss)))
+ (thing-at-point 'symbol)))
+
+(defun ejc-get-package-before-point ()
+ "Return package name of stored procedure before the point."
+ (interactive)
+ (save-excursion
+ (goto-char (nth 1 (syntax-ppss)))
+ (beginning-of-thing 'symbol)
+ (when (equal (string (char-before)) ".")
+ (left-char)
+ (thing-at-point 'symbol))))
+
+(defun ejc-get-parameter-index ()
+ "Return parameter number around the point."
+ (interactive)
+ (let ((index 0)
+ (ch (string (preceding-char))))
+ (save-excursion
+ (while (nth 2 (syntax-ppss))
+ (let ((pss (nth 2 (syntax-ppss))))
+ (when (member ch (list " " "\t" "\n" ","))
+ (setq index (1+ index))
+ (setq ch nil))
+ (goto-char pss)
+ (setq index (1+ index)))))
+ (max (1- index) 0)))
+
+(defun ejc-get-word-before-point ()
+ "Return SQL word before the point."
+ (interactive)
+ (save-excursion
+ (if (not (member (string (preceding-char)) (list " " "\t" "\n")))
+ (forward-same-syntax -1))
+ (goto-char (nth 2 (syntax-ppss)))
+ (thing-at-point 'symbol)))
+
+(defun ejc-eldoc-function ()
+ "Returns a doc string appropriate for the current context, or nil."
+ (if-let ((stored-procedure (if (ejc-buffer-connected-p)
+ (condition-case nil
+ (ejc-get-procedure-before-point)
+ (error nil)))))
+ (let ((type (ejc-get-entity-type ejc-db stored-procedure))
+ (package (ejc-get-package-before-point)))
+ (if (or (eq type :procedure)
+ (eq type :function))
+ (let ((params (car (ejc-get-parameters ejc-db
+ package
+ stored-procedure
+ t)))
+ (p-index (ejc-get-parameter-index)))
+ (ejc-propertize
+ (format "@%s: (%s)"
+ stored-procedure
+ (string-join
+ (-map
+ (lambda (p) (if (eql (cdr p) p-index)
+ (ejc-split-and-join
+ (lambda (s) (concat "#" s ))
+ " ")
+ (car p)))
+ (-zip params
+ (number-sequence 0 (1- (length params)))))
+ ", "))))))
+ (if-let ((sql-word (condition-case nil
+ (ejc-get-word-before-point)
+ (error nil))))
+ (if-let ((sql-expression (lax-plist-get
+ ejc-sql-expressions
+ sql-word)))
+ (ejc-propertize sql-expression)))))
+
+;;;###autoload
+(defun ejc-eldoc-setup ()
+ "Set up eldoc function and enable eldoc-mode."
+ (interactive)
+ (cond
+ ((boundp 'eldoc-documentation-strategy)
+ (setq-local eldoc-documentation-strategy #'ejc-eldoc-function))
+ ((boundp 'eldoc-documentation-functions)
+ (add-hook 'eldoc-documentation-functions #'ejc-eldoc-function nil t))
+ (t (setq-local eldoc-documentation-function #'ejc-eldoc-function)))
+ (eldoc-mode +1))
+
+(provide 'ejc-eldoc)
+
+;;; ejc-eldoc.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-2024 - 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)
+(require 'ejc-result-buffer)
+
+(defvar ejc-sql-separator "/"
+ "The char with purpose to separate the SQL statement both other.")
+
+(defun ejc-sql-separator-re ()
+ (format "^\\s-*%s\\(\\s-+\\|\n\\)" (or (alist-get :separator ejc-db)
+ 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
+ (when (and (characterp (char-after))
+ (or (equal (string (char-after)) " ")
+ (equal (string (char-after)) "\n")))
+ (forward-char 1))
+ (if (re-search-backward (ejc-sql-separator-re) nil t nil)
+ (re-search-forward (ejc-sql-separator-re) nil t nil)
+ (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)
+ (re-search-backward (ejc-sql-separator-re) nil t nil)
+ (end-of-buffer))
+ (if (equal (string (preceding-char)) "\n")
+ (backward-char 1))
+ (let ((sep-len (length ejc-sql-separator)))
+ (if (equal (buffer-substring (max (point-min) (- (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)
+ (if (equal (buffer-name) ejc-results-buffer-name)
+ (ejc-show-next-result)
+ (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)
+ (if (equal (buffer-name) ejc-results-buffer-name)
+ (ejc-show-prev-result)
+ (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)))
+
+(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)))
+
+(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 (arg)
+ "Format SQL bounded by the `ejc-sql-separator' or/and buffer
+boundaries."
+ (interactive "P")
+ (save-excursion
+ (ejc--in-sql-boundaries
+ beg end
+ (if arg
+ (ejc-format-sql beg end)
+ (let ((result (ejc-format-by-hibernate
+ (buffer-substring beg end))))
+ (delete-region beg end)
+ (insert result)))
+ (when (equal (char-before beg)
+ (string-to-char ejc-sql-separator))
+ (goto-char beg)
+ (insert "\n")))
+ (ejc-flash-this-sql)))
+
+(defun ejc-format-sql-region (beg end)
+ "Pretty-print SQL bounded by the selection area."
+ (interactive "r")
+ (let ((result (ejc-format-by-hibernate (buffer-substring beg end))))
+ (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)
+ (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-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))))
+
+(provide 'ejc-format)
+
+;;; ejc-format.el ends here
--- /dev/null
+;;; ejc-interaction.el -- ejc-sql interact with Clojure. -*- lexical-binding: t -*-
+
+;;; Copyright © 2013-2020 - 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 '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 ejc-sql.classpath)
+
+(clomacs-defun ejc-require
+ clojure.core/require
+ :lib-name "ejc-sql")
+
+(clomacs-defun ejc-import
+ clojure.core/import
+ :lib-name "ejc-sql")
+
+(clomacs-defun ejc-class-for-name
+ Class/forName
+ :lib-name "ejc-sql")
+
+(clomacs-defun ejc-get-dependeces-files-list
+ get-dependeces-files-list
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.deps-resolver
+ :return-type :list)
+
+(clomacs-defun ejc-resolve-dependencies
+ resolve-dependencies
+ :lib-name "ejc-sql"
+ :namespace cemerick.pomegranate.aether)
+
+(defun ejc-connect-to-db (conn-struct)
+ (let* ((jars-to-load
+ (if-let (dependencies (alist-get :dependencies conn-struct))
+ ;; Resolve dependencies and prepare jars paths list to load.
+ (ejc-get-dependeces-files-list dependencies)
+ (let* ((classpath (alist-get :classpath conn-struct))
+ (dependency-jars (-map
+ (lambda (jar-path)
+ (ejc-get-dependeces-files-list
+ (ejc-path-to-lein-artifact jar-path)))
+ classpath)))
+ ;; Join jar files paths from `:classpath' vector of
+ ;; `ejc-create-connection' and dependencies for this jars.
+ (delq nil
+ (delete-dups
+ (append
+ (-flatten dependency-jars)
+ (append classpath nil))))))))
+ (-map 'ejc-add-classpath jars-to-load))
+ (when-let ((classname (alist-get :classname conn-struct)))
+ (ejc-class-for-name classname)
+ (ejc-import (read classname)))
+ (ejc-sql-set-db conn-struct))
+
+(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--describe-table
+ describe-table
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.structure)
+
+(clomacs-defun ejc-get-entity-type
+ get-entity-type-fmt
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.structure
+ :return-type :eval)
+
+(clomacs-defun ejc-get-parameters
+ get-parameters
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.structure
+ :return-type :list)
+
+(clomacs-defun ejc-get-entity-description
+ get-entity-description
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.structure)
+
+(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-format-by-hibernate
+ format-sql-print
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.output
+ :return-value :stdout)
+
+(clomacs-defun ejc-set-fetch-size
+ set-fetch-size
+ :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-set-show-too-many-rows-message
+ set-show-too-many-rows-message
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.output
+ :doc (concat "Show 'Too many rows...' message in case"
+ "of ResultSet is bigger than `fetch-size'."))
+
+(clomacs-defun ejc-set-max-rows
+ set-max-rows
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.output
+ :doc (concat "Set limit for number of records to contain "
+ "in ResultSet. When nil no limit."))
+
+(clomacs-defun ejc-set-column-width-limit
+ set-column-width-limit
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.output
+ :doc (concat "Set limit for number of chars per column to "
+ "output to output. When nil no limit."))
+
+(clomacs-defun ejc-set-use-unicode
+ set-use-unicode
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.output
+ :doc "Set using unicode for grid borders.")
+
+(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-views-candidates
+ get-views-candidates
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.structure
+ :return-type :list)
+
+(clomacs-defun ejc-get-packages-candidates
+ get-packages-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-get-keywords-inner
+ get-keywords
+ :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.cache
+ :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 :eval)
+
+(defun ejc-invalidate-cache ()
+ "Clean current connection cache (database owners and tables list)."
+ (interactive)
+ (ejc-invalidate-cache-inner ejc-db))
+
+(clomacs-defun ejc-output-cache
+ output-cache
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.cache
+ :return-type :eval)
+
+(defun ejc-print-cache ()
+ "Print current database connection cache when run from connected SQL buffer.
+Print all connections cache otherwise."
+ (interactive)
+ (pprint (ejc-output-cache ejc-db)))
+
+(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)
+
+(clomacs-defun ejc-get-this-owner
+ get-this-owner
+ :lib-name "ejc-sql"
+ :namespace ejc-sql.structure)
+
+(defun ejc-unset-mode-name ()
+ (if (derived-mode-p 'org-mode)
+ (setq mode-name "Org")
+ (if (derived-mode-p 'sql-mode)
+ (setq mode-name "SQL"))))
+
+(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)
+ (ejc-unset-mode-name)
+ (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-2023 - 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 's)
+(require 'dash)
+(require 'sql)
+
+(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-lein-artifact-to-path (artifact)
+ "Get ~/.m2 jar file path of artifact."
+ (if (not (vectorp artifact))
+ (error
+ "Expect leiningen artifact, e.g. [com.h2database/h2 \"1.4.199\"]."))
+ (let* ((group (car (split-string
+ (ejc-strip-text-properties (symbol-name (elt artifact 0)))
+ "/")))
+ (name (or (cadr (split-string
+ (ejc-strip-text-properties
+ (symbol-name (elt artifact 0))) "/"))
+ group))
+ (version (elt artifact 1)))
+ (format "~/.m2/repository/%s/%s/%s/%s-%s.jar"
+ (mapconcat 'identity (split-string group "\\.") "/")
+ name
+ version
+ name
+ version)))
+
+(defun ejc-path-to-lein-artifact (path)
+ "Get leiningen artifact from ~/.m2 jar file path."
+ (if (not (stringp path))
+ (error
+ "Expect jar file path."))
+ (let* ((path (s-replace "\\" "/" path))
+ (path (nth 1 (s-split ".m2/repository/" path)))
+ (path-elements (s-split "/" path))
+ (version (nth (- (length path-elements) 2) path-elements))
+ (name (nth (- (length path-elements) 3) path-elements))
+ (group (s-join "." (-> path-elements -butlast -butlast -butlast))))
+ (read
+ (format "[[%s/%s \"%s\"]]"
+ group
+ name
+ version))))
+
+(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)
+
+(defvar ejc-product-assoc
+ '((sqlserver . ms)
+ (oracle:sid . oracle)))
+
+(defun ejc-get-product-name (db)
+ "Get database type from db connection info."
+ (let ((product-name (or (alist-get :subprotocol db)
+ (alist-get :dbtype db))))
+ (or (cdr (assoc-string product-name ejc-product-assoc))
+ (car (assoc-string product-name sql-product-alist))
+ 'ansi)))
+
+(defun ejc-ensure-file-directory-exists (file-path)
+ (let ((dir (file-name-directory file-path)))
+ (if (not (file-accessible-directory-p dir))
+ (make-directory dir))))
+
+(defun ejc-save-to-file (file-path data)
+ "Save Elisp variable DATA to FILE-PATH."
+ (ejc-ensure-file-directory-exists file-path)
+ (with-temp-file file-path
+ (prin1 data (current-buffer))))
+
+(cl-defun ejc-load-from-file (file-path &key default check)
+ "Read Elisp variable from FILE-PATH."
+ (ejc-ensure-file-directory-exists file-path)
+ (condition-case nil
+ (with-temp-buffer
+ (insert-file-contents file-path)
+ (let ((value (read (current-buffer))))
+ (if (and check (funcall check value))
+ value
+ (error "File contents don't match function check."))))
+ (error (ejc-save-to-file file-path default)
+ default)))
+
+(defun ejc-plist-p (lst)
+ "Check if LST is a plist."
+ (condition-case nil
+ (progn
+ (lax-plist-get lst nil)
+ t)
+ (error nil)))
+
+(defun ejc-flatten-index (imenu-index)
+ "Flatten imenu index into a plain list.
+IMENU-INDEX - imenu index tree."
+ (-mapcat
+ (lambda (x)
+ (if (imenu--subalist-p x)
+ (mapcar (lambda (y) (cons (car y) (cdr y)))
+ (ejc-flatten-index (cdr x)))
+ (list x)))
+ imenu-index))
+
+(defun ejc-split-and-join (fn split &optional join)
+ "Split string by SPLIT, apply FN to each substring, than join by JOIN."
+ (let ((join (or join split)))
+ (string-join
+ (-map fn (split-string (car p) split))
+ join)))
+
+(defun ejc-not-nil-str (s)
+ (not (equal s "nil")))
+
+(defun ejc-append-without-duplicates (list-left list-right comparator lead)
+ "Unite LIST-LEFT and LIST-RIGHT without duplicates items.
+Check items equality by COMPARATOR function.
+In case if some item presents in both lists (in terms of COMPARATOR
+equality) get the item from LIST-LEFT if LEAD param is `:left'or
+get it from LIST-RIGHT if LEAD param is `:right'."
+ (let* ((a (if (eq lead :left) list-left list-right))
+ (b (if (eq lead :left) list-right list-left))
+ (a-results (-map comparator a)))
+ (append a
+ (-filter
+ (lambda (b-item)
+ (not (-contains-p a-results
+ (funcall comparator b-item))))
+ b))))
+
+(provide 'ejc-lib)
+
+;;; ejc-lib.el ends here
--- /dev/null
+;;; ejc-result-buffer.el
+
+;;; Copyright © 2019-2020 - 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-result-mode)
+
+(defvar ejc-results-buffer nil
+ "The results buffer.")
+
+(defvar ejc-results-buffer-name "*ejc-sql-output*"
+ "The results buffer name.")
+
+(defvar ejc-result-file-template "ejc-sql-result-%d.txt"
+ "SQL evaluation results file name template.")
+
+(defvar ejc-result-file-path nil
+ "The current result file path. Refreshed by any finished SQL evaluation.")
+
+(defcustom ejc-results-path temporary-file-directory
+ "SQL evaluation result files location."
+ :group 'ejc-sql
+ :type 'string)
+
+(defcustom ejc-ring-length 10
+ "The number of SQL evaluation results to keep."
+ :group 'ejc-sql
+ :type 'integer)
+
+(defcustom ejc-show-result-bottom nil
+ "When t show result output buffer in the bottom window."
+ :group 'ejc-sql
+ :type 'boolean)
+
+(defvar ejc-ring-position 0
+ "Current SQL evaluation result position in ring.")
+
+(defvar ejc-modes-ring (list)
+ "List of SQL evaluation result modes.")
+
+(defcustom ejc-modes-ring-file (expand-file-name
+ "ejc-modes-ring.el"
+ ejc-results-path)
+ "Previous SQL evaluation result modes file location."
+ :group 'ejc-sql
+ :type 'string)
+
+(defun ejc-update-modes-ring (mode)
+ "Update SQL evaluation result modes list, persist it in `ejc-modes-ring-file'."
+ (setf (alist-get ejc-ring-position ejc-modes-ring) mode)
+ (ejc-save-to-file ejc-modes-ring-file ejc-modes-ring))
+
+(defun ejc-load-modes-ring ()
+ "Load SQL evaluation result modes list `ejc-modes-ring' var."
+ (setq ejc-modes-ring
+ (ejc-load-from-file ejc-modes-ring-file :default (list))))
+
+(defun ejc-get-result-file-path ()
+ "Get current SQL evaluation result file path."
+ (expand-file-name (format ejc-result-file-template ejc-ring-position)
+ ejc-results-path))
+
+(defun ejc-inc-ring-position ()
+ (setq ejc-ring-position (1+ ejc-ring-position)
+ ejc-ring-position (if (>= ejc-ring-position ejc-ring-length)
+ 0
+ ejc-ring-position)))
+
+(defun ejc-dec-ring-position ()
+ (setq ejc-ring-position (1- ejc-ring-position)
+ ejc-ring-position (if (< ejc-ring-position 0)
+ (1- ejc-ring-length)
+ ejc-ring-position)))
+
+(defun ejc-iterate-ring (inc-or-dec &optional should-exist)
+ (funcall inc-or-dec)
+ (if should-exist
+ (let ((idx 0))
+ (while (and (not (file-exists-p (ejc-get-result-file-path)))
+ (if (< idx ejc-ring-length)
+ t
+ (progn
+ (setq ejc-ring-position 0)
+ nil)))
+ (setq idx (1+ idx))
+ (funcall inc-or-dec))))
+ (setq ejc-result-file-path (ejc-get-result-file-path)))
+
+(defun ejc-next-result-file-path (&optional should-exist)
+ (ejc-iterate-ring 'ejc-inc-ring-position should-exist))
+
+(defun ejc-prev-result-file-path (&optional should-exist)
+ (ejc-iterate-ring 'ejc-dec-ring-position should-exist))
+
+(defun ejc-get-output-buffer ()
+ "Get or create buffer for output SQL evaluation results.
+It can be result sets, record affected messages, SQL definition of entities
+or error messages."
+ (when (not (and ejc-results-buffer
+ (buffer-live-p ejc-results-buffer)))
+ (setq ejc-results-buffer (get-buffer-create
+ ejc-results-buffer-name))
+ (with-current-buffer ejc-results-buffer
+ (ejc-result-mode)))
+ (with-current-buffer ejc-results-buffer
+ ;; Clear undo history
+ (setq buffer-undo-list nil))
+ ejc-results-buffer)
+
+(defun ejc-output-mode-specific-customization ()
+ (cl-case ejc-result-table-impl
+ (orgtbl-mode (when (org-table-p) (org-table-align)))
+ (ejc-result-mode (read-only-mode 1))))
+
+(defun ejc-show-result-buffer (output-buffer)
+ (if ejc-show-result-bottom
+ (display-buffer output-buffer '(display-buffer-at-bottom . ()))
+ (display-buffer output-buffer)))
+
+;;;###autoload
+(cl-defun ejc-show-last-result (&key result
+ mode
+ connection-name
+ db
+ goto-symbol)
+ "Popup buffer with last SQL execution result output."
+ (interactive)
+ (let ((output-buffer (ejc-get-output-buffer)))
+ (with-current-buffer output-buffer
+ (read-only-mode -1)
+ (erase-buffer)
+ (when mode
+ (ejc-update-modes-ring mode)
+ (funcall mode))
+ (ejc-add-connection connection-name db)
+ (if result
+ ;; SQL evaluation result passed directly to fn
+ (insert result)
+ ;; SQL evaluation result rendered to file
+ (insert-file-contents (ejc-get-result-file-path)))
+ (ejc-output-mode-specific-customization)
+ (beginning-of-buffer)
+ (let* ((window (or (get-buffer-window output-buffer t)
+ (progn
+ (ejc-show-result-buffer output-buffer)
+ (get-buffer-window output-buffer t))))
+ (frame (window-frame window)))
+ (if (not (eq frame (selected-frame)))
+ (make-frame-visible frame))
+ (if goto-symbol
+ ;; Reversed, since if the result buffer is a package, it can
+ ;; contain 2 concatenated parts: header and implementation.
+ ;; Assume user wants to locate a point (cursor) in
+ ;; procedure implementation.
+ (if-let* ((items-list (reverse (delq imenu--rescan-item
+ (ejc-flatten-index
+ (condition-case nil
+ (imenu--make-index-alist)
+ (error nil))))))
+ ;; Find symbol position (typically to locate the
+ ;; beginning of procedure implementation in the package).
+ (pos (alist-get goto-symbol items-list nil nil 'equal)))
+ (set-window-point window pos)))))))
+
+(cl-defun ejc-show-ring-result (prev-or-next)
+ (let ((output-buffer (ejc-get-output-buffer)))
+ (set-buffer output-buffer)
+ (read-only-mode -1)
+ (erase-buffer)
+ (ejc-add-connection ejc-connection-name ejc-db)
+ (let ((file-path (funcall prev-or-next t))
+ (mode (alist-get ejc-ring-position (or ejc-modes-ring
+ (ejc-load-modes-ring)))))
+ (if mode
+ (funcall mode))
+ (insert-file-contents file-path)
+ (ejc-output-mode-specific-customization)
+ (beginning-of-buffer)
+ (ejc-show-result-buffer output-buffer)
+ (message file-path))))
+
+;;;###autoload
+(cl-defun ejc-show-prev-result ()
+ "Change `ejc-results-buffer' contents: show previous SQL evaluation result."
+ (interactive)
+ (ejc-show-ring-result 'ejc-prev-result-file-path))
+
+;;;###autoload
+(cl-defun ejc-show-next-result ()
+ "Change `ejc-results-buffer' contents: show next SQL evaluation result."
+ (interactive)
+ (ejc-show-ring-result 'ejc-next-result-file-path))
+
+(provide 'ejc-result-buffer)
+
+;;; ejc-result-buffer.el ends here
--- /dev/null
+;;; ejc-result-mode.el
+
+;;; Copyright © 2017-2020 - 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)
+ ("│" . 'ejc-result-table-borders-face)
+ ("─" . 'ejc-result-table-borders-face)
+ ("┼" . 'ejc-result-table-borders-face)))
+
+(defvar ejc-result-mode-hook nil
+ "Functions to be called when `ejc-result-mode' is entered.")
+
+(defun ejc-result-mode ()
+ (interactive)
+ (kill-all-local-variables)
+ (setq truncate-lines t)
+ (setq major-mode 'ejc-result-mode
+ mode-name "SQL-Result")
+ (cl-case ejc-result-table-impl
+ (orgtbl-mode (orgtbl-mode 1))
+ (ejc-result-mode (setq view-read-only t)))
+ (setq font-lock-defaults '(ejc-result-font-lock-keywords))
+ (run-hooks 'ejc-result-mode-hook))
+
+(provide 'ejc-result-mode)
+
+;;; ejc-result-mode.el ends here
--- /dev/null
+;;; ejc-sql-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*-
+;; Generated by the `loaddefs-generate' function.
+
+;; This file is part of GNU Emacs.
+
+;;; Code:
+
+(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path)))
+
+
+\f
+;;; Generated autoloads from ejc-autocomplete.el
+
+(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#" t)
+(register-definition-prefixes "ejc-autocomplete" '("ac-source-ejc-" "ejc-ac-hook"))
+
+\f
+;;; Generated autoloads from ejc-company.el
+
+(register-definition-prefixes "ejc-company" '("ejc-company-"))
+
+\f
+;;; Generated autoloads from ejc-completion-common.el
+
+(autoload 'ejc-owners-candidates "ejc-completion-common")
+(autoload 'ejc-tables-candidates "ejc-completion-common")
+(autoload 'ejc-views-candidates "ejc-completion-common")
+(autoload 'ejc-packages-candidates "ejc-completion-common")
+(autoload 'ejc-colomns-candidates "ejc-completion-common")
+(register-definition-prefixes "ejc-completion-common" '("ac-ejc-documentation" "ejc-"))
+
+\f
+;;; Generated autoloads from ejc-doc.el
+
+(register-definition-prefixes "ejc-doc" '("ejc-"))
+
+\f
+;;; Generated autoloads from ejc-eldoc.el
+
+(autoload 'ejc-eldoc-setup "ejc-eldoc" "\
+Set up eldoc function and enable eldoc-mode." t)
+(register-definition-prefixes "ejc-eldoc" '("ejc-"))
+
+\f
+;;; Generated autoloads from ejc-flx.el
+
+(register-definition-prefixes "ejc-flx" '("ejc-"))
+
+\f
+;;; Generated autoloads from ejc-format.el
+
+(register-definition-prefixes "ejc-format" '("ejc-"))
+
+\f
+;;; Generated autoloads from ejc-interaction.el
+
+(register-definition-prefixes "ejc-interaction" '("ejc-"))
+
+\f
+;;; Generated autoloads from ejc-lib.el
+
+(register-definition-prefixes "ejc-lib" '("ejc-"))
+
+\f
+;;; Generated autoloads from ejc-result-buffer.el
+
+(autoload 'ejc-show-last-result "ejc-result-buffer" "\
+Popup buffer with last SQL execution result output.
+
+(fn &key RESULT MODE CONNECTION-NAME DB GOTO-SYMBOL)" t)
+(autoload 'ejc-show-prev-result "ejc-result-buffer" "\
+Change `ejc-results-buffer' contents: show previous SQL evaluation result." t)
+(autoload 'ejc-show-next-result "ejc-result-buffer" "\
+Change `ejc-results-buffer' contents: show next SQL evaluation result." t)
+(register-definition-prefixes "ejc-result-buffer" '("ejc-"))
+
+\f
+;;; Generated autoloads from ejc-result-mode.el
+
+(register-definition-prefixes "ejc-result-mode" '("ejc-result-"))
+
+\f
+;;; Generated autoloads from ejc-sql.el
+
+(autoload 'ejc-sql-mode "ejc-sql" "\
+Toggle ejc-sql mode.
+
+This is a minor mode. If called interactively, toggle the `ejc-Sql
+mode' mode. If the prefix argument is positive, enable the mode, and if
+it is zero or negative, disable the mode.
+
+If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
+mode if ARG is nil, omitted, or is a positive number. Disable the mode
+if ARG is a negative number.
+
+To check whether the minor mode is enabled in the current buffer,
+evaluate the variable `ejc-sql-mode'.
+
+The mode's hook is called both when the mode is enabled and when it is
+disabled.
+
+(fn &optional ARG)" t)
+(autoload 'ejc-create-menu "ejc-sql")
+(autoload 'ejc-insert-connection-data "ejc-sql" "\
+Insert configured connection data to keep it between Emacs restarts.
+Assume to be evaluated somewhere in .emacs or any file, loaded as Emacs
+configuration.
+
+(fn CONNECTION-NAME)" t)
+(autoload 'ejc-connect-interactive "ejc-sql" "\
+Create new connection interactively and connect to it.
+
+(fn CONNECTION-NAME)" t)
+(autoload 'ejc-connect "ejc-sql" "\
+Connect to selected db.
+
+(fn CONNECTION-NAME)" t)
+(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. " t)
+(autoload 'ejc-eval-user-sql-region "ejc-sql" "\
+Evaluate SQL bounded by the selection area.
+
+(fn BEG END)" t)
+(autoload 'ejc-eval-user-sql-at-point "ejc-sql" "\
+Evaluate SQL bounded by the `ejc-sql-separator' or/and buffer
+boundaries.
+
+(fn &key SYNC BEG END (DISPLAY-RESULT t))" t)
+(autoload 'ejc-show-tables-list "ejc-sql" "\
+Output tables list." t)
+(autoload 'ejc-show-views-list "ejc-sql" "\
+Output views list." t)
+(autoload 'ejc-show-user-types-list "ejc-sql" "\
+Output user types list.
+
+(fn &optional OWNER)" t)
+(autoload 'ejc-show-constraints-list "ejc-sql" "\
+Output constraints list.
+
+(fn &optional OWNER TABLE)" t)
+(autoload 'ejc-show-procedures-list "ejc-sql" "\
+Output procedures list." t)
+(autoload 'ejc-get-temp-editor-buffer "ejc-sql" "\
+
+
+(fn &optional NUM)" t)
+(autoload 'ejc-version "ejc-sql" "\
+Get the ejc-sql version as string." t)
+(register-definition-prefixes "ejc-sql" '("ejc-"))
+\f
+;;; End of scraped data
+
+(provide 'ejc-sql-autoloads)
+
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; no-native-compile: t
+;; coding: utf-8-emacs-unix
+;; End:
+
+;;; ejc-sql-autoloads.el ends here
--- /dev/null
+;; -*- no-byte-compile: t; lexical-binding: nil -*-
+(define-package "ejc-sql" "20241111.117"
+ "Emacs SQL client uses Clojure JDBC."
+ '((emacs "26.3")
+ (clomacs "0.0.5")
+ (dash "2.16.0")
+ (spinner "1.7.3"))
+ :url "https://gitlab.com/kostafey/ejc-sql"
+ :commit "1fc5a38d974aed401424ecd3b49a74e0a0ebc3bb"
+ :revdesc "1fc5a38d974a"
+ :keywords '("sql" "jdbc")
+ :authors '(("Kostafey" . "kostafeyNOSPAMgmail.com"))
+ :maintainers '(("Kostafey" . "kostafeyNOSPAMgmail.com")))
--- /dev/null
+;;; ejc-sql.el --- Emacs SQL client uses Clojure JDBC. -*- lexical-binding: t -*-
+
+;;; Copyright © 2012-2020 - Kostafey <kostafeyNOSPAMgmail.com>
+
+;; Author: Kostafey <kostafeyNOSPAMgmail.com>
+;; URL: https://github.com/kostafey/ejc-sql
+;; Keywords: sql, jdbc
+;; Package-Version: 20241111.117
+;; Package-Revision: 1fc5a38d974a
+;; Package-Requires: ((emacs "26.3")(clomacs "0.0.5")(dash "2.16.0")(spinner "1.7.3"))
+
+;; 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 'org-table)
+(require 'ejc-lib)
+(require 'ejc-eldoc)
+(require 'ejc-format)
+(require 'ejc-interaction)
+(require 'ejc-result-mode)
+(require 'ejc-result-buffer)
+(require 'ejc-completion-common)
+
+(defvar-local ejc-db nil
+ "JDBC connection info for current SQL buffer.")
+
+(defvar ejc-connections nil
+ "List of existing configured jdbc connections")
+
+(defvar ejc-current-buffer-query nil
+ "Current SQL edit buffer lanched query.")
+
+(defcustom ejc-temp-editor-buffer-name "ejc-sql-editor"
+ "Template name for buffers used to ad-hoc edit SQL scripts."
+ :group 'ejc-sql
+ :type 'string)
+
+(defcustom ejc-temp-editor-file-path (expand-file-name "~/tmp/ejc-sql/")
+ "Directory to save temp ad-hoc SQL edit buffers contents."
+ :group 'ejc-sql
+ :type 'string)
+
+(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-result-table-impl 'orgtbl-mode
+ "Set mode for result-set table. Possible values are one of:
+'orgtbl-mode
+'ejc-result-mode."
+ :group 'ejc-sql
+ :type 'symbol)
+
+(defcustom ejc-org-mode-babel-wrapper t
+ "Add wrapper around org-mode default `org-babel-execute:sql'."
+ :type 'boolean
+ :safe #'booleanp
+ :group 'ejc-sql)
+
+(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)
+
+(defcustom ejc-jdbc-drivers
+ '("sqlite" [org.xerial/sqlite-jdbc "3.23.1"]
+ "h2" [com.h2database/h2 "1.4.199"]
+ "mysql" [mysql/mysql-connector-java "5.1.44"]
+ "postgresql" [postgresql/postgresql "9.3-1102.jdbc41"]
+ "sqlserver" [com.microsoft.sqlserver/mssql-jdbc "6.2.2.jre8"]
+ "oracle" [com.oracle.jdbc/ojdbc8 "12.2.0.1"])
+ "Artifacts used as JDBC drivers for each database type in Leiningen format."
+ :group 'ejc-sql
+ :type '(plist :key-type string :value-type (vector symbol string)))
+
+(defcustom ejc-completion-system 'standard
+ "The completion system used by `ejc-connect'."
+ :group 'ejc-sql
+ :type '(radio
+ (const :tag "Ido" ido)
+ (const :tag "Standard" standard)
+ (function :tag "Custom function")))
+
+(defvar-local ejc-replace-double-quotes nil
+ "When t replace double quotes with single ones in SQL before evaluation.")
+
+(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-c C-r") 'ejc-eval-user-sql-region)
+(define-key ejc-sql-mode-keymap (kbd "C-h t") 'ejc-describe-table)
+(define-key ejc-sql-mode-keymap (kbd "C-h d") '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)
+(define-key ejc-sql-mode-keymap (kbd "M-.") 'ejc-describe-entity)
+(define-key ejc-sql-mode-keymap (kbd "M-,") 'ejc-show-prev-result)
+(define-key ejc-sql-mode-keymap (kbd ".") 'ejc-dot-pressed)
+
+(defvar ejc-command-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "c") #'ejc-connect)
+ (define-key map (kbd "i") #'ejc-connect-interactive)
+ (define-key map (kbd "<up>") #'ejc-show-last-result)
+ (define-key map (kbd "t") #'ejc-show-tables-list)
+ (define-key map (kbd "v") #'ejc-show-views-list)
+ (define-key map (kbd "p") #'ejc-show-procedures-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 "f") #'ejc-format-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-connected-hook nil
+ "Hook run when nREPL started and some buffer connected to DataBase.")
+
+(defvar ejc-sql-complete-query-hook nil
+ "Hook run when SQL query executed and the result is outputted.")
+
+(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)))))
+
+;;;###autoload
+(define-minor-mode ejc-sql-mode
+ "Toggle ejc-sql mode."
+ :lighter " ejc"
+ :keymap ejc-sql-mode-keymap
+ :group 'ejc
+ :global nil
+ (if ejc-sql-mode
+ (progn
+ (ejc-create-menu)
+ (ejc-refresh-font-lock)
+ (run-hooks 'ejc-sql-minor-mode-hook))
+ (progn
+ (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
+ dependencies
+ classpath
+ separator
+ sslmode
+ ;; ----------
+ ;; 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 :dependencies dependencies)
+ (cons :classpath
+ (when classpath
+ (if (vectorp classpath)
+ (apply 'vector
+ (-map 'file-truename classpath))
+ (vector (file-truename classpath)))))
+ (cons :separator separator)
+ (cons :sslmode sslmode)
+ (cons :classname classname)))
+ new-connection))
+ ejc-connections)))
+
+(cl-defun ejc-completing-read (prompt choices &key initial-input)
+ "Present a PROMPT with CHOICES and optional INITIAL-INPUT."
+ (cond
+ ((eq ejc-completion-system 'ido)
+ (ido-completing-read prompt choices nil nil initial-input))
+ ((eq ejc-completion-system 'standard)
+ (completing-read prompt choices nil nil initial-input))
+ (t (funcall ejc-completion-system prompt choices))))
+
+(defun ejc-read-file-name (prompt)
+ "Read file name, prompting with PROMPT."
+ (cond
+ ((eq ejc-completion-system 'ido)
+ (ido-read-file-name prompt))
+ (t
+ (read-file-name prompt))))
+
+(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))
+
+(defun ejc-load-conn-statistics ()
+ "Load connection usage statistics to `ejc-conn-statistics' var."
+ (setq ejc-conn-statistics
+ (ejc-load-from-file ejc-conn-statistics-file
+ :default (list)
+ :check 'ejc-plist-p)))
+
+(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))))
+ (ejc-save-to-file ejc-conn-statistics-file ejc-conn-statistics))
+
+(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
+ (if (listp mode-name)
+ (car mode-name)
+ mode-name)
+ "->\\[.+\\]"))
+ connection-name)))
+
+(cl-defun ejc-add-connection (&optional connection-name db)
+ "Add ejc connection information to current buffer.
+If the current mode is `sql-mode' prepare buffer to operate as `ejc-sql-mode'."
+ (when (derived-mode-p 'sql-mode)
+ (sql-set-product (if db
+ (ejc-get-product-name db)
+ "ansi"))
+ (ejc-sql-mode t))
+ (setq-local ejc-connection-name connection-name)
+ (setq-local ejc-db db)
+ (ejc-set-mode-name connection-name))
+
+(defun ejc-eval-org-snippet (&optional orig-fun body params)
+ "Used to eval SQL code in `org-mode' code snippets."
+ (if (or (not ejc-org-mode-babel-wrapper)
+ (and (cdr (assq :engine params))
+ (not
+ (yes-or-no-p
+ (concat "ejc-sql is enabled, ignore source block connection"
+ " header arguments and use ejc-sql to execute it? ")))))
+ (funcall orig-fun body params)
+ (let* ((info (org-babel-get-src-block-info 'no-eval))
+ (expanded-body (if (org-babel-noweb-p (nth 2 info) :eval)
+ (org-babel-expand-noweb-references info)
+ (nth 1 info))))
+ (ejc-eval-user-sql
+ expanded-body
+ :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))
+ (or (org-babel-read-table)
+ (buffer-string)))))))
+
+(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))
+ (apply orig-fun args)
+ (ejc-add-connection connection-name db))
+ (apply orig-fun args)))
+
+(defun ejc-read-connection-name ()
+ "Read connection-name in minibuffer."
+ (ejc-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))))
+
+;;;###autoload
+(defun ejc-insert-connection-data (connection-name)
+ "Insert configured connection data to keep it between Emacs restarts.
+Assume to be evaluated somewhere in .emacs or any file, loaded as Emacs
+configuration."
+ (interactive
+ (list (or (and (boundp 'connection-name) connection-name)
+ (ejc-read-connection-name))))
+ (let ((connection-params (cdr (ejc-find-connection connection-name))))
+ (insert
+ (format "(ejc-create-connection\n \"%s\"%s)"
+ connection-name
+ (-reduce-from
+ (lambda (result x)
+ (concat result
+ (format "\n %s \"%s\""
+ (symbol-name (car x))
+ (cdr x))))
+ ""
+ connection-params)))))
+
+(defalias 'ejc-save-connection-data 'ejc-insert-connection-data)
+
+(defun ejc-resolve-jdbc-driver (dbtype)
+ "Resolve and download artifacts (JDBC drivers) for DBTYPE.
+Apropriate artifacts list located in `ejc-jdbc-drivers'."
+ (let* ((artifact (lax-plist-get ejc-jdbc-drivers dbtype))
+ (jar-path (ejc-lein-artifact-to-path artifact)))
+ (if (not (and (file-exists-p jar-path)
+ (if (> (file-attribute-size (file-attributes jar-path))
+ 0)
+ t
+ ;; If JDBC driver jar file is accidentally empty - it
+ ;; should be deleted and reinstalled.
+ (progn (delete-file jar-path)
+ nil))))
+ (ejc-resolve-dependencies
+ :coordinates (vector artifact)
+ :repositories '(("central" . "https://repo1.maven.org/maven2/")
+ ("clojars" . "https://clojars.org/repo"))))
+ jar-path))
+
+;;;###autoload
+(defun ejc-connect-interactive (connection-name)
+ "Create new connection interactively and connect to it."
+ (interactive
+ (list
+ (or (and (boundp 'connection-name) connection-name)
+ (read-string "DataBase new connection name: "))))
+ (let* ((db-types '(("MySQL" . "mysql")
+ ("Oracle" . "oracle")
+ ("MS SQL Server" . "sqlserver")
+ ("H2" . "h2")
+ ("SQLite" . "sqlite")
+ ("PostgreSQL" . "postgresql")))
+ (dbtype (cdr (assoc-string
+ (ejc-completing-read
+ "Database type: "
+ (cl-sort (-map 'car db-types)
+ 'string-lessp :key 'downcase))
+ db-types)))
+ (properties
+ (-concat
+ (pcase dbtype
+ ("sqlite"
+ `((:subprotocol . "sqlite")
+ (:subname . "")))
+ ("h2"
+ `((:subprotocol . "h2")
+ (:subname . "")))
+ ("mysql"
+ `((:dbtype . "mysql")
+ (:classname . "com.mysql.jdbc.Driver")
+ (:dbname . "")
+ (:host . "localhost")
+ (:port . "3306")))
+ ("postgresql"
+ `((:dbtype . "postgresql")
+ (:dbname . "")
+ (:host . "localhost")
+ (:port . "5432")))
+ ("sqlserver"
+ `((:dbtype . "sqlserver")
+ (:dbname . "")
+ (:host . "localhost")
+ (:port . "1433")))
+ ("oracle"
+ `((:dbtype . "oracle")
+ (:dbname . "")
+ (:host . "localhost")
+ (:port . "1521"))))
+ '((:classpath . "")
+ (:user . "")
+ (:password . ""))))
+ (args
+ (-reduce-from
+ (lambda (memo p)
+ (-concat
+ memo
+ (list
+ (car p)
+ (cl-case (car p)
+ (:dbtype (cdr p))
+ (:classpath (ejc-resolve-jdbc-driver dbtype))
+ (:classname (cdr p))
+ (:subprotocol (cdr p))
+ (:subname (if (member dbtype '("h2" "sqlite"))
+ (let ((fpath
+ (file-truename
+ (ejc-read-file-name "DB file: "))))
+ (if (equal "h2" dbtype)
+ (concat "file://"
+ (file-name-sans-extension
+ (file-name-sans-extension
+ fpath))
+ ";AUTO_SERVER=TRUE")
+ fpath))
+ (read-string "DataBase subname: " (cdr p))))
+ (:dbname (read-string "DataBase name: " (cdr p)))
+ (:host (read-string "Host: " (cdr p)))
+ (:port (read-string "Port: " (cdr p)))
+ (:user (read-string "User: "))
+ (:password (read-passwd "Password: "))))))
+ (list connection-name)
+ properties)))
+ (apply 'ejc-create-connection args)
+ (ejc-connect connection-name)))
+
+;;;###autoload
+(defun ejc-connect (connection-name)
+ "Connect to selected db."
+ (interactive (list
+ (or (and (boundp 'connection-name) connection-name)
+ (ejc-read-connection-name))))
+ (if-let ((db (cdr (ejc-find-connection connection-name))))
+ (progn
+ (ejc-update-conn-statistics connection-name)
+ (ejc-add-connection connection-name db)
+ (when (derived-mode-p 'org-mode)
+ (require 'ob-sql)
+ (advice-add 'org-babel-execute:sql :around 'ejc-eval-org-snippet)
+ (advice-add 'org-edit-special :around #'ejc-org-edit-special))
+ (message "Connection started...")
+ (clomacs-with-nrepl "ejc-sql"
+ (lambda (db connection-name)
+ (ejc-connect-to-db db)
+ (let ((validation-result
+ (ejc-validate-connection
+ :db db
+ :timeout ejc-connection-validate-timeout)))
+ (when (alist-get :status validation-result)
+ (ejc-set-mode-name connection-name)
+ (run-hooks 'ejc-sql-connected-hook)
+ (message (let ((msg (alist-get :message validation-result)))
+ (if (equal "Connected." msg)
+ (format
+ "Connected -> %s."
+ (propertize connection-name
+ 'face 'font-lock-keyword-face))
+ msg))))))
+ :params (list db connection-name)))
+ (ejc-connect-interactive connection-name)))
+
+;;;###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-check-connection ()
+ (unless (ejc-buffer-connected-p)
+ (error "Run M-x ejc-connect first!")))
+
+(defun ejc-get-sql-from-string (sql)
+ (let* ((sql (replace-regexp-in-string ejc-clear-sql-regexp "" sql))
+ (sql (if ejc-replace-double-quotes
+ (replace-regexp-in-string "\"" "'" sql)
+ sql)))
+ sql))
+
+(defun ejc-add-outside-borders-p ()
+ (cl-case ejc-result-table-impl
+ (orgtbl-mode t)
+ (ejc-result-mode nil)))
+
+(defun ejc-message-query-done (start-time status)
+ (message
+ "%s SQL query at %s. Exec time %.03f"
+ (cl-case status
+ (: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."
+ (if ejc-current-buffer-query
+ (with-current-buffer ejc-current-buffer-query
+ (spinner-stop))))
+
+(cl-defun ejc-complete-query (result-file-path
+ &key
+ start-time
+ status
+ display-result
+ mode
+ connection-name
+ db
+ goto-symbol)
+ "Called by Clojure side, when SQL evaluation thread completes."
+ (ejc-spinner-stop)
+ (if result-file-path
+ (setq ejc-result-file-path result-file-path))
+ (if display-result
+ (ejc-show-last-result :mode mode
+ :connection-name connection-name
+ :db db
+ :goto-symbol goto-symbol))
+ (if (and start-time status)
+ (ejc-message-query-done start-time status))
+ (run-hooks 'ejc-sql-complete-query-hook)
+ 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)
+ (ejc-spinner-stop)
+ (if (and (clomacs-get-connection "ejc-sql")
+ (ejc--is-query-running-p))
+ (let ((start-time (or start-time (ejc--cancel-query))))
+ (ejc-message-query-done start-time :terminated))
+ (keyboard-quit)))
+
+(defun ejc-get-prompt-symbol-under-point (msg)
+ "Read user typed string from minibuffer.
+MSG is a first part of the prompt message. The second optional part in
+brackets is a symbol under point (cursor). Return a list of two items:
+(schema|owner db-entity)."
+ (let* ((prefix (if (not mark-active)
+ (ejc-get-prefix-word)))
+ (sql-symbol (if mark-active
+ (buffer-substring (mark) (point))
+ (ejc-get-word-at-point (point))))
+ (enable-recursive-minibuffers t)
+ (typed-string (read-string
+ (if sql-symbol
+ (format "%s (default %s): "
+ msg
+ (if prefix
+ (format "%s.%s" prefix sql-symbol)
+ sql-symbol))
+ (format "%s: " msg)))))
+ (if (equal typed-string "")
+ (list prefix sql-symbol)
+ (let ((split-typed-string (split-string typed-string "\\.")))
+ (if (cadr split-typed-string)
+ split-typed-string
+ (list nil typed-string))))))
+
+(defun ejc-describe-table (prefix 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)
+ (ejc--describe-table :db ejc-db
+ :connection-name ejc-connection-name
+ :table table-name
+ :owner prefix
+ :result-file (ejc-next-result-file-path)
+ :add-outside-borders (ejc-add-outside-borders-p)))
+
+(defun ejc-describe-entity (prefix 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-get-entity-description :db ejc-db
+ :connection-name ejc-connection-name
+ :prefix prefix
+ :entity-name entity-name
+ :result-file (ejc-next-result-file-path)))
+
+(cl-defun ejc-eval-user-sql (sql &key
+ db
+ rows-limit
+ fetch-size
+ column-width-limit
+ append
+ sync
+ display-result
+ result-file)
+ "User starts SQL evaluation process."
+ (message "Processing SQL query...")
+ (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
+ (or db ejc-db)
+ prepared-sql
+ :start-time (current-time)
+ :rows-limit rows-limit
+ :fetch-size fetch-size
+ :column-width-limit column-width-limit
+ :append append
+ :sync sync
+ :display-result display-result
+ :result-file (or result-file
+ (ejc-next-result-file-path))
+ :add-outside-borders (ejc-add-outside-borders-p)))))
+
+;;;###autoload
+(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
+ :display-result t))
+ (if (region-active-p)
+ (deactivate-mark)))
+
+;;;###autoload
+(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))
+
+;;;###autoload
+(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
+ :fetch-size 0
+ :column-width-limit 0
+ :display-result t))
+
+;;;###autoload
+(defun ejc-show-views-list ()
+ "Output views list."
+ (interactive)
+ (ejc-check-connection)
+ (ejc-eval-user-sql
+ (ejc-select-db-meta-script ejc-db :views)
+ :rows-limit 0
+ :column-width-limit 0
+ :display-result t))
+
+;;;###autoload
+(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)))
+
+;;;###autoload
+(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)))
+
+;;;###autoload
+(defun ejc-show-procedures-list ()
+ "Output procedures list."
+ (interactive)
+ (ejc-check-connection)
+ (ejc-eval-user-sql
+ (ejc-select-db-meta-script ejc-db :procedures
+ :owner (ejc-get-this-owner ejc-db))
+ :rows-limit 0
+ :column-width-limit 0
+ :display-result t))
+
+;;;###autoload
+(defun ejc-get-temp-editor-buffer (&optional num)
+ (interactive "P")
+ "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."
+ (let* ((tmp-file-name (if num
+ (format "%s-%s"
+ ejc-temp-editor-buffer-name
+ (if (numberp num)
+ (int-to-string num)
+ num))
+ ejc-temp-editor-buffer-name))
+ (tmp-file-path (progn
+ (unless (file-exists-p ejc-temp-editor-file-path)
+ (make-directory ejc-temp-editor-file-path t))
+ (expand-file-name (concat tmp-file-name ".sql")
+ ejc-temp-editor-file-path)))
+ (tmp-buffer-name (format "*%s*" tmp-file-name)))
+ (if (get-buffer tmp-buffer-name)
+ (switch-to-buffer tmp-buffer-name)
+ (progn
+ (find-file tmp-file-path)
+ (rename-buffer tmp-buffer-name)
+ (sql-mode)
+ (ejc-add-connection)
+ (get-buffer tmp-buffer-name)))))
+
+(defun ejc-open-log ()
+ (interactive)
+ (find-file-read-only (ejc-get-log-file-path))
+ (goto-char (point-max)))
+
+;;;###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.4.1-SNAPSHOT"
+ :description "Interact with database via java/clojure libs to run SQL 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.11.1"]
+ [org.clojure/java.jdbc "0.7.10"]
+ [org.hibernate/hibernate-core "5.4.1.Final"]
+ [com.cemerick/pomegranate "1.1.0"]
+ [leiningen-core "2.9.3"]
+ [org.apache.commons/commons-lang3 "3.5"]
+ [org.apache.httpcomponents/httpclient "4.5.5"]
+ [clomacs "0.0.5-SNAPSHOT"]])
--- /dev/null
+# -*- mode: snippet -*-
+# name: altertable
+# key: altertable
+# --
+ALTER TABLE ${1:table}
+ ADD ${2:column_name} ${3:column_definition}
--- /dev/null
+# -*- mode: snippet -*-
+# name: begin
+# key: begin
+# --
+BEGIN
+ $0
+END;
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: create.d
+# key: create.d
+# --
+CREATE DATABASE ${1:database_name}
+`(if (eq sql-product 'ansi) "character set 'utf8' collate 'utf8_general_ci'")`;
\ 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: drop.d
+# key: drop.d
+# --
+DROP DATABASE ${1:database_name};
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: grant
+# key: grant
+# --
+GRANT ALL PRIVILEGES
+ ON ${1:object_type}
+ TO ${2:user};
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: inner
+# key: inner
+# --
+INNER JOIN ${1:table_name} ON $2
\ 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: left
+# key: left
+# --
+LEFT JOIN ${1:table_name} ON $2
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: revoke
+# key: revoke
+# --
+REVOKE ALL PRIVILEGES
+ ON ${1:object_type}
+ FROM ${2:user};
\ No newline at end of file
--- /dev/null
+# -*- mode: snippet -*-
+# name: right
+# key: right
+# --
+RIGHT JOIN ${1:table_name} ON $2
\ 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: show
+# key: show
+# --
+SHOW TABLES
\ 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
+;;; cache.clj -- Keep database stucture cache.
+
+;;; Copyright © 2019-2023 - 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.cache
+ (:require [clomacs :as clomacs]))
+
+(def cache
+ "Keep information about structure of databases used for autocomplete & eldoc.
+ This data contains (depends on database type):
+ ├── owners/schemas
+ | ├── tables
+ | | └── columns
+ | └── views
+ ├── packages
+ | └── stored procedures & functions
+ | └── parameters
+ └── keywords
+ It's global: same database structure information shared beetween
+ different buffers connected to the same database."
+ (atom {}))
+
+(def cache-creation-promises
+ "Signs of database structure cache created."
+ (atom {}))
+
+(defn get-cache
+ "Get actual cache."
+ []
+ @cache)
+
+(defn deref-cache [db]
+ [db
+ (into
+ {}
+ (map
+ (fn [entity-k]
+ [entity-k
+ (let [item (get-in (get-cache) [db entity-k])]
+ (if (future? item)
+ (deref item)
+ (if (map? item)
+ (into
+ {}
+ (map
+ (fn [sub-entity-k]
+ [sub-entity-k
+ (let [sub-item (get-in (get-cache)
+ [db entity-k sub-entity-k])]
+ (if (future? sub-item)
+ (deref sub-item)
+ sub-item))])
+ (keys item)))
+ item)))])
+ (keys
+ ((get-cache) db))))])
+
+(defn output-cache
+ "Output actual cache to printable format."
+ [db]
+ (clomacs/format-result
+ (if db
+ (second (deref-cache db))
+ (into {} (map deref-cache (keys (get-cache)))))))
+
+(defn invalidate-cache
+ "Clean your current connection cache (database owners and tables list)."
+ [db]
+ (swap! cache assoc-in [db] nil)
+ (swap! cache-creation-promises assoc-in [db] nil))
--- /dev/null
+;; Version of `add-classpath` imlementation from Kaocha project.
+;; https://github.com/lambdaisland/kaocha/blob/master/src/kaocha/classpath.clj
+
+(ns ejc-sql.classpath
+ "This is the add-classpath function from Pomegranate 1.0.0, extracted so we
+ don't need to pull in Aether."
+ (:refer-clojure :exclude [add-classpath])
+ (:require [dynapath.util :as dp]
+ [clojure.java.io :as io]))
+
+(def new-jdk
+ (>= (BigDecimal. (System/getProperty "java.specification.version")) 1.9))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Pomegranate
+
+(defn ensure-compiler-loader
+ "Ensures the clojure.lang.Compiler/LOADER var is bound to a DynamicClassLoader,
+ so that we can add to Clojure's classpath dynamically."
+ []
+ (when-not (bound? Compiler/LOADER)
+ (.bindRoot Compiler/LOADER (clojure.lang.DynamicClassLoader. (clojure.lang.RT/baseLoader)))))
+
+(defn- classloader-hierarchy
+ "Returns a seq of classloaders, with the tip of the hierarchy first.
+ Uses the current thread context ClassLoader as the tip ClassLoader
+ if one is not provided."
+ ([]
+ (if new-jdk
+ (ensure-compiler-loader)
+ (classloader-hierarchy (.. Thread currentThread getContextClassLoader)))
+ (classloader-hierarchy (deref clojure.lang.Compiler/LOADER)))
+ ([tip]
+ (->> tip
+ (iterate #(.getParent %))
+ (take-while boolean))))
+
+(defn- modifiable-classloader?
+ "Returns true iff the given ClassLoader is of a type that satisfies
+ the dynapath.dynamic-classpath/DynamicClasspath protocol, and it can
+ be modified."
+ [cl]
+ (dp/addable-classpath? cl))
+
+(defn add-classpath
+ "A corollary to the (deprecated) `add-classpath` in clojure.core. This implementation
+ requires a java.io.File or String path to a jar file or directory, and will attempt
+ to add that path to the right classloader (with the search rooted at the current
+ thread's context classloader)."
+ ([jar-or-dir classloader]
+ (when-not (dp/add-classpath-url classloader (.toURL (.toURI (io/file jar-or-dir))))
+ (throw (IllegalStateException. (str classloader " is not a modifiable classloader")))))
+ ([jar-or-dir]
+ (let [classloaders (classloader-hierarchy)]
+ (if-let [cl (if new-jdk
+ (filter modifiable-classloader? classloaders)
+ (last (filter modifiable-classloader? classloaders)))]
+ ;; Add to all classloaders that allow it. Brute force but doesn't hurt.
+ (if new-jdk
+ (run! #(add-classpath jar-or-dir %) cl)
+ (add-classpath jar-or-dir cl))
+ (throw (IllegalStateException. (str "Could not find a suitable classloader to modify from "
+ classloaders)))))))
+
+;; /Pomegranate
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
--- /dev/null
+;;; connect.clj -- Core clojure functions for ejc-sql emacs extension.
+
+;;; Copyright © 2013-2024 - 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
+ (:require [clojure.java.jdbc :as j]
+ [clojure.java.io :as io]
+ [clojure.string :as s]
+ [clomacs :refer [clomacs-defn]]
+ [ejc-sql.output :as o]
+ [ejc-sql.lib :refer [select? ddl? clob-to-string-row *max-column-width*]]
+ [ejc-sql.cache :refer [invalidate-cache]])
+ (:import [java.sql SQLException]))
+
+(def db
+ "DataBase connection properties list from the last transaction.
+For debug purpose."
+ (atom nil))
+
+(defn set-db [ejc-db]
+ (reset! db ejc-db))
+
+(def current-query
+ "Current running query data."
+ (atom {}))
+
+(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 is-statement-not-closed? []
+ (let [stmt (:stmt @current-query)]
+ (and (not (nil? stmt))
+ (not (.isClosed stmt)))))
+
+(defn is-query-process-running? []
+ (let [runner (:runner @current-query)]
+ (and
+ (not (nil? runner))
+ (not (future-done? runner))
+ (not (future-cancelled? runner)))))
+
+(defn is-query-running? []
+ (or (is-statement-not-closed?)
+ (is-query-process-running?)))
+
+(defn cancel-query
+ "Terminate current (long) running query. Aimed to cancel SELECT queries.
+ Unsafe for INSERT/UPDATE/CREATE/ALTER queries."
+ []
+ (future
+ (when (is-statement-not-closed?)
+ (let [conn (:conn @current-query)]
+ (try
+ (.rollback conn)
+ (finally
+ (.close conn)))))
+ (when (is-query-process-running?)
+ (future-cancel (:runner @current-query))))
+ (:start-time @current-query))
+
+(defn validate-connection [& {:keys [db timeout]
+ :or {db @ejc-sql.connect/db
+ timeout 5}}]
+ (letfn [(abstract-is-valid [msg]
+ (clomacs/format-result
+ {:status true
+ :message (str "Warning: can't validate connection. "
+ "Please, update your JDBC driver and "
+ "restart the REPL.\n"
+ msg)}))]
+ (try
+ (clomacs/format-result
+ {:status (.isValid (j/get-connection db) timeout)
+ :message "Connected."})
+ (catch AbstractMethodError e
+ (abstract-is-valid (.getMessage e)))
+ (catch java.sql.SQLFeatureNotSupportedException e
+ (abstract-is-valid (.getMessage e))))))
+
+(defn get-separator-re
+ "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%'"
+ [separator]
+ (re-pattern
+ (format
+ "%s(?<!\\s{0,1000}--.{0,1000})(?=(([^\"']*[\"']){2})*[^\"']*$)"
+ ;; Escape chars for `$$` separators.
+ (.replace separator "$" "\\$"))))
+
+(def delimiter-re
+ "Regex to search a `delimiter` command in SQL expression."
+ (re-pattern "(?i)delimiter\\s+(.+)"))
+
+(def comments-re
+ "Regex to search comments in SQL expression."
+ (java.util.regex.Pattern/compile
+ "(?:/\\*.*?\\*/[\\s;]*\n?)|(?:--.*?$\n)",
+ (bit-or java.util.regex.Pattern/DOTALL
+ java.util.regex.Pattern/MULTILINE)))
+
+(clomacs-defn complete-query 'ejc-complete-query
+ :doc "Show file contents with SQL query evaluation results.")
+
+(defn complete
+ "Complete query and display `text` as a result."
+ [text & {:keys [display-result
+ result-file
+ append
+ mode
+ start-time
+ status
+ connection-name
+ db
+ goto-symbol]
+ :or {display-result true
+ append false
+ mode 'ejc-result-mode}}]
+ (complete-query
+ (when text
+ (o/write-result-file text :result-file result-file :append append))
+
+ :start-time start-time
+ :status status
+ :display-result display-result
+ :mode mode
+ :connection-name connection-name
+ :db db
+ :goto-symbol goto-symbol))
+
+(defn eval-sql-core
+ "The core SQL evaluation function."
+ [& {:keys [db sql-list fetch-size max-rows]
+ :or {db @ejc-sql.connect/db}}]
+ (set-db db)
+ (java.util.Locale/setDefault (java.util.Locale. "UK"))
+ (try
+ (with-open [conn (j/get-connection db)]
+ (let [statement (.createStatement conn)]
+ (mapv (fn [sql]
+ (if (select? sql)
+ ;; SELECT
+ (list
+ :result-set
+ (let [stmt (j/prepare-statement
+ conn sql
+ {:fetch-size (or fetch-size @o/fetch-size 0)
+ :max-rows (or max-rows
+ (if (and (> @o/max-rows 0)
+ @o/show-too-many-rows-message)
+ ;; Get one more row to recognize that
+ ;; the actual number of records from this
+ ;; query is bigger than `max-rows`.
+ (+ @o/max-rows 1)
+ @o/max-rows)
+ 0)})]
+ (swap! current-query assoc
+ :stmt stmt
+ :conn conn)
+ (j/query db stmt
+ {:as-arrays? true
+ :result-set-fn
+ (fn [rs]
+ (let [single-record?
+ (not (next (next rs)))]
+ (mapv
+ #(clob-to-string-row
+ % single-record?)
+ rs)))})))
+ ;; DML or DDL
+ (let [result-set? (.execute statement sql)
+ message (if-let [result (when
+ (and
+ (not result-set?)
+ (> (.getUpdateCount statement) 0))
+ (.getUpdateCount statement))]
+ (str "Records affected: " result)
+ "Executed")]
+ (when (ddl? sql)
+ (invalidate-cache db))
+ (list :message message))))
+ sql-list)))
+ (catch SQLException e
+ [(list :message
+ (o/unify-str "Error: " (.getMessage e)))])))
+
+(defn- eval-user-sql
+ "Receive raw SQL from the user, log it, divide by statements and eval them."
+ [db sql & {:keys [rows-limit
+ fetch-size
+ append
+ display-result
+ result-file]}]
+ (let [sql (s/trim sql)
+ _ (do (o/log-sql (str sql "\n"))
+ (o/clear-result-file :result-file result-file))
+ [sql
+ manual-separator] (if (s/starts-with? (s/lower-case sql) "delimiter")
+ ;; User defined statement separator manually
+ ;; before SQL expression.
+ ;; Remove `delimiter` command from SQL expression.
+ [(s/trim (s/replace-first sql delimiter-re ""))
+ (second (re-find delimiter-re sql))]
+ [sql nil])
+ sql (handle-special-cases db sql)
+ statement-separator-re (get-separator-re (or manual-separator ";"))
+ results (let [sql-parts (filter
+ ;; Remove parts contains comments only.
+ (fn [part]
+ (seq (s/trim
+ (s/replace part comments-re ""))))
+ (if (or (not (:separator db)) manual-separator)
+ (s/split sql statement-separator-re)
+ [sql]))
+ result-list (eval-sql-core :db db
+ :sql-list sql-parts
+ :max-rows rows-limit
+ :fetch-size fetch-size)
+ _ (doall
+ (for [[result-type result] result-list]
+ (if (= result-type :result-set)
+ (o/print-table result fetch-size)
+ (println result))))]
+ result-list)]
+ (complete
+ nil
+ :start-time (:start-time @current-query)
+ :status (if (or
+ (every? (fn [[result-type _]]
+ (= result-type :result-set))
+ results)
+ (not (some (fn [[result-type result]]
+ (and
+ (not (= result-type :result-set))
+ (s/starts-with? (s/lower-case result)
+ "error")))
+ results)))
+ :done
+ (if (and
+ (= (count results) 1)
+ (some (fn [[_ result]]
+ (.contains (s/lower-case result)
+ "closed connection"))
+ results))
+ :terminated
+ :error))
+ :display-result display-result
+ :result-file result-file)))
+
+(defn eval-sql-and-log-print
+ "Write SQL to log file, evaluate it and print result."
+ [db sql & {:keys [rows-limit
+ fetch-size
+ column-width-limit
+ append
+ start-time
+ sync
+ display-result
+ result-file
+ add-outside-borders]
+ :or {append false
+ sync false
+ display-result true
+ add-outside-borders true}}]
+ (letfn [(run-query []
+ (try
+ (with-open [out (io/writer result-file)]
+ (binding [*out* out
+ o/*add-outside-borders* add-outside-borders
+ *max-column-width* (or column-width-limit
+ @o/column-width-limit)]
+ (eval-user-sql db sql
+ :rows-limit rows-limit
+ :fetch-size fetch-size
+ :append append
+ :display-result display-result
+ :result-file result-file)))
+ (catch Exception e
+ (complete
+ (str (.getMessage e) "\n"
+ (s/join "\n" (.getStackTrace e)))
+ :start-time (:start-time @current-query)
+ :status :error
+ :display-result true
+ :result-file result-file))))]
+ (if sync
+ (run-query)
+ (swap! current-query assoc
+ :runner (future (run-query))
+ :start-time start-time))))
+
+(defn query-meta
+ "Get metadata for `sql` result dataset."
+ [db sql]
+ (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)))
--- /dev/null
+;;; deps_resolver.clj -- Discover required jar artifacts.
+
+;;; Copyright © 2020-2023 - 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.deps-resolver
+ (:require
+ [cemerick.pomegranate.aether :as aether]
+ [leiningen.core.project :refer [default-repositories]]))
+
+(defn get-hierarchy [artifacts-list]
+ (aether/dependency-hierarchy
+ artifacts-list
+ (aether/resolve-dependencies
+ :coordinates artifacts-list
+ :repositories default-repositories)))
+
+(def artifacts (atom (list)))
+
+(defn art-wanderer [art]
+ (if (and
+ (coll? art)
+ (vector? art)
+ (not (coll? (nth art 0))))
+ (swap! artifacts conj art)
+ (dorun (map art-wanderer art))))
+
+(defn run-wanderer [art]
+ (reset! artifacts (list))
+ (dorun (map art-wanderer art))
+ @artifacts)
+
+(defn get-dependeces-list
+ "Get artifacts dependeces hierarchy as a flatten list."
+ [artifacts-list]
+ (-> artifacts-list get-hierarchy run-wanderer))
+
+(defn get-dependeces-files-list
+ "Resolve dependeces and return a list of all requred jar files paths.
+ `artifacts-list` is a leningen dependeces vector.
+ E.g. '[[com.ibm.informix/jdbc \"4.50.3\"]]."
+ [artifacts-list]
+ (try
+ (map
+ (fn [dep-file] (.getPath dep-file))
+ (flatten
+ (map
+ aether/dependency-files
+ (map
+ (fn [dep] (get-hierarchy (vector dep)))
+ (get-dependeces-list artifacts-list)))))
+ (catch Exception _
+ nil)))
--- /dev/null
+;;; keywords.clj -- Keep database-specific keywords.
+
+;;; Copyright © 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.keywords)
+
+(def keywords
+ {:sqlite
+ ["ABORT" "ACTION" "ADD" "AFTER" "ALL" "ALTER" "ANALYZE" "AND" "AS" "ASC" "ATTACH"
+ "AUTOINCREMENT" "BEFORE" "BEGIN" "BETWEEN" "BY" "CASCADE" "CASE" "CAST" "CHECK"
+ "COLLATE" "COLUMN" "COMMIT" "CONFLICT" "CONSTRAINT" "CREATE" "CROSS" "CURRENT"
+ "CURRENT_DATE" "CURRENT_TIME" "CURRENT_TIMESTAMP" "DATABASE" "DEFAULT"
+ "DEFERRABLE" "DEFERRED" "DELETE" "DESC" "DETACH" "DISTINCT" "DO" "DROP" "EACH"
+ "ELSE" "END" "ESCAPE" "EXCEPT" "EXCLUSIVE" "EXISTS" "EXPLAIN" "FAIL" "FILTER"
+ "FOLLOWING" "FOR" "FOREIGN" "FROM" "FULL" "GLOB" "GROUP" "HAVING" "IF" "IGNORE"
+ "IMMEDIATE" "IN" "INDEX" "INDEXED" "INITIALLY" "INNER" "INSERT" "INSTEAD"
+ "INTERSECT" "INTO" "IS" "ISNULL" "JOIN" "KEY" "LEFT" "LIKE" "LIMIT" "MATCH"
+ "NATURAL" "NO" "NOT" "NOTHING" "NOTNULL" "NULL" "OF" "OFFSET" "ON" "OR" "ORDER"
+ "OUTER" "OVER" "PARTITION" "PLAN" "PRAGMA" "PRECEDING" "PRIMARY" "QUERY" "RAISE"
+ "RANGE" "RECURSIVE" "REFERENCES" "REGEXP" "REINDEX" "RELEASE" "RENAME" "REPLACE"
+ "RESTRICT" "RIGHT" "ROLLBACK" "ROW" "ROWS" "SAVEPOINT" "SELECT" "SET" "TABLE"
+ "TEMP" "TEMPORARY" "THEN" "TO" "TRANSACTION" "TRIGGER" "UNBOUNDED" "UNION"
+ "UNIQUE" "UPDATE" "USING" "VACUUM" "VALUES" "VIEW" "VIRTUAL" "WHEN" "WHERE"
+ "WINDOW" "WITH" "WITHOUT"]})
--- /dev/null
+;;; lib.clj -- Misc clojure functions for ejc-sql emacs extension.
+
+;;; Copyright © 2013-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.lib
+ (:require [clojure.string :as s]
+ [clojure.reflect :refer [resolve-class]]))
+
+(def ^:dynamic *max-column-width* 30)
+
+(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}}]
+ (when (and elm seq)
+ (if (not case-sensitive)
+ (in? (mapv s/lower-case seq) (s/lower-case elm))
+ (some #(= elm %) seq))))
+
+(defn get->in
+ "Case insensitive `get-in` for last key in sequence."
+ [obj path & {:keys [case-sensitive] :or {case-sensitive false}}]
+ (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 simple-join [n s]
+ (s/join
+ (for [_ (range 0 n)] s)))
+
+(defn class-exists? [c]
+ (resolve-class (.getContextClassLoader (Thread/currentThread)) c))
+
+(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
+ "Turn an Oracle Clob into a String"
+ ([clob]
+ (clob-to-string clob true))
+ ([clob single-record?]
+ (with-open [rdr (java.io.BufferedReader. (.getCharacterStream clob))]
+ (if (or single-record? (not *max-column-width*))
+ (apply str (line-seq rdr))
+ ;; Show only first `*max-column-width*` (30 by default) symbols
+ ;; of Clob field. If longer, replace last 3 symbols by dots.
+ (let [result (apply str (take (+ *max-column-width* 1)
+ (mapcat seq (line-seq rdr))))]
+ (if (> (count result) *max-column-width*)
+ (str (subs result 0 (- *max-column-width* 3)) "...")
+ result))))))
+
+(defn clob-to-string-row
+ "Check all data in row if it's a CLOB and convert CLOB to string."
+ [row single-record?]
+ (mapv (fn [field]
+ (if (is-clob? field)
+ (clob-to-string field single-record?)
+ field))
+ row))
+
+(defn clean-sql [sql]
+ (-> sql
+ (s/replace #"(--).*\n" "")
+ (s/replace #"( )|( \t)|\t" " ")
+ (s/replace "^\n" "")
+ s/trim))
+
+(def select-words
+ '("SELECT"
+ "SHOW"
+ "WITH"
+ "EXPLAIN"))
+
+(def dml-words
+ (concat
+ select-words
+ '("INSERT"
+ "UPDATE"
+ "DELETE")))
+
+(def ddl-words
+ '("CREATE"
+ "ALTER"
+ "DROP"
+ "RENAME"))
+
+(defn determine-query
+ "Determine if current SQL starts with one of the words from `words` list."
+ [sql words]
+ (let [sql (clean-sql sql)
+ ignore-set #{\( \[}
+ pos (loop [pos 0]
+ (if (ignore-set (get sql pos))
+ (recur (inc pos))
+ pos))
+ sql (s/upper-case (subs sql pos))]
+ (first (filter (fn [w] (s/starts-with? sql w)) words))))
+
+(defn select? [sql]
+ (determine-query sql select-words))
+
+(defn dml?
+ "Determine if current SQL is Data Manipulation Language (DML) case."
+ [sql]
+ (determine-query sql dml-words))
+
+(defn ddl?
+ "Determine if current SQL is Data Definition Language (DDL) case."
+ [sql]
+ (determine-query sql ddl-words))
--- /dev/null
+;;; output.clj -- Output & formatting clojure functions for ejc-sql.
+
+;;; Copyright © 2013-2023 - 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
+ (:require [clojure.string :as s]
+ [clojure.java.io :refer [file writer]]
+ [ejc-sql.lib :refer [*max-column-width* dml? simple-join windows?]])
+ (:import (java.io File)
+ (java.lang Character$UnicodeBlock)
+ (org.apache.commons.lang3 StringUtils)
+ (org.hibernate.engine.jdbc.internal BasicFormatterImpl
+ DDLFormatterImpl)))
+
+(def ^:dynamic *add-outside-borders* true)
+
+(defn get-log-dir []
+ (file (if windows?
+ (System/getenv "AppData")
+ "/var/log/")
+ "ejc-sql"))
+
+(defn get-log-file [& [create-new]]
+ (loop [xs (take 100 (range))]
+ (when xs
+ (let [prev-day (first xs)
+ log-file (file
+ (get-log-dir)
+ (format "%s.log"
+ (.format
+ (new java.text.SimpleDateFormat
+ "yyyy-MM-dd")
+ (let [cal (java.util.Calendar/getInstance)]
+ (.setTime cal (new java.util.Date))
+ (.add cal java.util.Calendar/DATE
+ (if prev-day (- prev-day) 0))
+ (.getTime cal)))))]
+ (if (or create-new (.exists log-file))
+ log-file
+ (recur (next xs)))))))
+
+(defn print-log-file-path []
+ (print (.getAbsolutePath (or (get-log-file) (get-log-dir)))))
+
+(defn log-sql [sql]
+ (let [log-file (get-log-file true)
+ is-new-file (not (.exists log-file))]
+ (when is-new-file
+ (.mkdirs (File. (.getParent log-file)))
+ (.createNewFile log-file))
+ (with-open [wrtr (writer log-file :append true)]
+ (when 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 fetch-size
+ "Limit number of records to output."
+ (atom 50))
+
+(def max-rows
+ "Limit number of records to contain in ResultSet."
+ (atom 99))
+
+(def show-too-many-rows-message
+ "Output message in case of ResultSet is bigger than `fetch-size`."
+ (atom true))
+
+(def column-width-limit
+ "Limit number of chars per column to output."
+ (atom 30))
+
+(defn set-fetch-size
+ "Set limit for number of records to output. When nil no limit.
+ Passed to the JDBC driver a hint as to the number of rows that should be
+ fetched from the database when more rows are needed for ResultSet objects
+ generated by a Statement."
+ [val]
+ (reset! fetch-size (or val 0)))
+
+(defn set-max-rows
+ "Set limit for number of records to contain in ResultSet. When nil no limit.
+ Sets the limit for the maximum number of rows that any ResultSet object
+ generated by a Statement object can contain to the given number."
+ [val]
+ (reset! max-rows (or val 0)))
+
+(defn set-show-too-many-rows-message
+ [val]
+ (reset! show-too-many-rows-message (or val false)))
+
+(defn set-column-width-limit
+ "Set limit for number of chars per column to output. When nil no limit."
+ [val]
+ (reset! column-width-limit val))
+
+(defn rotate-table
+ "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"
+ [data]
+ (apply mapv vector data))
+
+(def use-unicode (atom false))
+
+(defn set-use-unicode
+ "Set using unicode for grid borders."
+ [val]
+ (reset! use-unicode val))
+
+(defn u? [unicode-str ascii-str]
+ (if @use-unicode unicode-str ascii-str))
+
+(defn print-maps
+ "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 add-borders]
+ (when (seq rows)
+ (let [widths (map
+ (fn [k]
+ (apply max (count (str k))
+ (map #(count (str (get % k))) rows)))
+ ks)
+ spacers (map #(apply str (repeat % (u? "─" "-"))) widths)
+ fmts (map #(str "%-" % "s") widths)
+ fmt-row (fn [leader divider trailer row]
+ (str (if add-borders leader "")
+ (apply str
+ (interpose
+ divider
+ (for [[col fmt]
+ (map vector (map #(get row %) ks) fmts)]
+ (format fmt (str col)))))
+ (if add-borders trailer "")))
+ aob *add-outside-borders*]
+ (println (fmt-row (if aob (u? "│ " "| ") "") (u? " │ " " | ") (if aob (u? " │" " |") "")
+ (zipmap ks (map name ks))))
+ (println (fmt-row (if aob (u? "├─" "|-") "") (u? "─┼─" "-+-") (if aob (u? "─┤" "-|") "")
+ (zipmap ks spacers)))
+ (doseq [row rows]
+ (println (fmt-row (if aob (u? "│ " "| ") "") (u? " │ " " | ") (if aob (u? " │" " |") "") row))))))
+ ([rows add-borders]
+ (print-maps (keys (first rows)) rows add-borders)))
+
+(defn trim-max-width [x]
+ (let [s (str x)]
+ (if (and *max-column-width*
+ (> *max-column-width* 0)
+ (> (count s) *max-column-width*))
+ (str (subs s 0 (- *max-column-width* 3)) "...")
+ s)))
+
+(defn min-not-zero [x y]
+ (min (if (> x 0) x y)
+ (if (> y 0) y x)))
+
+(defn- cjk-char?
+ "Return true if argument char is CJK character."
+ [char]
+ (= (Character$UnicodeBlock/of char)
+ Character$UnicodeBlock/CJK_UNIFIED_IDEOGRAPHS))
+
+(defn- cjk-chars-count
+ "Return count of CJK characters in string."
+ [text]
+ (count (filter cjk-char? text)))
+
+(defn- string-length
+ "Return string length, given that CJK characters have a length of 2."
+ [text]
+ (loop [string text
+ length 0]
+ (if (= (count string) 0)
+ length
+ (recur (next string) (+ length
+ (if (cjk-char? (first string)) 2 1))))))
+
+(defn print-table
+ "Converts a seq of seqs to a textual table. Uses the first seq as the table
+ headings and the remaining seqs as rows."
+ ([rows limit]
+ (when (seq rows)
+ (let [row-limit (or limit (min-not-zero @max-rows @fetch-size))
+ [rows msg] (if (and row-limit
+ (> row-limit 0)
+ ;; Since `rows` parameter contains a header
+ ;; `row` 1 should be added to `row-limit`.
+ (> (count rows) (+ row-limit 1)))
+ [(take (+ row-limit 1) rows)
+ (when @show-too-many-rows-message
+ (format "Too many rows. Only %s from %s%s are shown."
+ row-limit
+ (min-not-zero @max-rows (- (count rows) 1))
+ (if (and @max-rows
+ (> @max-rows 0)
+ (> (- (count rows) 1) @max-rows))
+ "+" "")))]
+ [rows ""])
+ [headers rows] [(map name (first rows)) (rest rows)]
+ aob *add-outside-borders*
+ [rows rotated] (if (and (not aob)
+ (= (count rows) 1)
+ (> (count (first rows)) 1))
+ ;; Rotatate result set table representation
+ ;; if it has 1 row and many columns.
+ [(rotate-table [headers (first rows)]) true]
+ [rows false])
+ [single-column-and-row
+ cell-value] (when-let [single-cell? (and (= (count rows) 1)
+ (= (count (first rows)) 1))]
+ [single-cell? (ffirst rows)])
+ [headers rows] (if (or rotated single-column-and-row)
+ ;; Do not restrict column width if result
+ ;; set has only 1 row or 1 column & 1 row.
+ [headers rows]
+ [(map trim-max-width headers)
+ (map #(map trim-max-width %) rows)])
+ rn #"(\r\n)|\n|\r"
+ nl (System/getProperty "line.separator")
+ rows (for [row rows]
+ (map #(if (string? %)
+ (if single-column-and-row
+ ;; In case of only 1 column & 1 row unify
+ ;; newline separators to system line break.
+ (s/replace % rn nl)
+ (-> %
+ (s/replace rn " ")
+ ;; Tabs to spaces to align columns widths.
+ (s/replace #"\t" " ")))
+ ;; Do not remove newline separators if result
+ ;; set cell is not a string.
+ %)
+ row))
+ widths (if single-column-and-row
+ (list
+ (apply max
+ (cons
+ (string-length (first headers))
+ (if (string? cell-value)
+ (map string-length (s/split cell-value rn))
+ (list (string-length (str cell-value)))))))
+ (for [col (rotate-table (conj rows headers))]
+ (apply max (map #(string-length (str %)) col))))
+ spacers (map #(apply str (repeat % (u? "─" "-"))) widths)
+ ;; TODO: #(str "%" % "d") for numbers
+ fmts (if (and rotated (not aob))
+ ;; Remove trailing spaces for data column of single-row
+ ;; result if no outer borders required.
+ (list (fn [text] (let [width (- (first widths)
+ (cjk-chars-count text))
+ pattern (str "%-" width "s")]
+ (format pattern text)))
+ (fn [text] (let [pattern "%s"]
+ (format pattern text))))
+ (map (fn [w]
+ (fn [text] (let [width (- w (cjk-chars-count text))
+ pattern (str "%-" width "s")]
+ (format pattern text))))
+ widths))
+ fmt-row (fn [leader divider trailer row]
+ (str leader
+ (apply str (interpose
+ divider
+ (for [[col fmt] (map vector row fmts)]
+ (fmt (str col)))))
+ trailer))]
+ (when (not-empty msg)
+ (println msg)
+ (println))
+ (when (not rotated)
+ (println (fmt-row (if aob (u? "│ " "| ") "") (u? " │ " " | ") (if aob (u? " │" " |") "") headers))
+ (println (fmt-row (if aob (u? "├─" "|-") "") (u? "─┼─" "-+-") (if aob (u? "─┤" "-|") "") spacers)))
+ (doseq [row (if (and aob single-column-and-row (string? cell-value))
+ (map list (s/split cell-value (re-pattern nl)))
+ rows)]
+ (println (fmt-row (if aob (u? "│ " "| ") "") (u? " │ " " | ") (if aob (u? " │" " |") "") row))))))
+ ([rows] (print-table rows @fetch-size)))
+
+(defn unify-str
+ "Concatenate stings, unify newline separators to the system line break."
+ [& s]
+ (if (empty? (filter not-empty s))
+ ""
+ (apply str (map #(s/replace %
+ #"(\r\n)|\n|\r"
+ (System/getProperty "line.separator"))
+ s))))
+
+(defn format-sql [sql]
+ (s/trim
+ (let [sql (s/trim sql)]
+ (.format (if (dml? sql)
+ (BasicFormatterImpl.)
+ (DDLFormatterImpl.))
+ sql))))
+
+(defn format-sql-print
+ "SQL should be printed to provide cross-platform newline handling."
+ [sql]
+ (print (format-sql sql)))
+
+(defn format-sql-if-required [sql]
+ (if (> (StringUtils/countMatches sql "\n") 1)
+ sql
+ (format-sql sql)))
+
+(defn write-result-file [text & {:keys [result-file
+ append]
+ :or {append false}}]
+ (spit result-file text :append append)
+ result-file)
+
+(defn clear-result-file [& {:keys [result-file]}]
+ (write-result-file "" :result-file result-file))
--- /dev/null
+;;; structure.clj -- Receive database stucture and keep it in cache.
+
+;;; Copyright © 2016-2024 - 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
+ (:require
+ [clojure.java.jdbc :as j]
+ [clojure.string :as s]
+ [clojure.java.io :as io]
+ [clomacs :refer [clomacs-defn]]
+ [ejc-sql.lib :refer [is-clob? clob-to-string clean-sql in? get->in]]
+ [ejc-sql.cache :refer [cache cache-creation-promises]]
+ [ejc-sql.connect :as c]
+ [ejc-sql.output :as o]
+ [ejc-sql.keywords :as k]))
+
+(defn- safe-query
+ "Return `sql` query result or nil in case of error."
+ [db sql & {:keys [row-fn column-name]
+ :or {row-fn identity}}]
+ (try
+ (if column-name
+ [[(keyword column-name)]
+ (mapv (keyword column-name)
+ (row-fn (j/query db (list sql) {:as-arrays? false})))]
+ (j/query db (list sql) {:as-arrays? true
+ :row-fn row-fn}))
+ (catch Exception _)))
+
+(defn- db->column
+ "Execute `sql`, return `column-name` or first column
+ (if `column-name` is not passed) of result set as result list."
+ [db sql & {:keys [row-fn column-name]
+ :or {row-fn identity}}]
+ (when sql
+ (rest (map first (safe-query db sql
+ :row-fn row-fn
+ :column-name column-name)))))
+
+(defn- db->>column
+ "Execute `sql`, return last column of result set as result list."
+ [db sql]
+ (when sql
+ (rest
+ (map last
+ (j/query db (list sql) {:as-arrays? true})))))
+
+(defn- db->value
+ "Execute `sql`, return first value of first column of result set as result."
+ [db sql & {:keys [row-fn]
+ :or {row-fn identity}}]
+ (first (db->column db sql :row-fn row-fn)))
+
+(defn get-ms-sql-server-version [ver]
+ (->
+ (filter not-empty (.split ver " "))
+ (nth 3)
+ Integer/parseInt))
+
+(defn is-modern-sql-server? [db]
+ (let [ver (db->value db "SELECT @@VERSION AS 'SQL Server Version'")]
+ (if (.startsWith ver "Microsoft SQL Azure")
+ true
+ (> (get-ms-sql-server-version ver) 2000))))
+
+(def queries
+ "Database - specific queries used for obtain data about database structure."
+ (let [default-queries
+ {:owners (fn [& _] "
+ SELECT schema_owner
+ FROM information_schema.schemata ")
+ :schemas (fn [& _] "
+ SELECT schema_name
+ FROM information_schema.schemata ")
+ :tables (fn [& {:keys [schema]}]
+ (format "
+ SELECT table_name
+ FROM information_schema.tables
+ %s
+ ORDER BY table_name "
+ (if schema
+ (format " WHERE table_schema = '%s'" schema)
+ "")))
+ :views (fn [& _] "
+ SELECT table_name
+ FROM information_schema.views ")
+ :all-tables (fn [& _] "
+ SELECT s.schema_owner, s.schema_name, t.table_name
+ FROM information_schema.schemata AS s,
+ information_schema.tables AS t
+ WHERE t.table_schema = s.schema_name ")
+ :columns (fn [& {:keys [table]}]
+ (format "
+ SELECT column_name
+ FROM information_schema.columns
+ WHERE UPPER(table_name) = '%s'
+ ORDER BY column_name "
+ (s/upper-case table)))
+ :view (fn [& {:keys [entity-name]}]
+ (format "
+ SELECT v.view_definition
+ FROM information_schema.views AS v
+ WHERE UPPER(v.table_name) = '%s' "
+ (s/upper-case entity-name)))}
+ ;;--------
+ oracle
+ ;;--------
+ {:entity (fn [& {:keys [entity-name]}]
+ (format "
+ SELECT text
+ FROM all_source
+ WHERE UPPER(name) = '%s' "
+ (s/upper-case entity-name)))
+ :entity-type (fn [& {:keys [entity-name]}]
+ (format "
+ SELECT object_type
+ FROM all_objects
+ WHERE UPPER(OBJECT_NAME) = '%s'
+ AND object_type NOT IN ('SYNONYM', 'PACKAGE BODY')
+ UNION
+ SELECT 'PROCEDURE' FROM all_procedures
+ WHERE UPPER(OBJECT_NAME) = '%s'
+ AND object_type = 'PROCEDURE'
+ AND rownum = 1"
+ (s/upper-case entity-name)
+ (s/upper-case entity-name)))
+ :view (fn [& {:keys [entity-name]}]
+ (format "
+ SELECT text
+ FROM all_views
+ WHERE UPPER(view_name) = '%s' "
+ (s/upper-case entity-name)))
+ :types (fn [& _] "
+ SELECT * FROM USER_TYPES ")
+ :owners (fn [& _] "
+ SELECT DISTINCT(owner)
+ FROM ALL_OBJECTS
+ ORDER BY owner ")
+ :tables (fn [& {:keys [owner]}]
+ (format "
+ SELECT table_name, owner
+ FROM all_tables
+ %s
+ ORDER BY table_name "
+ (if owner
+ (format " WHERE UPPER(owner) = '%s' "
+ (s/upper-case owner))
+ "")))
+ :views (fn [& {:keys [owner]}]
+ (format "
+ SELECT view_name
+ FROM all_views
+ %s
+ ORDER BY view_name "
+ (if owner
+ (format " WHERE UPPER(owner) = '%s' "
+ (s/upper-case owner))
+ "")))
+ :all-tables (fn [& _] "
+ SELECT owner, table_name
+ FROM all_tables
+ WHERE owner NOT IN ('SYS', 'SYSTEM')
+ ORDER BY owner ")
+ :columns (fn [& {:keys [table]}]
+ (format "
+ SELECT column_name
+ FROM ALL_TAB_COLUMNS
+ WHERE UPPER(table_name) = '%s' "
+ (s/upper-case table)))
+ :constraints (fn [& {:keys [owner table]}]
+ (cond
+ (and owner table)
+ (format "
+ SELECT * FROM all_constraints
+ WHERE owner = '%s'
+ AND table_name = '%s' "
+ owner table)
+ table
+ (format "
+ SELECT * FROM all_constraints
+ WHERE table_name = '%s' " table)
+ :else
+ "SELECT * FROM user_constraints"))
+ :procedures (fn [& {:keys [owner]}]
+ (format "
+ SELECT object_name, procedure_name
+ FROM all_procedures
+ %s " (if owner
+ (format "WHERE owner = '%s' " owner)
+ "")))
+ :parameters (fn [& {:keys [package entity-name]}]
+ (format "
+ SELECT data_type, argument_name
+ FROM SYS.ALL_ARGUMENTS
+ WHERE object_name = '%s'
+ AND in_out = 'IN'
+ %s "
+ (s/upper-case entity-name)
+ (if package
+ (format "AND package_name = '%s'" package)
+ "")))
+ :package (fn [& {:keys [entity-name]}]
+ ;; entity-name is a package name here
+ (format "
+ SELECT text FROM
+ (
+ SELECT text AS text,
+ 1 AS ordered,
+ line AS line
+ FROM all_source
+ WHERE UPPER(name) = '%s'
+ AND type = 'PACKAGE'
+ UNION SELECT '\n\n', 2, 1 from dual
+ UNION SELECT ' ------------------\n', 3, 1 from dual
+ UNION SELECT ' -- PACKAGE BODY --\n', 4, 1 from dual
+ UNION SELECT ' ------------------\n', 5, 1 from dual
+ UNION SELECT '\n', 6, 1 from dual
+ UNION
+ SELECT text,
+ 7,
+ line
+ FROM all_source
+ WHERE UPPER(name) = '%s'
+ AND type = 'PACKAGE BODY'
+ )
+ ORDER BY ordered, line "
+ (s/upper-case entity-name)
+ (s/upper-case entity-name)))
+ :table (fn [& {:keys [entity-name]}]
+ (format "
+ SELECT dbms_metadata.get_ddl('TABLE','%s')
+ FROM dual " (s/upper-case entity-name)))
+ :objects (fn [& _] "
+ SELECT * FROM all_objects
+ WHERE object_type IN ('FUNCTION','PROCEDURE','PACKAGE') ")
+ :keywords (fn [& _] "
+ SELECT * FROM V$RESERVED_WORDS ORDER BY keyword ")}
+ ;;--------
+ informix
+ ;;--------
+ {:owners nil
+ :tables (fn [& _] "
+ SELECT TRIM(t.tabname) as tablesList
+ FROM systables AS t
+ WHERE t.tabtype = 'T'
+ AND t.tabid >= 100
+ ORDER BY t.tabname; ")
+ :columns (fn [& {:keys [table]}]
+ (format "
+ SELECT TRIM(c.colname) AS column_name
+ FROM systables AS t, syscolumns AS c
+ WHERE t.tabid = c.tabid
+ AND t.tabtype = 'T'
+ AND t.tabid >= 100
+ AND TRIM(t.tabname) = '%s'
+ ORDER BY c.colno; " table))}
+ ;;-------
+ mysql
+ ;;-------
+ {:owners (fn [& _] "
+ SELECT schema_name
+ FROM information_schema.schemata ")
+ :tables (default-queries :tables)
+ :all-tables (fn [& _] "
+ SELECT s.schema_name, t.table_name
+ FROM information_schema.schemata AS s,
+ information_schema.tables AS t
+ WHERE t.table_schema = s.schema_name ")
+ :columns (default-queries :columns)
+ :keywords (fn [& _] "
+ SELECT name FROM mysql.help_keyword")
+ :entity-type (fn [& {:keys [entity-name]}]
+ (format "
+ SELECT routine_type
+ FROM information_schema.routines
+ WHERE UPPER(routine_name) = '%s'
+ UNION
+ SELECT 'standard-function' FROM mysql.help_topic t
+ INNER JOIN mysql.help_category AS c
+ ON c.help_category_id = t.help_category_id
+ AND c.parent_category_id IN (SELECT help_category_id
+ FROM mysql.help_category
+ WHERE name = 'Functions')
+ WHERE UPPER(t.name) = '%s'
+ UNION
+ SELECT 'table' as table_name
+ FROM information_schema.tables
+ WHERE UPPER(table_name) = '%s'"
+ (s/upper-case entity-name)
+ (s/upper-case entity-name)
+ (s/upper-case entity-name)))
+ :constraints (fn [& {:keys [owner table]}]
+ (cond
+ (and owner table)
+ (format "
+ SELECT column_name, constraint_name,
+ referenced_column_name, referenced_table_name
+ FROM information_schema.key_column_usage
+ WHERE constraint_schema = '%s'
+ AND table_name = '%s' "
+ owner table)
+ table
+ (format "
+ SELECT column_name, constraint_name,
+ referenced_column_name, referenced_table_name
+ FROM information_schema.key_column_usage
+ WHERE table_name = '%s' " table)
+ :else
+ "SELECT * FROM information_schema.key_column_usage"))
+ :procedures (fn [& _] "
+ SELECT routine_schema, routine_name
+ FROM information_schema.routines ")
+ :procedure (fn [& {:keys [entity-name]}]
+ (format "
+ SHOW CREATE PROCEDURE %s "
+ entity-name))
+ :function (fn [& {:keys [entity-name]}]
+ (format "
+ SHOW CREATE FUNCTION %s "
+ entity-name))
+ :table (fn [& {:keys [entity-name]}]
+ (format "SHOW CREATE TABLE %s " entity-name))
+ :standard-function (fn [& {:keys [entity-name]}]
+ (format "
+ SELECT description FROM mysql.help_topic
+ WHERE UPPER(name) = '%s' "
+ (s/upper-case entity-name)))
+ :parameters (fn [& {:keys [entity-name]}]
+ (format "
+ SELECT data_type, parameter_name
+ FROM information_schema.parameters
+ WHERE parameter_mode = 'IN'
+ AND UPPER(specific_name) = '%s'"
+ (s/upper-case entity-name)))}
+ ;;--------
+ h2
+ ;;--------
+ {:tables (fn [& _] ((default-queries :tables) :schema "PUBLIC"))
+ :views (default-queries :views)
+ :all-tables (fn [& _] "
+ SELECT s.schema_owner, s.schema_name, t.table_name
+ FROM information_schema.schemata AS s,
+ information_schema.tables AS t
+ WHERE t.table_schema = s.schema_name
+ AND LCASE(s.schema_name) != 'information_schema' ")
+ :columns (default-queries :columns)
+ :keywords (fn [& _]
+ "SELECT topic FROM information_schema.help")
+ :entity-type (fn [& {:keys [entity-name]}]
+ (format "
+ SELECT t.table_type
+ FROM information_schema.tables AS t
+ WHERE UPPER(t.table_name) = '%s' "
+ (s/upper-case entity-name)))
+ :table (fn [& {:keys [entity-name]}]
+ (format "
+ SELECT sql
+ FROM INFORMATION_SCHEMA.TABLES
+ WHERE TABLE_NAME = '%s' "
+ (s/upper-case entity-name)))
+ :view (fn [& {:keys [entity-name]}]
+ ((default-queries :view) :entity-name entity-name))}
+ ;;--------
+ sqlite
+ ;;--------
+ {:tables (fn [& _] "SELECT name FROM sqlite_master WHERE type='table'")
+ :views (fn [& _] "SELECT name FROM sqlite_master WHERE type='view'")
+ :all-tables (fn [& _] "SELECT name FROM sqlite_master WHERE type='table'")
+ :columns (fn [& {:keys [table]}]
+ (format "
+ SELECT p.name as columnName
+ FROM sqlite_master m
+ LEFT OUTER JOIN pragma_table_info((m.name)) p
+ ON m.name <> p.name
+ WHERE m.name = '%s'
+ ORDER BY columnName " table))
+ :keywords (:sqlite k/keywords)
+ :entity-type (fn [& {:keys [entity-name]}]
+ (format "
+ SELECT type FROM sqlite_master
+ WHERE UPPER(name) = '%s' "
+ (s/upper-case entity-name)))
+ :view (fn [& {:keys [entity-name]}]
+ (format "
+ SELECT sql FROM sqlite_master
+ WHERE UPPER(name) = '%s' "
+ (s/upper-case entity-name)))}
+ ;;-------
+ 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]}]
+ (format "
+ SELECT type_desc AS constraint_type,
+ name
+ FROM sys.objects
+ WHERE type_desc LIKE '%CONSTRAINT'
+ AND OBJECT_NAME(parent_object_id)='%s' " table))
+ :entity (fn [& {:keys [db entity-name]}]
+ (if (is-modern-sql-server? db)
+ (format "
+ SELECT definition
+ FROM sys.objects o
+ JOIN sys.sql_modules m ON m.object_id = o.object_id
+ WHERE o.object_id = object_id('%s') " entity-name)
+ (format "
+ SELECT c.text
+ FROM sysobjects o
+ JOIN syscomments c ON c.id = o.id
+ WHERE o.name = '%s' " entity-name)))}
+ ;;-------
+ postgresql
+ ;;-------
+ {:procedure (fn [& {:keys [entity-name]}]
+ (format "
+ SELECT pg_get_functiondef(p.oid)
+ FROM pg_catalog.pg_proc p
+ WHERE upper(p.proname) = '%s' "
+ (s/upper-case entity-name)))
+ :table (fn [& {:keys [entity-name]}]
+ (format "
+ SELECT 'CREATE TABLE %s (\n' ||
+ string_agg(column_list.column_expr, ', \n') ||
+ '\n);'
+ FROM (
+ SELECT ' ' || column_name || ' ' || data_type ||
+ coalesce('(' || character_maximum_length || ')', '') ||
+ case when is_nullable = 'YES'
+ then ''
+ else ' NOT NULL'
+ end as column_expr
+ FROM information_schema.columns
+ WHERE table_schema = 'public'
+ AND upper(table_name) = '%s'
+ ORDER BY ordinal_position) column_list"
+ entity-name
+ (s/upper-case entity-name)))
+ :owners (default-queries :owners)
+ :schemas (default-queries :schemas)
+ :tables (default-queries :tables)
+ :all-tables (default-queries :all-tables)
+ :columns (default-queries :columns)
+ :procedures (fn [& _] "
+ SELECT p.proname
+ FROM pg_catalog.pg_namespace n
+ JOIN pg_catalog.pg_proc p
+ ON p.pronamespace = n.oid
+ ORDER BY proname ")
+ :entity-type (fn [& {:keys [entity-name]}]
+ (format "
+ SELECT 'namespace'
+ FROM pg_catalog.pg_namespace n
+ WHERE upper(n.nspname) = '%s'
+ UNION
+ SELECT 'table'
+ FROM information_schema.tables
+ WHERE upper(table_name) = '%s'
+ UNION
+ SELECT 'view'
+ FROM information_schema.views
+ WHERE upper(table_name) = '%s'
+ UNION
+ SELECT 'procedure'
+ FROM pg_catalog.pg_namespace n
+ JOIN pg_catalog.pg_proc p
+ ON p.pronamespace = n.oid
+ WHERE upper(p.proname) = '%s' "
+ (s/upper-case entity-name)
+ (s/upper-case entity-name)
+ (s/upper-case entity-name)
+ (s/upper-case entity-name)))
+ :parameters (fn [& {:keys [entity-name]}]
+ (format "
+ SELECT pg_catalog.pg_get_function_identity_arguments(
+ p.oid)
+ FROM pg_catalog.pg_proc p
+ WHERE p.proname = '%s'" entity-name))
+ :keywords (fn [& _]
+ "SELECT word FROM pg_get_keywords()")}]
+ {:oracle oracle
+ :informix informix
+ :mysql mysql
+ :mariadb mysql
+ :h2 h2
+ :sqlite sqlite
+ :sqlserver sqlserver
+ :postgresql postgresql}))
+
+(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
+ (if connection-uri
+ (second (.split
+ (let [props-list (.split connection-uri ";")]
+ (first
+ (filter
+ (fn [prop]
+ (=
+ "user"
+ (.toLowerCase (first (.split prop "=")))))
+ props-list))) "="))
+ :undefined-user)))))
+
+(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?]]
+ (when (and obj (or force? (realized? obj)))
+ @obj))
+
+(defn get-this-owner
+ "Return current owner/schema."
+ [db & [owner]]
+ (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 (is-modern-sql-server? db)
+ ;; 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
+ "Return SQL request to obtain some database structure info."
+ [db meta-type &
+ {:keys [owner
+ table
+ package
+ entity-name]}]
+ (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 (when sql-receiver
+ (sql-receiver :db db
+ :owner owner
+ :schema owner
+ :table table
+ :package package
+ :entity-name entity-name
+ :db-name (get-db-name db)))]
+ sql))
+
+(defn get-namespace
+ "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`"
+ [db]
+ (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-or-create-cache
+ "Fill `cache` atom with database structure data, then get data from it.
+ Parameters:
+ - `db` - database connection map
+ - `path` - the keys used to define the place to store data in `cache` atom
+ - `sql` - query to obtain the desired data from the database
+ - `force?` - when true, eval `sql` immediately and return data
+ - `direct-value` - sometimes there is no need to eval `sql` to obtain some
+ data,and value of this parameter, if it's defined, can be
+ used as-is
+ - `exec-fn` - SQL execution function (`db->column` by default)
+ - `filter-fn` - filer function applied to SQL execution results
+ - `handler-fn` - additional processing applied to SQL execution results."
+ [& {:keys [db
+ path
+ sql
+ force?
+ direct-value
+ exec-fn
+ filter-fn
+ handler-fn]
+ :or {exec-fn db->column}}]
+ (let [full-path (into [db] path)]
+ (if (not (get->in @cache full-path))
+ (let [flat-path [db (keyword (s/join "-" (map name path)))]
+ c-promise (promise)]
+ (swap! cache-creation-promises assoc-in flat-path c-promise)
+ (swap! cache assoc-in full-path
+ (if direct-value
+ (future (deliver c-promise :ok)
+ direct-value)
+ (future (try
+ (let [result (exec-fn db sql)
+ result (distinct result)
+ result (if filter-fn
+ (filter filter-fn result)
+ result)
+ result (if handler-fn
+ (mapv handler-fn result)
+ result)
+ result (if (vector? result)
+ (sort result)
+ result)]
+ (deliver c-promise :ok)
+ result)
+ (catch Exception e
+ (deliver c-promise e)
+ (list))))))))
+ (get? (get-in @cache full-path) force?)))
+
+(defn get-owners
+ "Return owners list from cache if already received from DB,
+ check if receiveing process is not running, then start it."
+ [db & [force?]]
+ (let [namespace (get-namespace db)]
+ (if namespace
+ (get-or-create-cache :db db
+ :path [namespace]
+ :sql (select-db-meta-script db namespace)
+ :force? force?)
+ ;; Schemas or owners are not applicable to this database type.
+ (list))))
+
+(defn get-tables
+ "Return tables list for this owner from cache if already received from DB,
+ check if receiveing process is not running, then start it."
+ [db & [owner_ force?]]
+ (let [owner (get-this-owner db owner_)]
+ (if owner_
+ (get-or-create-cache :db db
+ :path [:tables owner]
+ :sql (select-db-meta-script db :tables :owner owner)
+ :force? force?)
+ (get-or-create-cache :db db
+ :path [:all-tables]
+ :sql (select-db-meta-script db :all-tables)
+ :force? force?
+ :exec-fn db->>column))))
+
+(defn get-views
+ "Return views list from cache if already received from DB,
+ check if receiveing process is not running, then start it."
+ [db & [owner_ force?]]
+ (let [owner (get-this-owner db owner_)]
+ (get-or-create-cache :db db
+ :path [:views owner]
+ :sql (select-db-meta-script db :views :owner owner)
+ :force? force?)))
+
+(defn get-colomns
+ "Return colomns list for this table from cache if already received from DB,
+ check if receiveing process is not running, then start it."
+ [db table force?]
+ (when (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 (distinct (db->column db sql)))))
+ db table))))
+ (get? (get->in @cache [db :colomns table])
+ force?))
+
+(def postgresql-type-aliases
+ "Some of PostgreSQL type aliases used for show in eldoc."
+ {"character varying" "varchar"
+ "bit varying" "varbit"})
+
+(defn get-parameters
+ "Return parameters list of `stored-procedure` from cache if already received
+ from DB, check if receiveing process is not running, then start it."
+ [db package stored-procedure & [force?]]
+ (let [db-type (get-db-type db)]
+ (get-or-create-cache
+ :db db
+ :path (if package
+ [:stored-procedures package stored-procedure]
+ [:stored-procedures stored-procedure])
+ :sql (select-db-meta-script db :parameters
+ :package package
+ :entity-name stored-procedure)
+ :force? force?
+ :exec-fn
+ (case db-type
+ :postgresql (fn [db sql]
+ ;; Use only first possible list of parameters if many.
+ (list (db->value db sql)))
+ :mysql (fn [db sql]
+ (list (rest (safe-query db sql))))
+ :oracle (fn [db sql]
+ (list
+ (map
+ (fn [[param-type param-name]]
+ (format "%s %s" param-type param-name))
+ (rest
+ (safe-query db
+ sql
+ :row-fn identity
+ :column-name nil)))))
+ nil)
+ :handler-fn
+ (case db-type
+ :postgresql (fn [types]
+ (map
+ (fn [type]
+ (let [type (s/trim type)]
+ (or (postgresql-type-aliases type)
+ type)))
+ (s/split types #",")))
+ :mysql (fn [types]
+ (map #(s/join " " %) types))
+ nil))))
+
+(defn get-keywords
+ "Return keywords list for this database type from cache if already received
+ from DB, check if receiveing process is not running, then start it."
+ [db force?]
+ (when-let [keywords-query (get-in queries [(get-db-type db) :keywords])]
+ (get-or-create-cache :db db
+ :path [:keywords]
+ :direct-value (when (vector? keywords-query)
+ keywords-query)
+ :sql (select-db-meta-script db :keywords)
+ :force? force?
+ :filter-fn #(not (nil? %)))))
+
+(defn get-packages
+ "Return packages list for this owner from cache if already received from DB,
+ check if receiveing process is not running, then start it."
+ [db & [owner_ force?]]
+ (let [owner (get-this-owner db owner_)]
+ (get-or-create-cache :db db
+ :path [:packages owner]
+ :sql (select-db-meta-script db :procedures
+ :owner owner)
+ :force? force?)))
+
+(defn is-owner? [db prefix]
+ (in? (get-owners db) prefix :case-sensitive false))
+
+(clomacs-defn
+ complete-auto-complete
+ 'ejc-complete-auto-complete
+ :doc "Call Emacs auto-complete if point is the same as before loading.")
+
+(defn run-autocomplete [db buffer-name point]
+ (future
+ ;; Wait for all cache building promises ready.
+ (mapv deref (vals (get-in @cache-creation-promises [db])))
+ ;; Remove them from memory.
+ (swap! cache-creation-promises assoc-in [db] nil)
+ ;; Pass to Emacs a note that db structure cache ready (try to autocomplete).
+ (complete-auto-complete buffer-name point)))
+
+(defn autocomplete-loading
+ "Not loaded tables yet. Output pending db structure data..."
+ ([db buffer-name point]
+ (run-autocomplete db buffer-name point)
+ (autocomplete-loading))
+ ([]
+ (list "t")))
+
+(defn autocomplete-result
+ "Output autocomplete result."
+ [result]
+ (cons "nil" result))
+
+(defn autocomplete-nothing
+ "Output autocomplete nothing."
+ []
+ (list "nil"))
+
+(defn get-owners-candidates
+ "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."
+ [& {:keys [db sql prefix-1 buffer-name point]}]
+ (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 db buffer-name point)))))
+
+(defn get-tables-candidates
+ "Return tables candidates autocomplete list."
+ [& {:keys [db sql prefix-1 buffer-name point]}]
+ (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 get-views-candidates
+ "Return views candidates autocomplete list."
+ [& {:keys [db sql prefix-1 buffer-name point]}]
+ (if-let [views (if (not prefix-1)
+ ;; something#
+ (get-views db)
+ (if (is-owner? db prefix-1)
+ ;; [owner].#<views-list>
+ (get-views db prefix-1)
+ ;; owners still pending or
+ ;; unknown?.# case
+ (list)))]
+ (autocomplete-result views)
+ ;; pending views...
+ (autocomplete-loading)))
+
+(defn get-packages-candidates
+ "Return packages candidates autocomplete list."
+ [& {:keys [db sql buffer-name point]}]
+ (if-let [packages (get-packages db)]
+ (autocomplete-result packages)
+ ;; pending packages...
+ (autocomplete-loading)))
+
+(defn match-alias?
+ "Check if prefix (`probable-alias`) is alias for `table` in this `sql`."
+ [sql owner table probable-alias]
+ (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
+ "Get all tables for all owners/schemas."
+ [db]
+ (or (get-tables db nil true)
+ (flatten
+ (mapv #(get-tables db % true)
+ (distinct (get-owners db true))))))
+
+(def select-re
+ (re-pattern (str "(?i)\\s*SELECT\\s+(.*\\s+)?FROM\\s+(\\S+)")))
+
+(defn select-sql?
+ "If `sql` is SELECT query, return a table name used in FROM clause.
+ Otherwise return nil."
+ [sql]
+ (nth (re-find select-re sql) 2))
+
+(def insert-re
+ (re-pattern (str "(?i)\\s*INSERT\\s+INTO\\s+(\\S+)\\s+")))
+
+(defn insert-sql?
+ "If `sql` is INSERT query, return a table name used to insert new records.
+ Otherwise return nil."
+ [sql]
+ (second (re-find insert-re sql)))
+
+(def update-re
+ (re-pattern (str "(?i)\\s*UPDATE\\s(\\S+)\\s+\n*SET.*")))
+
+(defn update-sql?
+ "If `sql` is UPDATE query, return a table name used to modify the existing
+ records. Otherwise return nil."
+ [sql]
+ (second (re-find update-re sql)))
+
+(defn get-colomns-candidates
+ "Return colomns candidates autocomplete list."
+ [& {:keys [db sql prefix-1 prefix-2
+ buffer-name point]}]
+ ;; 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 (concat
+ (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)))
+ (get-views 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 (select-sql? sql)
+ (insert-sql? sql)
+ (update-sql? sql))]
+ (cond
+ (and (not-empty insert-or-update-table)
+ (in? tables-list insert-or-update-table
+ :case-sensitive false))
+ ;; SELECT # FROM table
+ ;; or
+ ;; 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 (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 (when 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-entity-type
+ "Determine DB entity type, whether it is a `:view`, `:type`,
+ `:package`, `:namespace` or `:procedure`."
+ [db entity-name]
+ (when-let [sql (and entity-name
+ (select-db-meta-script db :entity-type
+ :entity-name entity-name))]
+ (when-let [found-type (db->value db sql)]
+ (-> (.split found-type " ")
+ first
+ s/lower-case
+ keyword))))
+
+(defn get-entity-type-fmt [db entity-name]
+ (clomacs/format-result (get-entity-type db entity-name)))
+
+(def creation-headers
+ {:oracle {:view (fn [db view]
+ (format "CREATE OR REPLACE VIEW %%s\n(%s)\nAS\n%%s"
+ (s/join ", "
+ (map #(-> % :name s/lower-case)
+ (:result
+ (c/query-meta db view))))))
+ :package (fn [db _] "CREATE OR REPLACE %2$s\n")}})
+
+(defn add-creation-header [db entity-type entity-name sql]
+ (let [db-type (get-db-type db)]
+ (if-let [header-creator (get-in creation-headers [db-type entity-type])]
+ (let [header-format (header-creator db entity-name)]
+ (format header-format entity-name sql))
+ sql)))
+
+(defn get-entity-description
+ "Get DB entity creation SQL.
+ Database entity types:
+ - `:table`
+ - `:view`
+ - `:package`
+ - `:function`
+ - `:procedure`
+ - `:standard-function`."
+ [& {:keys [db
+ connection-name
+ prefix
+ entity-name
+ result-file]}]
+ (let [sql-object (or prefix entity-name)
+ db-type (get-db-type db)]
+ (if-let [type (get-entity-type db sql-object)]
+ (if (and prefix (= :namespace type))
+ ;; Omit prefix if it's a `:namespace`.
+ (get-entity-description :db db
+ :connection-name connection-name
+ :prefix nil
+ :entity-name entity-name
+ :result-file result-file)
+ (if-let [entity-obtainig-sql (select-db-meta-script
+ db
+ type
+ :entity-name sql-object)]
+ (if-let [entity-sql (s/join
+ ""
+ (db->column
+ db
+ entity-obtainig-sql
+ :row-fn (fn [row]
+ (mapv #(if (is-clob? %)
+ (clob-to-string %)
+ %)
+ row))
+ :column-name
+ (case (get-db-type db)
+ :mysql (case type
+ :function "create function"
+ :procedure "create procedure"
+ :table "create table"
+ nil)
+ nil)))]
+ (c/complete (o/unify-str
+ (add-creation-header
+ db
+ type
+ sql-object
+ (o/format-sql-if-required entity-sql)))
+ :mode (if (and (= type :standard-function)
+ (= db-type :mysql))
+ 'rst-mode
+ 'sql-mode)
+ :connection-name connection-name
+ :db db
+ :result-file result-file
+ :goto-symbol (when prefix entity-name))
+ (c/complete (format "Can't find %s named %s."
+ (name type) sql-object)
+ :result-file result-file))
+ (c/complete (format (str "Script for obtaining DB entity of type %s "
+ "was not added for this database type.")
+ (name type))
+ :result-file result-file)))
+ (c/complete (format "Can't determine type of %s." sql-object)
+ :result-file result-file))))
+
+(defn print-table-meta [db table-name]
+ (let [result-map (c/table-meta db table-name)
+ success (:success result-map)
+ result-data (:result result-map)]
+ (if success
+ (do (println (format "Table \"%s\" description:" table-name))
+ (println)
+ (o/print-maps result-data true))
+ (println result-data))
+ success))
+
+(defn describe-table [& {:keys [db
+ connection-name
+ table
+ owner
+ result-file
+ add-outside-borders]}]
+ (with-open [out (io/writer result-file)]
+ (binding [*out* out
+ o/*add-outside-borders* add-outside-borders]
+ (when (print-table-meta db (if owner (str owner "." table) table))
+ (when-let [sql (select-db-meta-script db :constraints
+ :owner owner
+ :table table)]
+ (println)
+ (println "Constraints:")
+ (println)
+ (o/print-table (second
+ (first
+ (c/eval-sql-core :db db
+ :sql-list (list sql)
+ :fetch-size 0
+ :max-rows 0))))))))
+ (c/complete
+ nil
+ :display-result true
+ :connection-name connection-name
+ :db db
+ :result-file result-file))
+++ /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