* [2024-12-13 18:46] Ihor Radchenko:
Phil Estival <[email protected]> writes:this patch modifies ob-sql to add support for session.Before I start a more detailed preview, may you please: 1. Rebase your changes onto main (development) branch. This is where the new features are added. See https://orgmode.org/worg/org-maintenance.html#branches 2. Get rid of whitespace-only commits. See https://orgmode.org/worg/org-contribute.html#orge765e69 3. If possible, add a commit message to each patch in the series. It will make things easier for me during the review, as I will have an idea about the general purpose of each patch in the series.
Hello. Here we go again. Also, in the commit message of the patch for the tests, I mention that some macros should probably be moved upward in a file where generic functions which purposes are to help writing the tests of babel source blocks should be declared (ob-src-testfuncs.el for instance). Examples : - result-should-contain (regexp block) : Checking that REGEXP(s) matches the command executed when evaluating BLOCK. - result-should-not-contain (regexp block) - result-equals (str block) and so on. Cheers, Phil
From a84099e373203e29dd3a77e5cd4f4efb5f1613a7 Mon Sep 17 00:00:00 2001 From: Phil Estival <[email protected]> Date: Tue, 7 Jan 2025 03:37:03 +0100 Subject: [PATCH 1/5] lisp/ob-sql.el: new functions and variables for session support * ob-sql.el: introduces new functions and variables for session support and configure features for postgres and sqlite3. --- lisp/ob-sql.el | 285 +++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 279 insertions(+), 6 deletions(-) diff --git a/lisp/ob-sql.el b/lisp/ob-sql.el index 14ca6bc48..f94bb1272 100644 --- a/lisp/ob-sql.el +++ b/lisp/ob-sql.el @@ -4,6 +4,7 @@ ;; Author: Eric Schulte ;; Maintainer: Daniel Kraus <[email protected]> +;; Maintainer: Philippe Estival <[email protected]> ;; Keywords: literate programming, reproducible research ;; URL: https://orgmode.org @@ -46,6 +47,7 @@ ;; - colnames (default, nil, means "yes") ;; - result-params ;; - out-file +;; - session ;; ;; The following are used but not really implemented for SQL: ;; - colname-names @@ -54,6 +56,7 @@ ;; ;; Engines supported: ;; - mysql +;; - sqlite3 ;; - dbi ;; - mssql ;; - sqsh @@ -62,12 +65,13 @@ ;; - vertica ;; - saphana ;; -;; TODO: +;; Limitation: +;; - no error line number in session mode ;; -;; - support for sessions +;; TODO: ;; - support for more engines ;; - what's a reasonable way to drop table data into SQL? -;; +;; - babel tables as input ;;; Code: @@ -75,6 +79,32 @@ (org-assert-version) (require 'ob) +(require 'sql) + +(defvar ob-sql-session--batch-end-indicator "---#" "Indicate the end of a command batch.") +(defvar ob-sql-session-command-terminated nil) +(defvar org-babel-sql-out-file) +(defvar org-babel-sql-session-start-time) + +(sql-set-product-feature 'sqlite :prompt-regexp "sqlite> ") +(sql-set-product-feature 'sqlite :batch-terminate + (format ".print %s\n" ob-sql-session--batch-end-indicator)) +(sql-set-product-feature 'sqlite :terminal-command "\\.") + +(sql-set-product-feature 'postgres :prompt-regexp "SQL> ") +(sql-set-product-feature 'postgres :prompt-cont-regexp "> ") +(sql-set-product-feature 'postgres :batch-terminate + (format "\\echo %s\n" ob-sql-session--batch-end-indicator)) +(sql-set-product-feature 'postgres :terminal-command "\\\\") +(sql-set-product-feature 'postgres :environment '(("PGPASSWORD" sql-password))) +(sql-set-product-feature + 'postgres :sqli-options + (list "--set=ON_ERROR_STOP=1" + (format "--set=PROMPT1=%s" (sql-get-product-feature 'postgres :prompt-regexp )) + (format "--set=PROMPT2=%s" (sql-get-product-feature 'postgres :prompt-cont-regexp )) + "-P" "pager=off" + "-P" "footer=off" + "-A" )) (declare-function org-table-import "org-table" (file arg)) (declare-function orgtbl-to-csv "org-table" (table params)) @@ -85,6 +115,24 @@ (defvar sql-connection-alist) (defvar org-babel-default-header-args:sql '()) +(defcustom org-babel-sql-run-comint-p 'nil + "Run non-session SQL commands through comoint (or command line if nil)." + :type '(boolean) + :group 'org-babel-sql + :safe t) + +(defcustom org-babel-sql-timeout '5.0 + "Abort on timeout." + :type '(number) + :group 'org-babel-sql + :safe t) + +(defcustom org-babel-sql-close-out-temp-buffer-p 'nil + "Close sql-out-temp buffer." + :type '(boolean) + :group 'org-babel-sql + :safe t) + (defconst org-babel-header-args:sql '((engine . :any) (out-file . :any) @@ -399,6 +447,234 @@ SET COLSEP '|' (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." + (message "org-babel-prep-session")) + +(defun org-babel-load-session:sql (session body params) + (message "load session %s" session)) + +(defun ob-sql-session-buffer-live-p (buffer) + "Return non-nil if the process associated with buffer is live. + +This redefines `sql-buffer-live-p' of sql.el, considering the terminal +is valid even when `sql-interactive-mode' isn't set. BUFFER can be a buffer +object or a buffer name. The buffer must be a live buffer, have a +running process attached to it, and, if PRODUCT or CONNECTION are +specified, its `sql-product' or `sql-connection' must match." + + (let ((buffer (get-buffer buffer))) + (and buffer + (buffer-live-p buffer) + (let ((proc (get-buffer-process buffer))) + (and proc (memq (process-status proc) '(open run))))))) + +(defun org-babel-sql-session-connect (in-engine params session) + "Start the SQL client of IN-ENGINE if it has not. +PARAMS provides the sql connection parameters for a new or +existing SESSION. Clear the intermediate buffer from previous +output, and set the process filter. Return the comint process +buffer. + +The buffer naming was shortened from +*[session] engine://user@host/database*, +that clearly identifies the connexion from Emacs, +to *SQL [session]* in order to retrieve a session with its +name alone, the other parameters in the header args beeing +no longer needed while the session stays open." + (sql-set-product in-engine) + (let* ( (sql-server (cdr (assoc :dbhost params))) + ;; (sql-port (cdr (assoc :port params))) + (sql-database (cdr (assoc :database params))) + (sql-user (cdr (assoc :dbuser params))) + (sql-password (cdr (assoc :dbpassword params))) + (buffer-name (format "%s" (if (string= session "none") "" + (format "[%s]" session)))) + ;; (buffer-name + ;; (format "%s%s://%s%s/%s" + ;; (if (string= session "none") "" (format "[%s] " session)) + ;; engine + ;; (if sql-user (concat sql-user "@") "") + ;; (if sql-server (concat sql-server ":") "") + ;; sql-database)) + (ob-sql-buffer (format "*SQL: %s*" buffer-name))) + + ;; I get a nil on sql-for-each-login on the first call + ;; to sql-interactive at + ;; (if (sql-buffer-live-p ob-sql-buffer) + ;; so put sql-buffer-live-p aside + (if (ob-sql-session-buffer-live-p ob-sql-buffer) + (progn ; set again the filter + (set-process-filter (get-buffer-process ob-sql-buffer) + #'ob-sql-session-comint-output-filter) + ob-sql-buffer) ; and return the buffer + ;; otherwise initiate a new connection + (save-window-excursion + (setq ob-sql-buffer ; start the client + (ob-sql-connect in-engine buffer-name))) + (let ((sql-term-proc (get-buffer-process ob-sql-buffer))) + (unless sql-term-proc + (user-error (format "SQL %s didn't start" in-engine))) + + ;; clear the welcoming message out of the output from the + ;; first command, in the case where we forgot quiet mode. + ;; we can't evaluate how long the connection will take + ;; so if quiet mode is off and the connexion takes time + ;; then the welcoming message may show up + + ;;(while (not ob-sql-session-connected)) + ;;(sleep-for 0.10) + (with-current-buffer (get-buffer ob-sql-buffer) (erase-buffer)) + ;; set the redirection filter + (set-process-filter sql-term-proc + #'ob-sql-session-comint-output-filter) + ;; return that buffer + (get-buffer ob-sql-buffer))))) + +(defun ob-sql-connect (&optional engine sql-cnx) + "Run ENGINE interpreter as an inferior process, with SQL-CNX as client buffer. + +Imported from sql.el with a few modification in order +to prompt for authentication only if there's a missing +parameter. Depending on the sql client the password +should also be prompted." + + ;; Get the value of engine that we need + (setq sql-product + (cond + ((assoc engine sql-product-alist) ; Product specified + engine) + (t sql-product))) ; Default to sql-engine + + (when (sql-get-product-feature sql-product :sqli-comint-func) + ;; If no new name specified or new name in buffer name, + ;; try to pop to an active SQL interactive for the same engine + (let (;(buf (sql-find-sqli-buffer sql-product sql-connection)) ; unused yet + (prompt-regexp (sql-get-product-feature engine :prompt-regexp )) + (prompt-cont-regexp (sql-get-product-feature engine :prompt-cont-regexp)) + sqli-buffer + rpt) + + ;; store the regexp used to clear output (prompt1|indicator|prompt2) + (sql-set-product-feature + engine :ob-sql-session-clean-output + (concat "\\(" prompt-regexp "\\)" + "\\|\\(" ob-sql-session--batch-end-indicator "\n\\)" + (when prompt-cont-regexp + (concat "\\|\\(" prompt-cont-regexp "\\)")))) + ;; Get credentials. + ;; either all fields are provided + ;; or there's a specific case were no login is needed + ;; or trigger the prompt + (or (and sql-database sql-user sql-server ) ;sql-port? + (eq sql-product 'sqlite) ;; sqlite allows in-memory db, w/o login + (apply #'sql-get-login + (sql-get-product-feature engine :sqli-login))) + ;; depending on client, password is forcefully prompted + + ;; Connect to database. + ;; (let ((sql-user (default-value 'sql-user)) + ;; (sql-password (default-value 'sql-password)) + ;; (sql-server (default-value 'sql-server)) + ;; (sql-database (default-value 'sql-database)) + ;; (sql-port (default-value 'sql-port)) + ;; (default-directory (or sql-default-directory default-directory))) + + ;; The password wallet returns a function + ;; which supplies the password. (untested) + (when (functionp sql-password) + (setq sql-password (funcall sql-password))) + + ;; Erase previous sql-buffer as we'll be looking for it's prompt + ;; to indicate session readyness + (let ((previous-session + (get-buffer (format "*SQL: %s*" sql-cnx)))) + (when previous-session + (with-current-buffer + previous-session (erase-buffer))) + + (setq sqli-buffer + (let ((process-environment (copy-sequence process-environment)) + (variables (sql-get-product-feature engine :environment))) + (mapc (lambda (elem) ; environment variables, evaluated here + (setenv (car elem) (eval (cadr elem)))) + variables) + (funcall (sql-get-product-feature engine :sqli-comint-func) + engine + (sql-get-product-feature engine :sqli-options) + (format "SQL: %s" sql-cnx)))) + (setq sql-buffer (buffer-name sqli-buffer)) + + (setq rpt (sql-make-progress-reporter nil "Login")) + (with-current-buffer sql-buffer + (let ((proc (get-buffer-process sqli-buffer)) + (secs org-babel-sql-timeout) + (step 0.2)) + (while (and proc + (memq (process-status proc) '(open run)) + (or (accept-process-output proc step) + (<= 0.0 (setq secs (- secs step)))) + (progn (goto-char (point-max)) + (not (re-search-backward + prompt-regexp 0 t)))) + (sql-progress-reporter-update rpt))) + + ;; no prompt, connexion failed (and process is terminated) + (goto-char (point-max)) + (unless (re-search-backward prompt-regexp 0 t) + (user-error "Connection failed"))) ;is this a _user_ error? + ;;(run-hooks 'sql-login-hook) ; don't + ) + (sql-progress-reporter-done rpt) + (get-buffer sqli-buffer)))) + +(defun ob-sql-session-format-query (str) + "Process then send the command STR to the SQL process. +Provide ENGINE to retrieve product features. +Carefully separate client commands from SQL commands +Concatenate SQL commands as one line is one way to stop on error. +Otherwise the entire batch will be emitted no matter what. +Finnally add the termination command." + + (concat + (let ((commands (split-string str "\n")) + (terminal-command + (concat "^\s*" + (sql-get-product-feature sql-product :terminal-command)))) + (mapconcat + (lambda(s) + (when (not + (string-match "\\(^[\s\t]*--.*$\\)\\|\\(^[\s\t]*$\\)" s)) + (concat (replace-regexp-in-string + "[\t]" "" ; filter tabs + (replace-regexp-in-string "--.*" "" s)) ;; remove comments + (when (string-match terminal-command s) "\n")))) + commands " " )) ; the only way to stop on error, + ";\n" (sql-get-product-feature sql-product :batch-terminate) "\n" )) + + +(defun ob-sql-session-comint-output-filter (_proc string) + "Process output STRING of PROC gets redirected to a temporary buffer. +It is called several times consecutively as the shell outputs and flush +its message buffer" + + ;; Inserting a result in the sql process buffer (to read it as a + ;; regular prompt log) inserts it to the terminal, and as a result the + ;; ouput would get passed as input onto the next command line; See + ;; `comint-redirect-setup' to possibly fix that, + ;; (with-current-buffer (process-buffer proc) (insert output)) + + (when (or (string-match ob-sql-session--batch-end-indicator string) + (> (time-to-seconds + (time-subtract (current-time) + org-babel-sql-session-start-time)) + org-babel-sql-timeout)) + (setq ob-sql-session-command-terminated t)) + + (with-current-buffer (get-buffer-create "*ob-sql-result*") + (insert string))) + + (defun org-babel-sql-expand-vars (body vars &optional sqlite) "Expand the variables held in VARS in BODY. @@ -429,9 +705,6 @@ argument mechanism." vars) body) -(defun org-babel-prep-session:sql (_session _params) - "Raise an error because Sql sessions aren't implemented." - (error "SQL sessions not yet implemented")) (provide 'ob-sql) -- 2.39.5
From 5da846ed082c4c03dae3344eaf0da3b2b54656c0 Mon Sep 17 00:00:00 2001 From: Phil Estival <[email protected]> Date: Tue, 7 Jan 2025 03:40:39 +0100 Subject: [PATCH 2/5] lisp/ob-sql.el: default header arguments are a custom variable default header arguments have :options with composite types. --- lisp/ob-sql.el | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/lisp/ob-sql.el b/lisp/ob-sql.el index f94bb1272..df0059492 100644 --- a/lisp/ob-sql.el +++ b/lisp/ob-sql.el @@ -81,6 +81,7 @@ (require 'ob) (require 'sql) +(defvar sql-connection-alist) (defvar ob-sql-session--batch-end-indicator "---#" "Indicate the end of a command batch.") (defvar ob-sql-session-command-terminated nil) (defvar org-babel-sql-out-file) @@ -112,8 +113,13 @@ (declare-function cygwin-convert-file-name-to-windows "cygw32.c" (file &optional absolute-p)) (declare-function sql-set-product "sql" (product)) -(defvar sql-connection-alist) -(defvar org-babel-default-header-args:sql '()) +(defcustom org-babel-default-header-args:sql '((:engine . "unset")) + "Default header args." + :type '(alist :key-type symbol :value-type string + :options ("dbi" "sqlite" "mysql" "postgres" + "sqsh" "mssql" "vertica" "oracle" "saphana" )) + :group 'org-babel-sql + :safe t) (defcustom org-babel-sql-run-comint-p 'nil "Run non-session SQL commands through comoint (or command line if nil)." -- 2.39.5
From 3ba23fecd34f75bd4a18ed9dc75044adb9c58e6c Mon Sep 17 00:00:00 2001 From: Phil Estival <[email protected]> Date: Tue, 7 Jan 2025 03:44:52 +0100 Subject: [PATCH 3/5] lisp/ob-sql.el: expand body discarding nil prologue or epilogue --- lisp/ob-sql.el | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/lisp/ob-sql.el b/lisp/ob-sql.el index df0059492..970363f7d 100644 --- a/lisp/ob-sql.el +++ b/lisp/ob-sql.el @@ -155,11 +155,10 @@ (let ((prologue (cdr (assq :prologue params))) (epilogue (cdr (assq :epilogue params)))) (mapconcat 'identity - (list - prologue - (org-babel-sql-expand-vars - body (org-babel--get-vars params)) - epilogue) + (delq nil (list prologue + (org-babel-sql-expand-vars + body (org-babel--get-vars params)) + epilogue)) "\n"))) (defun org-babel-edit-prep:sql (info) -- 2.39.5
From 89b9b0d764ac99e5584c569866d15be79cc3b595 Mon Sep 17 00:00:00 2001 From: Phil Estival <[email protected]> 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
From f77222069cb5f098be2e1e19290337b3f2b2bcde Mon Sep 17 00:00:00 2001 From: Phil Estival <[email protected]> Date: Tue, 7 Jan 2025 04:29:05 +0100 Subject: [PATCH 5/5] testing/lisp/test-ob-sql.el: adds 4 tests for sessions on sqlite * test-ob-sql.el: test sessions. Also adds a macro for testing equality of a string with the result of a given block. Note : This is not proper to SQL and should move upwards. --- testing/lisp/test-ob-sql.el | 36 ++++++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) diff --git a/testing/lisp/test-ob-sql.el b/testing/lisp/test-ob-sql.el index ac8a1ccb2..6afffc1e9 100644 --- a/testing/lisp/test-ob-sql.el +++ b/testing/lisp/test-ob-sql.el @@ -49,6 +49,18 @@ (org-babel-execute-src-block))))) (should-not (string-match-p ,regexp command)))) + +(defmacro ob-sql/command-equals (str sql-block) + "Check the equality of STR with the value returned by the evaluation of SQL-BLOCK." + `(let ((strings ,(if (listp str) str `(list ,str))) + (command (ob-sql/command (org-test-with-temp-text + ,sql-block + (org-babel-next-src-block) + (org-babel-execute-src-block))))) + (dolist (s strings) + (should (string= s command))))) + + ;;; dbish (ert-deftest ob-sql/engine-dbi-uses-dbish () (ob-sql/command-should-contain "^dbish " " @@ -377,5 +389,29 @@ select * from dummy; #+end_src")) +(ert-deftest ob-sql-sesssion-001/engine-sqlite-headers-off () + (ob-sql/command-equals "" " +#+begin_src sql :engine sqlite :session A :results raw +.headers off +#+end_src")) + +(ert-deftest ob-sql-sesssion-002/engine-sqlite-session-continuation () + (ob-sql/command-equals "Emacs\n" " +#+begin_src sql :engine sqlite :session A :results raw +select 'Emacs' as 'your preffered editor' +#+end_src")) + +(ert-deftest ob-sql-sesssion-003/engine-sqlite-headers-on () + (ob-sql/command-equals "" " +#+begin_src sql :engine sqlite :session A :results raw +.headers on +#+end_src")) + +(ert-deftest ob-sql-sesssion-004/engine-sqlite-session-continuation () + (ob-sql/command-equals "your preffered editor\nEmacs\n" " +#+begin_src sql :engine sqlite :session A :results raw +select 'Emacs' as 'your preffered editor' +#+end_src")) + (provide 'test-ob-sql) ;;; test-ob-sql.el ends here -- 2.39.5
