--- /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"))
+
+(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 'lowercase (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-direx.el
+
+;;; Copyright © 2017 - Kostafey <kostafeyNOSPAMgmail.com>
+
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software Foundation,
+;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
+
+;;; Code:
+
+
+(require 'dash)
+(require 'direx)
+(require 'ejc-interaction)
+
+(defgroup ejc-direx nil
+ "Database structure visualisation tree."
+ :group 'ejc
+ :prefix "ejc-direx")
+
+
+;;; Core
+
+(defclass ejc-direx:object (direx:tree) ((cache :initarg :cache)))
+(defclass ejc-direx:database (ejc-direx:object direx:node)
+ ((buffer :initarg :buffer)
+ (file-name :initarg :file-name
+ :accessor direx:file-full-name)))
+(defclass ejc-direx:schema (ejc-direx:object direx:node) ())
+(defclass ejc-direx:table (ejc-direx:object direx:node) ())
+(defclass ejc-direx:colomn (ejc-direx:object direx:leaf) ())
+
+(defvar ejc-direx:type-class-map
+ '(("database" . ejc-direx:database)
+ ("schema" . ejc-direx:schema)
+ ("table" . ejc-direx:table)
+ ("column" . ejc-direx:colomn)))
+
+(defun ejc-direx:node-from-cache (cache)
+ (let* ((type (plist-get (car cache) :type))
+ (class (or (assoc-default type ejc-direx:type-class-map)
+ 'ejc-direx:colomn)))
+ (make-instance class
+ :cache cache
+ :name (plist-get (car cache) :name))))
+
+(defun ejc-direx:-filter-cache (items)
+ "Filter out cache items according to configuration."
+ (delq nil items))
+
+(defmethod direx:node-children ((node ejc-direx:object))
+ (mapcar 'ejc-direx:node-from-cache
+ (ejc-direx:-filter-cache (cdr (oref node :cache)))))
+
+
+;;; Face
+(defface ejc-direx:database
+ '((t :inherit font-lock-keyword-face))
+ "Face for database name in direx tree"
+ :group 'ejc-direx)
+
+(defface ejc-direx:schema
+ '((t :inherit font-lock-type-face))
+ "Face for schema name in direx tree"
+ :group 'ejc-direx)
+
+(defface ejc-direx:table
+ '((t :inherit font-lock-function-name-face))
+ "Face for table name in direx tree"
+ :group 'ejc-direx)
+
+(defface ejc-direx:colomn
+ '((t :inherit font-lock-variable-name-face))
+ "Face for column name in direx tree"
+ :group 'ejc-direx)
+
+
+;;; View
+
+(defclass ejc-direx:item (direx:item) ())
+
+(defmethod direx:make-item ((tree ejc-direx:object) parent)
+ (make-instance 'ejc-direx:item :tree tree :parent parent))
+
+(defmethod direx:make-item ((tree ejc-direx:colomn) parent)
+ (let ((item (call-next-method)))
+ (oset item :face 'ejc-direx:colomn)
+ item))
+
+(defmethod direx:make-item ((tree ejc-direx:table) parent)
+ (let ((item (call-next-method)))
+ (oset item :face 'ejc-direx:table)
+ item))
+
+(defmethod direx:make-item ((tree ejc-direx:schema) parent)
+ (let ((item (call-next-method)))
+ (oset item :face 'ejc-direx:schema)
+ item))
+
+(defmethod direx:make-item ((tree ejc-direx:database) parent)
+ (let ((item (call-next-method)))
+ (oset item :face 'ejc-direx:database)
+ item))
+
+(defun direx-ejc:-goto-item (item)
+ (destructuring-bind (&key line_nr column &allow-other-keys)
+ (car (oref (direx:item-tree item) :cache))
+ (ejc:goto--line-column line_nr column)))
+
+(defmethod direx:generic-find-item ((item ejc-direx:item)
+ not-this-window)
+ (let* ((root (direx:item-root item))
+ (filename (direx:file-full-name (direx:item-tree root))))
+ (if not-this-window
+ (find-file-other-window filename)
+ (find-file filename))
+ (direx-ejc:-goto-item item)))
+
+(defmethod direx:generic-display-item ((item ejc-direx:item))
+ (let* ((root (direx:item-root item))
+ (filename (direx:file-full-name (direx:item-tree root))))
+ (with-selected-window (display-buffer (find-file-noselect filename))
+ (direx-ejc:-goto-item item))))
+
+(defvar ejc-direx:item-refresh--recurring nil)
+
+(defun ejc-direx:get-structure ()
+ "Provide data - database structure for direx tree."
+ (cl-labels ((column-item (column)
+ (list :type "column" :name column))
+ (table-item (table)
+ (let ((columns
+ (ejc-get-cached-colomns-list ejc-db table t)))
+ (cons (list :type "table" :name table)
+ (-map 'list
+ (-map #'column-item columns)))))
+ (schema-item (schema)
+ (let ((tables (ejc-get-cached-tables-list
+ ejc-db schema t)))
+ (cons (list :type "schema" :name schema)
+ (-map #'table-item tables)))))
+ ;; Assume schema == owner (difference depends on exact database type).
+ (if-let ((schemas (ejc-get-cached-owners-list ejc-db t)))
+ (-map #'schema-item schemas)
+ (-map #'table-item (ejc-get-cached-tables-list ejc-db nil t)))))
+
+(defmethod direx:item-refresh ((item ejc-direx:item) &key recursive)
+ "Currently it always recursively refreshes whole tree."
+ (if ejc-direx:item-refresh--recurring
+ (call-next-method)
+ (let* ((ejc-direx:item-refresh--recurring t)
+ (root (direx:item-root item))
+ (module (direx:item-tree root)))
+ (if (with-current-buffer (oref module :buffer)
+ (unless (eq (cdr (oref module :cache)) (ejc-direx:get-structure))
+ (oset module :cache (cons nil (ejc-direx:get-structure)))))
+ (call-next-method root :recursive t)
+ (message "No need to refresh")))))
+
+
+;;; Command
+
+(defun ejc-direx:make-buffer ()
+ (let ((current-ejc-db ejc-db)
+ (buf (direx:ensure-buffer-for-root
+ (make-instance 'ejc-direx:database
+ :name (format "%s" (ejc-get-db-name ejc-db))
+ :buffer (current-buffer)
+ :file-name (buffer-file-name)
+ :cache (cons nil (ejc-direx:get-structure))))))
+ (with-current-buffer buf
+ (setq-local ejc-db current-ejc-db))
+ buf))
+
+;;;###autoload
+(defun ejc-direx:pop-to-buffer ()
+ (interactive)
+ (pop-to-buffer (ejc-direx:make-buffer)))
+
+;;;###autoload
+(defun ejc-direx:switch-to-buffer ()
+ (interactive)
+ (switch-to-buffer (ejc-direx:make-buffer)))
+
+(provide 'ejc-direx)
+
+;;; ejc-direx.el ends here
--- /dev/null
+;;; ejc-doc.el -- SQL quick hints documentation (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-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 's)
+(require 'dash)
+
+(defvar-local ejc-connection-name nil
+ "Buffer-local connection name created with `ejc-create-connection'.")
+
+(defvar-local ejc-connection-struct nil
+ "Buffer-local connection structure.")
+
+(defun ejc-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)
+
+(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))))
+
+;;;###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
+ (display-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)
+ (display-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-direx" "ejc-direx.el" (0 0 0 0))
+;;; Generated autoloads from ejc-direx.el
+
+(autoload 'ejc-direx:pop-to-buffer "ejc-direx" nil t nil)
+
+(autoload 'ejc-direx:switch-to-buffer "ejc-direx" nil t nil)
+
+(register-definition-prefixes "ejc-direx" '("direx" "ejc-direx:"))
+
+;;;***
+\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" "20220414.1329" "Emacs SQL client uses Clojure JDBC."
+ '((emacs "26.3")
+ (clomacs "0.0.5")
+ (dash "2.16.0")
+ (spinner "1.7.3")
+ (direx "1.0.0"))
+ :commit "5c6341c751da9c7dbed43eafc8e99f456c1de0d2" :authors
+ '(("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")(direx "1.0.0"))
+
+;; This file is not part of GNU Emacs.
+
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software Foundation,
+;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
+
+;;; Commentary:
+
+;; ejc-sql turns Emacs into simple SQL client, it uses JDBC connection to
+;; databases via clojure/java.jdbc lib.
+
+;; See README.md for detailed description.
+
+;;; Code:
+
+(require 'sql)
+(require 'dash)
+(require 'cl-lib)
+(require 'org-table)
+(require 'ejc-lib)
+(require 'ejc-direx)
+(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 'ido
+ "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 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)
+ (auto-fill-mode t)
+ (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.9.0"]
+ [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.4-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 - 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
+ (:use [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]
+ (if-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-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.connect
+ (:use [clojure.java.io]
+ [ejc-sql.lib]
+ [ejc-sql.cache]
+ [clomacs])
+ (:require [clojure.java.jdbc :as j]
+ [clojure.java.io :as io]
+ [clojure.string :as s]
+ [ejc-sql.output :as o])
+ (:import [java.sql Connection
+ DriverManager
+ PreparedStatement
+ ResultSet
+ SQLException]
+ [java.io File]))
+
+(def db
+ "DataBase connection properties list from the last transaction.
+For debug purpose."
+ (atom nil))
+
+(def current-query
+ "Current running query data."
+ (atom {}))
+
+(defn set-db [ejc-db]
+ (reset! db ejc-db))
+
+(defn 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
+ (if (is-statement-not-closed?)
+ (let [conn (:conn @current-query)]
+ (try
+ (.rollback conn)
+ (finally
+ (.close conn)))))
+ (if (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")]
+ (if (ddl? sql)
+ (invalidate-cache db))
+ (list :message msg)))
+ (catch SQLException e
+ (list :message
+ (o/unify-str "Error: " (.getMessage e))))))
+
+(defn- eval-user-sql [db sql & {:keys [rows-limit
+ fetch-size
+ append
+ display-result
+ result-file]}]
+ "Receive raw SQL from the user, log it, divide by statements and eval them."
+ (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]
+ (not (empty?
+ (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]]
+ (= 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-type 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))))]
+ (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 - 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
+ (:use
+ [leiningen.core.project :only [default-repositories]])
+ (:require
+ [cemerick.pomegranate.aether :as aether]))
+
+(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 e
+ 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-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.output
+ (:use clojure.java.io
+ ejc-sql.lib)
+ (:require [clojure.string :as s])
+ (:import (java.io File)
+ (java.lang.reflect Method)
+ (java.util Date)
+ (java.text SimpleDateFormat)
+ (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 (clojure.java.io/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 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)
+ (if @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] (if-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
+ (count (first headers))
+ (if (string? cell-value)
+ (map count (s/split cell-value rn))
+ (list (count (str cell-value)))))))
+ (for [col (rotate-table (conj rows headers))]
+ (apply max (map #(count (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 (str "%-" (first widths) "s") "%s")
+ (map #(str "%-" % "s") widths))
+ fmt-row (fn [leader divider trailer row]
+ (str leader
+ (apply str (interpose
+ divider
+ (for [[col fmt] (map vector row fmts)]
+ (format fmt (str col)))))
+ trailer))]
+ (when (not-empty msg)
+ (println msg)
+ (println))
+ (if (not rotated)
+ (do
+ (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-2019 - Kostafey <kostafeyNOSPAMgmail.com>
+
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software Foundation,
+;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
+
+(ns ejc-sql.structure
+ (:use [ejc-sql.lib]
+ [ejc-sql.cache]
+ [clomacs])
+ (:require
+ [clojure.java.jdbc :as j]
+ [clojure.string :as s]
+ [clojure.java.io :as io]
+ [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 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)))})
+
+(def queries
+ "Database - specific queries used for obtain data about database structure."
+ {
+ ;;--------
+ :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 dba_procedures
+ WHERE UPPER(PROCEDURE_NAME) = '%s'
+ 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'"
+ (s/upper-case entity-name)
+ (s/upper-case entity-name)))
+ :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))
+ :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()")}})
+
+;; Use the same database introspection queries for MariaDB as for MySQL.
+(def queries (assoc queries :mariadb (queries :mysql)))
+
+(defn autocomplete-available-for-db? [db-type]
+ (queries db-type))
+
+(defn get-db-name [db]
+ (let [{:keys [database subname connection-uri dbname]} db]
+ (or dbname
+ database
+ (if subname
+ (let [separator (if (= (first (.split subname "/")) subname)
+ ":" "/")
+ raw-db-name (last (.split subname separator))
+ raw-db-name (first (.split raw-db-name "\\?"))
+ raw-db-name (first (.split raw-db-name ";"))]
+ raw-db-name)
+ ;; No subname - parse connection-uri
+ (let [props-list (.split connection-uri ";")
+ db-name-prop (first
+ (filter
+ (fn [prop]
+ (=
+ "databasename"
+ (.toLowerCase (first (.split prop "=")))))
+ props-list))]
+ (if db-name-prop
+ ;; "databaseName=my_db_name;"
+ (second (.split db-name-prop "="))
+ ;; "jdbc:jtds:sqlserver://localhost:1433/my_db_name;"
+ (last (.split (first props-list) "/"))))))))
+
+(defn get-user [db]
+ (or
+ (:user db)
+ (let [{:keys [user connection-uri]} db]
+ (or user
+ (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 (if 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?]
+ (if-let [keywords-query (get-in queries [(get-db-type db) :keywords])]
+ (get-or-create-cache :db db
+ :path [:keywords]
+ :direct-value (if (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 (if complex-alias
+ (subs complex-alias 1
+ (.lastIndexOf complex-alias ")")))]
+ (if complex-alias
+ (let [{:keys [success result]} (c/query-meta db complex-alias)]
+ (if success
+ ;; complex-alias.#<colomns-list>
+ (autocomplete-result (mapv :name result))
+ ;; Can't execute "blah blah" to get metadata in
+ ;; "SELECT t.# FROM (blah blah) AS t" case.
+ (autocomplete-nothing)))
+ ;; unknown?.# case
+ ;; nothing to complete
+ (autocomplete-nothing))))))))))
+
+(defn get-entity-type
+ "Determine DB entity type, whether it is a `:view`, `:type`,
+ `:package`, `:namespace` or `:procedure`."
+ [db entity-name]
+ (if-let [sql (and entity-name
+ (select-db-meta-script db :entity-type
+ :entity-name entity-name))]
+ (if-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"
+ 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 (if 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-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