From: Andreas Gerler Date: Tue, 19 Apr 2022 08:41:41 +0000 (+0200) Subject: add ejc-sql X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=a1b8142c8ec6c9a4786dc86a1d866931b503f800;p=emacsconfig.git add ejc-sql Signed-off-by: Andreas Gerler --- diff --git a/elpa/ejc-sql-20220414.1329/ejc-autocomplete.el b/elpa/ejc-sql-20220414.1329/ejc-autocomplete.el new file mode 100644 index 00000000..208c0da1 --- /dev/null +++ b/elpa/ejc-sql-20220414.1329/ejc-autocomplete.el @@ -0,0 +1,129 @@ +;;; ejc-autocomplete.el -- SQL completitions at point by auto-complete (the part of ejc-sql). + +;;; Copyright © 2013-2020 - Kostafey + +;;; 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 diff --git a/elpa/ejc-sql-20220414.1329/ejc-company.el b/elpa/ejc-sql-20220414.1329/ejc-company.el new file mode 100644 index 00000000..527379a6 --- /dev/null +++ b/elpa/ejc-sql-20220414.1329/ejc-company.el @@ -0,0 +1,91 @@ +;;; ejc-company.el -- SQL completitions at point by company-mode (the part of ejc-sql). + +;;; Copyright © 2020 - Kostafey + +;;; 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 diff --git a/elpa/ejc-sql-20220414.1329/ejc-completion-common.el b/elpa/ejc-sql-20220414.1329/ejc-completion-common.el new file mode 100644 index 00000000..96a25cc3 --- /dev/null +++ b/elpa/ejc-sql-20220414.1329/ejc-completion-common.el @@ -0,0 +1,165 @@ +;;; ejc-completion-common.el -- SQL completitions common functionality (the part of ejc-sql). + +;;; Copyright © 2020 - Kostafey + +;;; 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 diff --git a/elpa/ejc-sql-20220414.1329/ejc-direx.el b/elpa/ejc-sql-20220414.1329/ejc-direx.el new file mode 100644 index 00000000..dec1488c --- /dev/null +++ b/elpa/ejc-sql-20220414.1329/ejc-direx.el @@ -0,0 +1,197 @@ +;;; ejc-direx.el + +;;; Copyright © 2017 - Kostafey + +;;; 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 diff --git a/elpa/ejc-sql-20220414.1329/ejc-doc.el b/elpa/ejc-sql-20220414.1329/ejc-doc.el new file mode 100644 index 00000000..84f696ca --- /dev/null +++ b/elpa/ejc-sql-20220414.1329/ejc-doc.el @@ -0,0 +1,91 @@ +;;; ejc-doc.el -- SQL quick hints documentation (the part of ejc-sql). + +;;; Copyright © 2018-2019 - Kostafey + +;;; 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 { ADD | ALTER } [ COLUMN ] + ; +ALTER TABLE { DROP } [ COLUMN ] + ; + +-- change table constraints +ALTER TABLE { ADD | ALTER } CONSTRAINT + ; +ALTER TABLE { DROP } CONSTRAINT + ;" + 'distinct + "Return different values") + (setq ejc-doc-created-p t)) + +(provide 'ejc-doc) + +;;; ejc-doc.el ends here diff --git a/elpa/ejc-sql-20220414.1329/ejc-eldoc.el b/elpa/ejc-sql-20220414.1329/ejc-eldoc.el new file mode 100644 index 00000000..3057ca8b --- /dev/null +++ b/elpa/ejc-sql-20220414.1329/ejc-eldoc.el @@ -0,0 +1,143 @@ +;;; ejc-eldoc.el -- ejc-sql eldoc support (the part of ejc-sql). + +;;; Copyright (C) 2019 - Kostafey + +;;; 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 diff --git a/elpa/ejc-sql-20220414.1329/ejc-flx.el b/elpa/ejc-sql-20220414.1329/ejc-flx.el new file mode 100644 index 00000000..2bb98a38 --- /dev/null +++ b/elpa/ejc-sql-20220414.1329/ejc-flx.el @@ -0,0 +1,103 @@ +;;; ejc-flx.el -- Customization flx for ejc (the part of ejc-sql). + +;;; Copyright © 2018 - Kostafey + +;;; 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 diff --git a/elpa/ejc-sql-20220414.1329/ejc-format.el b/elpa/ejc-sql-20220414.1329/ejc-format.el new file mode 100644 index 00000000..a0957ace --- /dev/null +++ b/elpa/ejc-sql-20220414.1329/ejc-format.el @@ -0,0 +1,302 @@ +;;; ejc-format.el -- SQL formatting library (the part of ejc-sql). + +;;; Copyright © 2012-2019 - Kostafey + +;;; 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 diff --git a/elpa/ejc-sql-20220414.1329/ejc-interaction.el b/elpa/ejc-sql-20220414.1329/ejc-interaction.el new file mode 100644 index 00000000..f6f0be5e --- /dev/null +++ b/elpa/ejc-sql-20220414.1329/ejc-interaction.el @@ -0,0 +1,342 @@ +;;; ejc-interaction.el -- ejc-sql interact with Clojure. -*- lexical-binding: t -*- + +;;; Copyright © 2013-2020 - Kostafey + +;;; 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 diff --git a/elpa/ejc-sql-20220414.1329/ejc-lib.el b/elpa/ejc-sql-20220414.1329/ejc-lib.el new file mode 100644 index 00000000..3f0425e7 --- /dev/null +++ b/elpa/ejc-sql-20220414.1329/ejc-lib.el @@ -0,0 +1,171 @@ +;;; ejc-lib.el -- ejc-sql shared objects (the part of ejc-sql). + +;;; Copyright © 2013-2020 - Kostafey + +;;; 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 diff --git a/elpa/ejc-sql-20220414.1329/ejc-result-buffer.el b/elpa/ejc-sql-20220414.1329/ejc-result-buffer.el new file mode 100644 index 00000000..acfd696e --- /dev/null +++ b/elpa/ejc-sql-20220414.1329/ejc-result-buffer.el @@ -0,0 +1,202 @@ +;;; ejc-result-buffer.el + +;;; Copyright © 2019-2020 - Kostafey + +;;; 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 diff --git a/elpa/ejc-sql-20220414.1329/ejc-result-mode.el b/elpa/ejc-sql-20220414.1329/ejc-result-mode.el new file mode 100644 index 00000000..3f849c7f --- /dev/null +++ b/elpa/ejc-sql-20220414.1329/ejc-result-mode.el @@ -0,0 +1,51 @@ +;;; ejc-result-mode.el + +;;; Copyright © 2017-2020 - Kostafey + +;;; 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 diff --git a/elpa/ejc-sql-20220414.1329/ejc-sql-autoloads.el b/elpa/ejc-sql-20220414.1329/ejc-sql-autoloads.el new file mode 100644 index 00000000..3f13aa29 --- /dev/null +++ b/elpa/ejc-sql-20220414.1329/ejc-sql-autoloads.el @@ -0,0 +1,236 @@ +;;; 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)))) + + +;;;### (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")) + +;;;*** + +;;;### (autoloads nil "ejc-company" "ejc-company.el" (0 0 0 0)) +;;; Generated autoloads from ejc-company.el + +(register-definition-prefixes "ejc-company" '("ejc-company-")) + +;;;*** + +;;;### (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-")) + +;;;*** + +;;;### (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:")) + +;;;*** + +;;;### (autoloads nil "ejc-doc" "ejc-doc.el" (0 0 0 0)) +;;; Generated autoloads from ejc-doc.el + +(register-definition-prefixes "ejc-doc" '("ejc-")) + +;;;*** + +;;;### (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-")) + +;;;*** + +;;;### (autoloads nil "ejc-flx" "ejc-flx.el" (0 0 0 0)) +;;; Generated autoloads from ejc-flx.el + +(register-definition-prefixes "ejc-flx" '("ejc-")) + +;;;*** + +;;;### (autoloads nil "ejc-format" "ejc-format.el" (0 0 0 0)) +;;; Generated autoloads from ejc-format.el + +(register-definition-prefixes "ejc-format" '("ejc-")) + +;;;*** + +;;;### (autoloads nil "ejc-interaction" "ejc-interaction.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from ejc-interaction.el + +(register-definition-prefixes "ejc-interaction" '("ejc-")) + +;;;*** + +;;;### (autoloads nil "ejc-lib" "ejc-lib.el" (0 0 0 0)) +;;; Generated autoloads from ejc-lib.el + +(register-definition-prefixes "ejc-lib" '("ejc-")) + +;;;*** + +;;;### (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-")) + +;;;*** + +;;;### (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-")) + +;;;*** + +;;;### (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-') 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-")) + +;;;*** + +;;;### (autoloads nil nil ("ejc-sql-pkg.el") (0 0 0 0)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8 +;; End: +;;; ejc-sql-autoloads.el ends here diff --git a/elpa/ejc-sql-20220414.1329/ejc-sql-pkg.el b/elpa/ejc-sql-20220414.1329/ejc-sql-pkg.el new file mode 100644 index 00000000..2d093006 --- /dev/null +++ b/elpa/ejc-sql-20220414.1329/ejc-sql-pkg.el @@ -0,0 +1,16 @@ +(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" . "kostafey@gmail.com")) + :maintainer + '("Kostafey" . "kostafey@gmail.com") + :keywords + '("sql" "jdbc") + :url "https://github.com/kostafey/ejc-sql") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/ejc-sql-20220414.1329/ejc-sql.el b/elpa/ejc-sql-20220414.1329/ejc-sql.el new file mode 100644 index 00000000..cc61da06 --- /dev/null +++ b/elpa/ejc-sql-20220414.1329/ejc-sql.el @@ -0,0 +1,883 @@ +;;; ejc-sql.el --- Emacs SQL client uses Clojure JDBC. -*- lexical-binding: t -*- + +;;; Copyright © 2012-2020 - Kostafey + +;; Author: Kostafey +;; 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 "") #'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-') 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 diff --git a/elpa/ejc-sql-20220414.1329/project.clj b/elpa/ejc-sql-20220414.1329/project.clj new file mode 100644 index 00000000..f7f0d493 --- /dev/null +++ b/elpa/ejc-sql-20220414.1329/project.clj @@ -0,0 +1,13 @@ +(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"]]) diff --git a/elpa/ejc-sql-20220414.1329/snippets/sql-mode/alter.yasnippet b/elpa/ejc-sql-20220414.1329/snippets/sql-mode/alter.yasnippet new file mode 100644 index 00000000..77a047ed --- /dev/null +++ b/elpa/ejc-sql-20220414.1329/snippets/sql-mode/alter.yasnippet @@ -0,0 +1,6 @@ +# -*- mode: snippet -*- +# name: altertable +# key: altertable +# -- +ALTER TABLE ${1:table} + ADD ${2:column_name} ${3:column_definition} diff --git a/elpa/ejc-sql-20220414.1329/snippets/sql-mode/begin.snippet b/elpa/ejc-sql-20220414.1329/snippets/sql-mode/begin.snippet new file mode 100644 index 00000000..346dff8b --- /dev/null +++ b/elpa/ejc-sql-20220414.1329/snippets/sql-mode/begin.snippet @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: begin +# key: begin +# -- +BEGIN + $0 +END; \ No newline at end of file diff --git a/elpa/ejc-sql-20220414.1329/snippets/sql-mode/delete.yasnippet b/elpa/ejc-sql-20220414.1329/snippets/sql-mode/delete.yasnippet new file mode 100644 index 00000000..27cc2af9 --- /dev/null +++ b/elpa/ejc-sql-20220414.1329/snippets/sql-mode/delete.yasnippet @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: delete +# key: delete +# -- +DELETE FROM ${1:table_name} WHERE ${2:where_stmt} \ No newline at end of file diff --git a/elpa/ejc-sql-20220414.1329/snippets/sql-mode/grant.yasnippet b/elpa/ejc-sql-20220414.1329/snippets/sql-mode/grant.yasnippet new file mode 100644 index 00000000..42611f4c --- /dev/null +++ b/elpa/ejc-sql-20220414.1329/snippets/sql-mode/grant.yasnippet @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: grant +# key: grant +# -- +GRANT ALL PRIVILEGES + ON ${1:object_type} + TO ${2:user}; \ No newline at end of file diff --git a/elpa/ejc-sql-20220414.1329/snippets/sql-mode/inner.yasnippet b/elpa/ejc-sql-20220414.1329/snippets/sql-mode/inner.yasnippet new file mode 100644 index 00000000..44e85d94 --- /dev/null +++ b/elpa/ejc-sql-20220414.1329/snippets/sql-mode/inner.yasnippet @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: inner +# key: inner +# -- +INNER JOIN ${1:table_name} ON $2 \ No newline at end of file diff --git a/elpa/ejc-sql-20220414.1329/snippets/sql-mode/insert.yasnippet b/elpa/ejc-sql-20220414.1329/snippets/sql-mode/insert.yasnippet new file mode 100644 index 00000000..b38c3ebb --- /dev/null +++ b/elpa/ejc-sql-20220414.1329/snippets/sql-mode/insert.yasnippet @@ -0,0 +1,6 @@ +# -*- mode: snippet -*- +# name: insert +# key: insert +# -- +INSERT INTO ${1:table_name} (${2:column1}, ${3:column2}) +VALUES ($0value1, value2) \ No newline at end of file diff --git a/elpa/ejc-sql-20220414.1329/snippets/sql-mode/left.yasnippet b/elpa/ejc-sql-20220414.1329/snippets/sql-mode/left.yasnippet new file mode 100644 index 00000000..aa0d7277 --- /dev/null +++ b/elpa/ejc-sql-20220414.1329/snippets/sql-mode/left.yasnippet @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: left +# key: left +# -- +LEFT JOIN ${1:table_name} ON $2 \ No newline at end of file diff --git a/elpa/ejc-sql-20220414.1329/snippets/sql-mode/revoke.yasnippet b/elpa/ejc-sql-20220414.1329/snippets/sql-mode/revoke.yasnippet new file mode 100644 index 00000000..2fa27e7e --- /dev/null +++ b/elpa/ejc-sql-20220414.1329/snippets/sql-mode/revoke.yasnippet @@ -0,0 +1,7 @@ +# -*- mode: snippet -*- +# name: revoke +# key: revoke +# -- +REVOKE ALL PRIVILEGES + ON ${1:object_type} + FROM ${2:user}; \ No newline at end of file diff --git a/elpa/ejc-sql-20220414.1329/snippets/sql-mode/right.yasnippet b/elpa/ejc-sql-20220414.1329/snippets/sql-mode/right.yasnippet new file mode 100644 index 00000000..fef03b27 --- /dev/null +++ b/elpa/ejc-sql-20220414.1329/snippets/sql-mode/right.yasnippet @@ -0,0 +1,5 @@ +# -*- mode: snippet -*- +# name: right +# key: right +# -- +RIGHT JOIN ${1:table_name} ON $2 \ No newline at end of file diff --git a/elpa/ejc-sql-20220414.1329/snippets/sql-mode/select.yasnippet b/elpa/ejc-sql-20220414.1329/snippets/sql-mode/select.yasnippet new file mode 100644 index 00000000..4e5fe935 --- /dev/null +++ b/elpa/ejc-sql-20220414.1329/snippets/sql-mode/select.yasnippet @@ -0,0 +1,7 @@ +# -*- 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 diff --git a/elpa/ejc-sql-20220414.1329/snippets/sql-mode/update.yasnippet b/elpa/ejc-sql-20220414.1329/snippets/sql-mode/update.yasnippet new file mode 100644 index 00000000..5f15e73f --- /dev/null +++ b/elpa/ejc-sql-20220414.1329/snippets/sql-mode/update.yasnippet @@ -0,0 +1,7 @@ +# -*- 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 diff --git a/elpa/ejc-sql-20220414.1329/snippets/sql-mode/where.yasnippet b/elpa/ejc-sql-20220414.1329/snippets/sql-mode/where.yasnippet new file mode 100644 index 00000000..13d87f2f --- /dev/null +++ b/elpa/ejc-sql-20220414.1329/snippets/sql-mode/where.yasnippet @@ -0,0 +1,5 @@ +# -*- 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 diff --git a/elpa/ejc-sql-20220414.1329/src/ejc_sql/cache.clj b/elpa/ejc-sql-20220414.1329/src/ejc_sql/cache.clj new file mode 100644 index 00000000..89a86258 --- /dev/null +++ b/elpa/ejc-sql-20220414.1329/src/ejc_sql/cache.clj @@ -0,0 +1,84 @@ +;;; cache.clj -- Keep database stucture cache. + +;;; Copyright © 2019 - Kostafey + +;;; 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)) diff --git a/elpa/ejc-sql-20220414.1329/src/ejc_sql/classpath.clj b/elpa/ejc-sql-20220414.1329/src/ejc_sql/classpath.clj new file mode 100644 index 00000000..311b7944 --- /dev/null +++ b/elpa/ejc-sql-20220414.1329/src/ejc_sql/classpath.clj @@ -0,0 +1,66 @@ +;; 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 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/elpa/ejc-sql-20220414.1329/src/ejc_sql/connect.clj b/elpa/ejc-sql-20220414.1329/src/ejc_sql/connect.clj new file mode 100644 index 00000000..4ce4019d --- /dev/null +++ b/elpa/ejc-sql-20220414.1329/src/ejc_sql/connect.clj @@ -0,0 +1,335 @@ +;;; connect.clj -- Core clojure functions for ejc-sql emacs extension. + +;;; Copyright © 2013-2019 - Kostafey + +;;; 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(? @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))) diff --git a/elpa/ejc-sql-20220414.1329/src/ejc_sql/deps_resolver.clj b/elpa/ejc-sql-20220414.1329/src/ejc_sql/deps_resolver.clj new file mode 100644 index 00000000..2911400c --- /dev/null +++ b/elpa/ejc-sql-20220414.1329/src/ejc_sql/deps_resolver.clj @@ -0,0 +1,67 @@ +;;; deps_resolver.clj -- Discover required jar artifacts. + +;;; Copyright © 2020 - Kostafey + +;;; 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))) diff --git a/elpa/ejc-sql-20220414.1329/src/ejc_sql/keywords.clj b/elpa/ejc-sql-20220414.1329/src/ejc_sql/keywords.clj new file mode 100644 index 00000000..6b4ae77c --- /dev/null +++ b/elpa/ejc-sql-20220414.1329/src/ejc_sql/keywords.clj @@ -0,0 +1,38 @@ +;;; keywords.clj -- Keep database-specific keywords. + +;;; Copyright © 2019 - Kostafey + +;;; 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"]}) diff --git a/elpa/ejc-sql-20220414.1329/src/ejc_sql/lib.clj b/elpa/ejc-sql-20220414.1329/src/ejc_sql/lib.clj new file mode 100644 index 00000000..3b5496f0 --- /dev/null +++ b/elpa/ejc-sql-20220414.1329/src/ejc_sql/lib.clj @@ -0,0 +1,139 @@ +;;; lib.clj -- Misc clojure functions for ejc-sql emacs extension. + +;;; Copyright © 2013-2019 - Kostafey + +;;; 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)) diff --git a/elpa/ejc-sql-20220414.1329/src/ejc_sql/output.clj b/elpa/ejc-sql-20220414.1329/src/ejc_sql/output.clj new file mode 100644 index 00000000..86fa9950 --- /dev/null +++ b/elpa/ejc-sql-20220414.1329/src/ejc_sql/output.clj @@ -0,0 +1,310 @@ +;;; output.clj -- Output & formatting clojure functions for ejc-sql. + +;;; Copyright © 2013-2019 - Kostafey + +;;; 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)) diff --git a/elpa/ejc-sql-20220414.1329/src/ejc_sql/structure.clj b/elpa/ejc-sql-20220414.1329/src/ejc_sql/structure.clj new file mode 100644 index 00000000..547f4a64 --- /dev/null +++ b/elpa/ejc-sql-20220414.1329/src/ejc_sql/structure.clj @@ -0,0 +1,1149 @@ +;;; structure.clj -- Receive database stucture and keep it in cache. + +;;; Copyright © 2016-2019 - Kostafey + +;;; 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.# 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].# + (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].# + (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.# + ;; 2. SELECT alias.# FROM [owner|schema.]table AS alias + ;; 3. SELECT complex-alias.# 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.# + (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.# + (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.# + (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)) diff --git a/elpa/ejc-sql-readme.txt b/elpa/ejc-sql-readme.txt new file mode 100644 index 00000000..4875dd4d --- /dev/null +++ b/elpa/ejc-sql-readme.txt @@ -0,0 +1,4 @@ +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.