From 89b9b0d764ac99e5584c569866d15be79cc3b595 Mon Sep 17 00:00:00 2001 From: Phil Estival Date: Tue, 7 Jan 2025 04:23:59 +0100 Subject: [PATCH 4/5] lisp/ob-sql.el: block execution changes to support sessions --- lisp/ob-sql.el | 308 +++++++++++++++++++++++++++++-------------------- 1 file changed, 184 insertions(+), 124 deletions(-) diff --git a/lisp/ob-sql.el b/lisp/ob-sql.el index 970363f7d..ee6eea5cd 100644 --- a/lisp/ob-sql.el +++ b/lisp/ob-sql.el @@ -298,96 +298,144 @@ database connections." (cdr (assoc-string dbconnection sql-connection-alist t)))))))) (defun org-babel-execute:sql (body params) - "Execute a block of Sql code with Babel. + "Execute a block of SQL code in BODY with PARAMS. This function is called by `org-babel-execute-src-block'." (let* ((result-params (cdr (assq :result-params params))) - (cmdline (cdr (assq :cmdline params))) - (dbhost (org-babel-find-db-connection-param params :dbhost)) - (dbport (org-babel-find-db-connection-param params :dbport)) - (dbuser (org-babel-find-db-connection-param params :dbuser)) + (engine (cdr (assq :engine params))) + (in-engine (intern (or engine (user-error "Missing :engine")))) + (dbhost (org-babel-find-db-connection-param params :dbhost)) + (dbport (org-babel-find-db-connection-param params :dbport)) + (dbuser (org-babel-find-db-connection-param params :dbuser)) (dbpassword (org-babel-find-db-connection-param params :dbpassword)) (dbinstance (org-babel-find-db-connection-param params :dbinstance)) - (database (org-babel-find-db-connection-param params :database)) - (engine (cdr (assq :engine params))) + (database (org-babel-find-db-connection-param params :database)) (colnames-p (not (equal "no" (cdr (assq :colnames params))))) (in-file (org-babel-temp-file "sql-in-")) (out-file (or (cdr (assq :out-file params)) (org-babel-temp-file "sql-out-"))) - (header-delim "") - (command (cl-case (intern engine) - (dbi (format "dbish --batch %s < %s | sed '%s' > %s" - (or cmdline "") - (org-babel-process-file-name in-file) - "/^+/d;s/^|//;s/(NULL)/ /g;$d" - (org-babel-process-file-name out-file))) - (monetdb (format "mclient -f tab %s < %s > %s" - (or cmdline "") - (org-babel-process-file-name in-file) - (org-babel-process-file-name out-file))) - (mssql (format "sqlcmd %s -s \"\t\" %s -i %s -o %s" - (or cmdline "") - (org-babel-sql-dbstring-mssql - dbhost dbuser dbpassword database) - (org-babel-sql-convert-standard-filename - (org-babel-process-file-name in-file)) - (org-babel-sql-convert-standard-filename - (org-babel-process-file-name out-file)))) - (mysql (format "mysql %s %s %s < %s > %s" - (org-babel-sql-dbstring-mysql - dbhost dbport dbuser dbpassword database) - (if colnames-p "" "-N") - (or cmdline "") - (org-babel-process-file-name in-file) - (org-babel-process-file-name out-file))) - ((postgresql postgres) - (format - "%s%s --set=\"ON_ERROR_STOP=1\" %s -A -P \ + (session (cdr (assoc :session params))) + (session-p (not (string= session "none"))) + (header-delim "")) + + (setq org-babel-sql-out-file out-file) + + (if (or session-p org-babel-sql-run-comint-p) + ;; run through comint + (let ((sql--buffer + (org-babel-sql-session-connect in-engine params session))) + (with-current-buffer (get-buffer-create "*ob-sql-result*") + (erase-buffer)) + (setq org-babel-sql-session-start-time (current-time)) + (setq ob-sql-session-command-terminated nil) + + (with-current-buffer (get-buffer sql--buffer) + (process-send-string (current-buffer) + (ob-sql-session-format-query + body + ;;(org-babel-expand-body:sql body params) + )) + ;; todo: check org-babel-comint-async-register + (while (not ob-sql-session-command-terminated) + ;; could there be a race condition here as described in (elisp) Accepting Output? + (sleep-for 0.03)) + ;; command finished, remove filter + (set-process-filter (get-buffer-process sql--buffer) nil) + + (when (not session-p) + (comint-quit-subjob) + ;; despite this quit, the process may not be finished yet + (let ((kill-buffer-query-functions nil)) + (kill-this-buffer)))) + + ;; get results + (with-current-buffer (get-buffer-create "*ob-sql-result*") + (goto-char (point-min)) + ;; clear the output or prompt and termination + (while (re-search-forward + (sql-get-product-feature in-engine :ob-sql-session-clean-output) + nil t) + (replace-match "")) + (write-file out-file))) + + ;; else, command line + (let* ((cmdline (cdr (assq :cmdline params))) + (command + (cl-case in-engine + (dbi (format "dbish --batch %s < %s | sed '%s' > %s" + (or cmdline "") + (org-babel-process-file-name in-file) + "/^+/d;s/^|//;s/(NULL)/ /g;$d" + (org-babel-process-file-name out-file))) + (sqlite (format "sqlite3 < %s > %s" + (org-babel-process-file-name in-file) + (org-babel-process-file-name out-file))) + (monetdb (format "mclient -f tab %s < %s > %s" + (or cmdline "") + (org-babel-process-file-name in-file) + (org-babel-process-file-name out-file))) + (mssql (format "sqlcmd %s -s \"\t\" %s -i %s -o %s" + (or cmdline "") + (org-babel-sql-dbstring-mssql + dbhost dbuser dbpassword database) + (org-babel-sql-convert-standard-filename + (org-babel-process-file-name in-file)) + (org-babel-sql-convert-standard-filename + (org-babel-process-file-name out-file)))) + (mysql (format "mysql %s %s %s < %s > %s" + (org-babel-sql-dbstring-mysql + dbhost dbport dbuser dbpassword database) + (if colnames-p "" "-N") + (or cmdline "") + (org-babel-process-file-name in-file) + (org-babel-process-file-name out-file))) + ((postgresql postgres) (format + "%s%s --set=\"ON_ERROR_STOP=1\" %s -A -P \ footer=off -F \"\t\" %s -f %s -o %s %s" - (if dbpassword - (format "PGPASSWORD=%s " - (shell-quote-argument dbpassword)) - "") - (or (bound-and-true-p - sql-postgres-program) - "psql") - (if colnames-p "" "-t") - (org-babel-sql-dbstring-postgresql - dbhost dbport dbuser database) - (org-babel-process-file-name in-file) - (org-babel-process-file-name out-file) - (or cmdline ""))) - (sqsh (format "sqsh %s %s -i %s -o %s -m csv" - (or cmdline "") - (org-babel-sql-dbstring-sqsh - dbhost dbuser dbpassword database) - (org-babel-sql-convert-standard-filename - (org-babel-process-file-name in-file)) - (org-babel-sql-convert-standard-filename - (org-babel-process-file-name out-file)))) - (vertica (format "vsql %s -f %s -o %s %s" - (org-babel-sql-dbstring-vertica - dbhost dbport dbuser dbpassword database) - (org-babel-process-file-name in-file) - (org-babel-process-file-name out-file) - (or cmdline ""))) - (oracle (format - "sqlplus -s %s < %s > %s" - (org-babel-sql-dbstring-oracle - dbhost dbport dbuser dbpassword database) - (org-babel-process-file-name in-file) - (org-babel-process-file-name out-file))) - (saphana (format "hdbsql %s -I %s -o %s %s" - (org-babel-sql-dbstring-saphana - dbhost dbport dbinstance dbuser dbpassword database) - (org-babel-process-file-name in-file) - (org-babel-process-file-name out-file) - (or cmdline ""))) - (t (user-error "No support for the %s SQL engine" engine))))) - (with-temp-file in-file - (insert - (pcase (intern engine) - (`dbi "/format partbox\n") - (`oracle "SET PAGESIZE 50000 + (if dbpassword + (format "PGPASSWORD=%s " + (shell-quote-argument dbpassword)) + "") + (or (bound-and-true-p + sql-postgres-program) + "psql") + (if colnames-p "" "-t") + (org-babel-sql-dbstring-postgresql + dbhost dbport dbuser database) + (org-babel-process-file-name in-file) + (org-babel-process-file-name out-file) + (or cmdline ""))) + (sqsh (format "sqsh %s %s -i %s -o %s -m csv" + (or cmdline "") + (org-babel-sql-dbstring-sqsh + dbhost dbuser dbpassword database) + (org-babel-sql-convert-standard-filename + (org-babel-process-file-name in-file)) + (org-babel-sql-convert-standard-filename + (org-babel-process-file-name out-file)))) + (vertica (format "vsql %s -f %s -o %s %s" + (org-babel-sql-dbstring-vertica + dbhost dbport dbuser dbpassword database) + (org-babel-process-file-name in-file) + (org-babel-process-file-name out-file) + (or cmdline ""))) + (oracle (format + "sqlplus -s %s < %s > %s" + (org-babel-sql-dbstring-oracle + dbhost dbport dbuser dbpassword database) + (org-babel-process-file-name in-file) + (org-babel-process-file-name out-file))) + (saphana (format "hdbsql %s -I %s -o %s %s" + (org-babel-sql-dbstring-saphana + dbhost dbport dbinstance dbuser dbpassword database) + (org-babel-process-file-name in-file) + (org-babel-process-file-name out-file) + (or cmdline ""))) + (t (user-error "No support for the %s SQL engine" engine))))) + (with-temp-file in-file + (insert + (pcase (intern engine) + (`dbi "/format partbox\n") + (`oracle "SET PAGESIZE 50000 SET NEWPAGE 0 SET TAB OFF SET SPACE 0 @@ -401,56 +449,68 @@ SET MARKUP HTML OFF SPOOL OFF SET COLSEP '|' ") - ((or `mssql `sqsh) "SET NOCOUNT ON + ((or `mssql `sqsh) "SET NOCOUNT ON ") - (`vertica "\\a\n") - (_ "")) - (org-babel-expand-body:sql body params) - ;; "sqsh" requires "go" inserted at EOF. - (if (string= engine "sqsh") "\ngo" ""))) - (org-babel-eval command "") - (org-babel-result-cond result-params - (with-temp-buffer - (progn (insert-file-contents-literally out-file) (buffer-string))) - (with-temp-buffer + (`vertica "\\a\n") + (_ "")) + (org-babel-expand-body:sql body params) + ;; "sqsh" requires "go" inserted at EOF. + (if (string= engine "sqsh") "\ngo" ""))) + (org-babel-eval command "")))) + + (org-babel-result-cond result-params ; collect results + (with-temp-buffer + (progn (insert-file-contents-literally out-file) (buffer-string))) + (with-temp-buffer + (cond + ((memq in-engine '(dbi sqlite mysql postgresql postgres saphana sqsh vertica)) + ;; Add header row delimiter after column-names header in first line (cond - ((memq (intern engine) '(dbi mysql postgresql postgres saphana sqsh vertica)) - ;; Add header row delimiter after column-names header in first line - (cond - (colnames-p - (with-temp-buffer - (insert-file-contents out-file) - (goto-char (point-min)) - (forward-line 1) - (insert "-\n") - (setq header-delim "-") - (write-file out-file))))) - (t - ;; Need to figure out the delimiter for the header row + (colnames-p (with-temp-buffer (insert-file-contents out-file) (goto-char (point-min)) - (when (re-search-forward "^\\(-+\\)[^-]" nil t) - (setq header-delim (match-string-no-properties 1))) + (forward-line 1) + (insert "-\n") + (setq header-delim "-") + (write-file out-file))))) + (t + ;; Need to figure out the delimiter for the header row + (with-temp-buffer + (insert-file-contents out-file) + (goto-char (point-min)) + (when (re-search-forward "^\\(-+\\)[^-]" nil t) + (setq header-delim (match-string-no-properties 1))) + (goto-char (point-max)) + (forward-char -1) + (while (looking-at "\n") + (delete-char 1) (goto-char (point-max)) - (forward-char -1) - (while (looking-at "\n") - (delete-char 1) - (goto-char (point-max)) - (forward-char -1)) - (write-file out-file)))) - (org-table-import out-file (if (string= engine "sqsh") '(4) '(16))) - (org-babel-reassemble-table - (mapcar (lambda (x) - (if (string= (car x) header-delim) - 'hline - x)) - (org-table-to-lisp)) - (org-babel-pick-name (cdr (assq :colname-names params)) - (cdr (assq :colnames params))) - (org-babel-pick-name (cdr (assq :rowname-names params)) - (cdr (assq :rownames params)))))))) + (forward-char -1)) + (write-file out-file)))) + + (when session-p + (goto-char (point-min)) + ;; clear the output of prompt and termination + (while (re-search-forward + (sql-get-product-feature in-engine :ob-sql-session-clean-output) + nil t) + (replace-match ""))) + + (org-table-import out-file (if (string= engine "sqsh") '(4) '(16))) + (when org-babel-sql-close-out-temp-buffer-p + (kill-buffer (get-file-buffer out-file))) + (org-babel-reassemble-table + (mapcar (lambda (x) + (if (string= (car x) header-delim) + 'hline + x)) + (org-table-to-lisp)) + (org-babel-pick-name (cdr (assq :colname-names params)) + (cdr (assq :colnames params))) + (org-babel-pick-name (cdr (assq :rowname-names params)) + (cdr (assq :rownames params)))))))) (defun org-babel-prep-session:sql (_session _params) "Raise an error because Sql sessions aren't implemented." -- 2.39.5