From: Phil Estival <pe@7d.nz>
To: Ihor Radchenko <yantar92@posteo.net>
Cc: Org Mode List <emacs-orgmode@gnu.org>
Subject: Re: [PATCH] ob-sql: session
Date: Tue, 7 Jan 2025 06:44:57 +0100 [thread overview]
Message-ID: <2c80ecf8-e114-45fd-8116-49ce0f975070@7d.nz> (raw)
In-Reply-To: <87seqrh3wl.fsf@localhost>
[-- Attachment #1: Type: text/plain, Size: 1202 bytes --]
* [2024-12-13 18:46] Ihor Radchenko:
> Phil Estival <pe@7d.nz> 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
[-- Attachment #2: 0001-lisp-ob-sql.el-new-functions-and-variables-for-sessi.patch --]
[-- Type: text/x-patch, Size: 14421 bytes --]
From a84099e373203e29dd3a77e5cd4f4efb5f1613a7 Mon Sep 17 00:00:00 2001
From: Phil Estival <pe@7d.nz>
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 <daniel@kraus.my>
+;; Maintainer: Philippe Estival <pe@7d.nz>
;; 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
[-- Attachment #3: 0002-lisp-ob-sql.el-default-header-arguments-are-a-custom.patch --]
[-- Type: text/x-patch, Size: 1453 bytes --]
From 5da846ed082c4c03dae3344eaf0da3b2b54656c0 Mon Sep 17 00:00:00 2001
From: Phil Estival <pe@7d.nz>
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
[-- Attachment #4: 0003-lisp-ob-sql.el-expand-body-discarding-nil-prologue-o.patch --]
[-- Type: text/x-patch, Size: 1032 bytes --]
From 3ba23fecd34f75bd4a18ed9dc75044adb9c58e6c Mon Sep 17 00:00:00 2001
From: Phil Estival <pe@7d.nz>
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
[-- Attachment #5: 0004-lisp-ob-sql.el-block-execution-changes-to-support-se.patch --]
[-- Type: text/x-patch, Size: 15157 bytes --]
From 89b9b0d764ac99e5584c569866d15be79cc3b595 Mon Sep 17 00:00:00 2001
From: Phil Estival <pe@7d.nz>
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
[-- Attachment #6: 0005-testing-lisp-test-ob-sql.el-add-4-tests-for-sessions.patch --]
[-- Type: text/x-patch, Size: 2381 bytes --]
From f77222069cb5f098be2e1e19290337b3f2b2bcde Mon Sep 17 00:00:00 2001
From: Phil Estival <pe@7d.nz>
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
next prev parent reply other threads:[~2025-01-07 5:46 UTC|newest]
Thread overview: 5+ messages / expand[flat|nested] mbox.gz Atom feed top
2024-11-26 14:34 [PATCH] ob-sql: session Phil Estival
2024-11-26 17:40 ` Phil Estival
2024-12-13 17:46 ` Ihor Radchenko
2025-01-07 5:44 ` Phil Estival [this message]
2025-01-07 18:38 ` Ihor Radchenko
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.orgmode.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=2c80ecf8-e114-45fd-8116-49ce0f975070@7d.nz \
--to=pe@7d.nz \
--cc=emacs-orgmode@gnu.org \
--cc=yantar92@posteo.net \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).