emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
* [PATCH] ob-sql: session
@ 2024-11-26 14:34 Phil Estival
  2024-11-26 17:40 ` Phil Estival
  2024-12-13 17:46 ` Ihor Radchenko
  0 siblings, 2 replies; 5+ messages in thread
From: Phil Estival @ 2024-11-26 14:34 UTC (permalink / raw)
  To: Org Mode List

[-- Attachment #1: Type: text/plain, Size: 308 bytes --]


 From Org 9.7.16,
this patch modifies ob-sql to add support for session.
- reintroduces sqlite in ob-sql (even if there is ob-sqlite.el)
- limitation: no line number in session (a block is provided
   on one prompt line)
- tests: some generic macro for checking results could go up/out
   of this test set.

[-- Attachment #2: 0001-ob-sql-untabify.patch --]
[-- Type: text/x-patch, Size: 20585 bytes --]

From 10bcb0fa4a5176657604a8f17c828ff5a60eddaf Mon Sep 17 00:00:00 2001
From: Phil Estival <pe@7d.nz>
Date: Tue, 26 Nov 2024 11:34:48 +0100
Subject: [PATCH 01/10] ob-sql: untabify

---
 lisp/ob-sql.el | 288 ++++++++++++++++++++++++-------------------------
 1 file changed, 144 insertions(+), 144 deletions(-)

diff --git a/lisp/ob-sql.el b/lisp/ob-sql.el
index d7bcaa097..24870b354 100644
--- a/lisp/ob-sql.el
+++ b/lisp/ob-sql.el
@@ -86,20 +86,20 @@
 (defvar org-babel-default-header-args:sql '())

 (defconst org-babel-header-args:sql
-  '((engine           . :any)
-    (out-file         . :any)
-    (dbhost           . :any)
-    (dbport           . :any)
-    (dbuser           . :any)
-    (dbpassword               . :any)
-    (dbinstance               . :any)
-    (database         . :any))
+  '((engine            . :any)
+    (out-file          . :any)
+    (dbhost            . :any)
+    (dbport            . :any)
+    (dbuser            . :any)
+    (dbpassword        . :any)
+    (dbinstance        . :any)
+    (database          . :any))
   "SQL-specific header arguments.")

 (defun org-babel-expand-body:sql (body params)
   "Expand BODY according to the values of PARAMS."
   (let ((prologue (cdr (assq :prologue params)))
-       (epilogue (cdr (assq :epilogue params))))
+        (epilogue (cdr (assq :epilogue params))))
     (mapconcat 'identity
                (list
                 prologue
@@ -120,11 +120,11 @@ corresponding :engine source block header argument."
   (mapconcat
    #'identity
    (delq nil
-        (list (when host     (concat "-h" (shell-quote-argument host)))
-              (when port     (format "-P%d" port))
-              (when user     (concat "-u" (shell-quote-argument user)))
-              (when password (concat "-p" (shell-quote-argument password)))
-              (when database (concat "-D" (shell-quote-argument database)))))
+         (list (when host     (concat "-h" (shell-quote-argument host)))
+               (when port     (format "-P%d" port))
+               (when user     (concat "-u" (shell-quote-argument user)))
+               (when password (concat "-p" (shell-quote-argument password)))
+               (when database (concat "-D" (shell-quote-argument database)))))
    " "))

 (defun org-babel-sql-dbstring-postgresql (host port user database)
@@ -133,10 +133,10 @@ Pass nil to omit that arg."
   (mapconcat
    #'identity
    (delq nil
-        (list (when host (concat "-h" (shell-quote-argument host)))
-              (when port (format "-p%d" port))
-              (when user (concat "-U" (shell-quote-argument user)))
-              (when database (concat "-d" (shell-quote-argument database)))))
+         (list (when host (concat "-h" (shell-quote-argument host)))
+               (when port (format "-p%d" port))
+               (when user (concat "-U" (shell-quote-argument user)))
+               (when database (concat "-d" (shell-quote-argument database)))))
    " "))

 (defun org-babel-sql-dbstring-oracle (host port user password database)
@@ -158,22 +158,22 @@ using its alias."
   (when database (setq database (shell-quote-argument database)))
   (when host (setq host (shell-quote-argument host)))
   (cond ((and user password database host port)
-        (format "%s/%s@%s:%d/%s" user password host port database))
-       ((and user password database)
-        (format "%s/%s@%s" user password database))
-       (t (user-error "Missing information to connect to database"))))
+         (format "%s/%s@%s:%d/%s" user password host port database))
+        ((and user password database)
+         (format "%s/%s@%s" user password database))
+        (t (user-error "Missing information to connect to database"))))

 (defun org-babel-sql-dbstring-mssql (host user password database)
   "Make sqlcmd command line args for database connection.
 `sqlcmd' is the preferred command line tool to access Microsoft
 SQL Server on Windows and Linux platform."
   (mapconcat #'identity
-            (delq nil
-                  (list (when host (format "-S \"%s\"" (shell-quote-argument host)))
-                        (when user (format "-U \"%s\"" (shell-quote-argument user)))
-                        (when password (format "-P \"%s\"" (shell-quote-argument password)))
-                        (when database (format "-d \"%s\"" (shell-quote-argument database)))))
-            " "))
+             (delq nil
+                   (list (when host (format "-S \"%s\"" (shell-quote-argument host)))
+                         (when user (format "-U \"%s\"" (shell-quote-argument user)))
+                         (when password (format "-P \"%s\"" (shell-quote-argument password)))
+                         (when database (format "-d \"%s\"" (shell-quote-argument database)))))
+             " "))

 (defun org-babel-sql-dbstring-sqsh (host user password database)
   "Make sqsh command line args for database connection.
@@ -190,13 +190,13 @@ SQL Server on Windows and Linux platform."
   "Make Vertica command line args for database connection.
 Pass nil to omit that arg."
   (mapconcat #'identity
-            (delq nil
-                  (list (when host     (format "-h %s" (shell-quote-argument host)))
-                        (when port     (format "-p %d" port))
-                        (when user     (format "-U %s" (shell-quote-argument user)))
-                        (when password (format "-w %s" (shell-quote-argument password) ))
-                        (when database (format "-d %s" (shell-quote-argument database)))))
-            " "))
+             (delq nil
+                   (list (when host     (format "-h %s" (shell-quote-argument host)))
+                         (when port     (format "-p %d" port))
+                         (when user     (format "-U %s" (shell-quote-argument user)))
+                         (when password (format "-w %s" (shell-quote-argument password) ))
+                         (when database (format "-d %s" (shell-quote-argument database)))))
+             " "))

 (defun org-babel-sql-dbstring-saphana (host port instance user password database)
   "Make SAP HANA command line args for database connection.
@@ -220,9 +220,9 @@ If in Cygwin environment, uses Cygwin specific function to
 convert the file name.  In a Windows-NT environment, do nothing.
 Otherwise, use Emacs's standard conversion function."
   (cond ((fboundp 'cygwin-convert-file-name-to-windows)
-        (format "%S" (cygwin-convert-file-name-to-windows file)))
-       ((string= "windows-nt" system-type) file)
-       (t (format "%S" (convert-standard-filename file)))))
+         (format "%S" (cygwin-convert-file-name-to-windows file)))
+        ((string= "windows-nt" system-type) file)
+        (t (format "%S" (convert-standard-filename file)))))

 (defun org-babel-find-db-connection-param (params name)
   "Return database connection parameter NAME.
@@ -260,80 +260,80 @@ This function is called by `org-babel-execute-src-block'."
          (in-file (org-babel-temp-file "sql-in-"))
          (out-file (or (cdr (assq :out-file params))
                        (org-babel-temp-file "sql-out-")))
-        (header-delim "")
+         (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)))
+                                 (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))))
+                                     (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)
+                                   (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 \
+                      "%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 "
+                      (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 "")))
+                      (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 "")))
+                             "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")
+         (`dbi "/format partbox\n")
          (`oracle "SET PAGESIZE 50000
 SET NEWPAGE 0
 SET TAB OFF
@@ -348,56 +348,56 @@ SET MARKUP HTML OFF SPOOL OFF
 SET COLSEP '|'

 ")
-        ((or `mssql `sqsh) "SET NOCOUNT ON
+         ((or `mssql `sqsh) "SET NOCOUNT ON

 ")
-        (`vertica "\\a\n")
-        (_ ""))
+         (`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)))
+        (progn (insert-file-contents-literally out-file) (buffer-string)))
       (with-temp-buffer
-       (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
-         (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))
-           (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))))))))
+        (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
+          (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))
+            (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))))))))

 (defun org-babel-sql-expand-vars (body vars &optional sqlite)
   "Expand the variables held in VARS in BODY.
@@ -409,9 +409,9 @@ argument mechanism."
   (mapc
    (lambda (pair)
      (setq body
-          (replace-regexp-in-string
-           (format "$%s" (car pair))
-           (let ((val (cdr pair)))
+           (replace-regexp-in-string
+            (format "$%s" (car pair))
+            (let ((val (cdr pair)))
               (if (listp val)
                   (let ((data-file (org-babel-temp-file "sql-data-")))
                     (with-temp-file data-file
@@ -419,11 +419,11 @@ argument mechanism."
                                val (if sqlite
                                        nil
                                      '(:fmt (lambda (el) (if (stringp el)
-                                                        el
-                                                      (format "%S" el))))))))
+                                                             el
+                                                           (format "%S" el))))))))
                     data-file)
                 (if (stringp val) val (format "%S" val))))
-           body t t)))
+            body t t)))
    vars)
   body)

--
2.39.5

[-- Attachment #3: 0002-ob-sql-re-align-to-improve-readability.patch --]
[-- Type: text/x-patch, Size: 5865 bytes --]

From d9968f9924797508a9b85adeec3c249411d2bf11 Mon Sep 17 00:00:00 2001
From: Phil Estival <pe@7d.nz>
Date: Tue, 26 Nov 2024 11:38:28 +0100
Subject: [PATCH 02/10] ob-sql: re-align to improve readability

---
 lisp/ob-sql.el | 87 +++++++++++++++++++++++++-------------------------
 1 file changed, 44 insertions(+), 43 deletions(-)

diff --git a/lisp/ob-sql.el b/lisp/ob-sql.el
index 24870b354..9e55d6d13 100644
--- a/lisp/ob-sql.el
+++ b/lisp/ob-sql.el
@@ -86,15 +86,15 @@
 (defvar org-babel-default-header-args:sql '())

 (defconst org-babel-header-args:sql
-  '((engine            . :any)
-    (out-file          . :any)
-    (dbhost            . :any)
-    (dbport            . :any)
-    (dbuser            . :any)
-    (dbpassword        . :any)
-    (dbinstance        . :any)
-    (database          . :any))
-  "SQL-specific header arguments.")
+  '((engine      . :any)
+    (dbhost      . :any)
+    (dbport      . :any)
+    (dbuser      . :any)
+    (dbpassword  . :any)
+    (dbinstance  . :any)
+    (database    . :any)
+    (out-file    . :any))
+  "Header arguments accepted.")

 (defun org-babel-expand-body:sql (body params)
   "Expand BODY according to the values of PARAMS."
@@ -167,52 +167,53 @@ using its alias."
   "Make sqlcmd command line args for database connection.
 `sqlcmd' is the preferred command line tool to access Microsoft
 SQL Server on Windows and Linux platform."
-  (mapconcat #'identity
-             (delq nil
-                   (list (when host (format "-S \"%s\"" (shell-quote-argument host)))
-                         (when user (format "-U \"%s\"" (shell-quote-argument user)))
-                         (when password (format "-P \"%s\"" (shell-quote-argument password)))
-                         (when database (format "-d \"%s\"" (shell-quote-argument database)))))
-             " "))
+  (mapconcat
+   #'identity
+   (delq nil
+         (list (when host (format "-S \"%s\"" (shell-quote-argument host)))
+               (when user (format "-U \"%s\"" (shell-quote-argument user)))
+               (when password (format "-P \"%s\"" (shell-quote-argument password)))
+               (when database (format "-d \"%s\"" (shell-quote-argument database)))))
+   " "))

 (defun org-babel-sql-dbstring-sqsh (host user password database)
   "Make sqsh command line args for database connection.
 \"sqsh\" is one method to access Sybase or MS SQL via Linux platform"
-  (mapconcat #'identity
-             (delq nil
-                   (list  (when host     (format "-S \"%s\"" (shell-quote-argument host)))
-                          (when user     (format "-U \"%s\"" (shell-quote-argument user)))
-                          (when password (format "-P \"%s\"" (shell-quote-argument password)))
-                          (when database (format "-D \"%s\"" (shell-quote-argument database)))))
-             " "))
+  (mapconcat
+   #'identity
+   (delq nil
+         (list  (when host     (format "-S \"%s\"" (shell-quote-argument host)))
+                (when user     (format "-U \"%s\"" (shell-quote-argument user)))
+                (when password (format "-P \"%s\"" (shell-quote-argument password)))
+                (when database (format "-D \"%s\"" (shell-quote-argument database)))))
+   " "))

 (defun org-babel-sql-dbstring-vertica (host port user password database)
   "Make Vertica command line args for database connection.
 Pass nil to omit that arg."
-  (mapconcat #'identity
-             (delq nil
-                   (list (when host     (format "-h %s" (shell-quote-argument host)))
-                         (when port     (format "-p %d" port))
-                         (when user     (format "-U %s" (shell-quote-argument user)))
-                         (when password (format "-w %s" (shell-quote-argument password) ))
-                         (when database (format "-d %s" (shell-quote-argument database)))))
-             " "))
+  (mapconcat
+   #'identity
+   (delq nil
+         (list (when host     (format "-h %s" (shell-quote-argument host)))
+               (when port     (format "-p %d" port))
+               (when user     (format "-U %s" (shell-quote-argument user)))
+               (when password (format "-w %s" (shell-quote-argument password) ))
+               (when database (format "-d %s" (shell-quote-argument database)))))
+   " "))

 (defun org-babel-sql-dbstring-saphana (host port instance user password database)
   "Make SAP HANA command line args for database connection.
 Pass nil to omit that arg."
-  (mapconcat #'identity
-             (delq nil
-                   (list (and host port (format "-n %s:%s"
-                                                (shell-quote-argument host)
-                                                port))
-                         (and host (not port) (format "-n %s" (shell-quote-argument host)))
-                         (and instance (format "-i %d" instance))
-                         (and user (format "-u %s" (shell-quote-argument user)))
-                         (and password (format "-p %s"
-                                               (shell-quote-argument password)))
-                         (and database (format "-d %s" (shell-quote-argument database)))))
-             " "))
+  (mapconcat
+   #'identity
+   (delq nil
+         (list (and host port (format "-n %s:%s" (shell-quote-argument host) port))
+               (and host (not port) (format "-n %s" (shell-quote-argument host)))
+               (and instance (format "-i %d" instance))
+               (and user     (format "-u %s" (shell-quote-argument user)))
+               (and password (format "-p %s" (shell-quote-argument password)))
+               (and database (format "-d %s" (shell-quote-argument database)))))
+   " "))

 (defun org-babel-sql-convert-standard-filename (file)
   "Convert FILE to OS standard file name.
--
2.39.5

[-- Attachment #4: 0003-ob-sql-insert-functions-and-variables-for-session-su.patch --]
[-- Type: text/x-patch, Size: 15265 bytes --]

From e7eb25d02930fb2b179d1c0336fdf8d5fc3d3a87 Mon Sep 17 00:00:00 2001
From: Phil Estival <pe@7d.nz>
Date: Tue, 26 Nov 2024 11:48:51 +0100
Subject: [PATCH 03/10] ob-sql: insert functions and variables for session
 support

---
 lisp/ob-sql.el | 291 +++++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 284 insertions(+), 7 deletions(-)

diff --git a/lisp/ob-sql.el b/lisp/ob-sql.el
index 9e55d6d13..5fdba7aaa 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,9 +65,10 @@
 ;; - 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
+;; - expand body for sessions

 ;;; 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)
     (dbhost      . :any)
@@ -400,6 +448,10 @@ 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."
+  (error "SQL sessions not yet implemented"))
+
 (defun org-babel-sql-expand-vars (body vars &optional sqlite)
   "Expand the variables held in VARS in BODY.

@@ -407,6 +459,7 @@ If SQLITE has been provided, prevent passing a format to
 `orgtbl-to-csv'.  This prevents overriding the default format, which if
 there were commas in the context of the table broke the table as an
 argument mechanism."
+
   (mapc
    (lambda (pair)
      (setq body
@@ -420,8 +473,8 @@ argument mechanism."
                                val (if sqlite
                                        nil
                                      '(:fmt (lambda (el) (if (stringp el)
-                                                             el
-                                                           (format "%S" el))))))))
+                                                        el
+                                                      (format "%S" el))))))))
                     data-file)
                 (if (stringp val) val (format "%S" val))))
             body t t)))
@@ -430,7 +483,231 @@ argument mechanism."

 (defun org-babel-prep-session:sql (_session _params)
   "Raise an error because Sql sessions aren't implemented."
-  (error "SQL sessions not yet 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)))
+

 (provide 'ob-sql)

--
2.39.5

[-- Attachment #5: 0004-ob-sql-set-default-header-args-as-a-custom-variable-.patch --]
[-- Type: text/x-patch, Size: 1411 bytes --]

From d89ddbd2a44a88505f7e8c363ff6268b8c6bf9a6 Mon Sep 17 00:00:00 2001
From: Phil Estival <pe@7d.nz>
Date: Tue, 26 Nov 2024 11:51:05 +0100
Subject: [PATCH 04/10] ob-sql: set default header args as a custom variable,
 :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 5fdba7aaa..9ed695aa8 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 #6: 0005-ob-sql-move-functions-downwards.patch --]
[-- Type: text/x-patch, Size: 2962 bytes --]

From f60618a7cc227373d4fc0dc8fc98dd2371a09ec5 Mon Sep 17 00:00:00 2001
From: Phil Estival <pe@7d.nz>
Date: Tue, 26 Nov 2024 11:58:46 +0100
Subject: [PATCH 05/10] ob-sql: move functions downwards

---
 lisp/ob-sql.el | 48 +++++++++++++++++++-----------------------------
 1 file changed, 19 insertions(+), 29 deletions(-)

diff --git a/lisp/ob-sql.el b/lisp/ob-sql.el
index 9ed695aa8..d20edb9fd 100644
--- a/lisp/ob-sql.el
+++ b/lisp/ob-sql.el
@@ -150,25 +150,6 @@
     (out-file    . :any))
   "Header arguments accepted.")

-(defun org-babel-expand-body:sql (body params)
-  "Expand BODY according to the values of PARAMS."
-  (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)
-               "\n")))
-
-(defun org-babel-edit-prep:sql (info)
-  "Set `sql-product' in Org edit buffer.
-Set `sql-product' in Org edit buffer according to the
-corresponding :engine source block header argument."
-  (let ((product (cdr (assq :engine (nth 2 info)))))
-    (sql-set-product product)))
-
 (defun org-babel-sql-dbstring-mysql (host port user password database)
   "Make MySQL cmd line args for database connection.  Pass nil to omit that arg."
   (mapconcat
@@ -454,9 +435,25 @@ 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."
-  (error "SQL sessions not yet implemented"))
+
+(defun org-babel-edit-prep:sql (info)
+  "Prepare Org-edit buffer.
+Set `sql-product' in Org edit buffer according to
+the :engine header argument provided in INFO."
+  (let ((product (cdr (assq :engine (nth 2 info)))))
+    (sql-set-product product)))
+
+(defun org-babel-expand-body:sql (body params)
+  "Expand BODY according to the values of PARAMS."
+  (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)
+               "\n")))

 (defun org-babel-sql-expand-vars (body vars &optional sqlite)
   "Expand the variables held in VARS in BODY.
@@ -487,13 +484,6 @@ argument mechanism."
    vars)
   body)

-(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.

--
2.39.5

[-- Attachment #7: 0006-ob-sql-expand-body-discarding-nil-prologue-or-epilog.patch --]
[-- Type: text/x-patch, Size: 1567 bytes --]

From 1fd8f388c4ed234557e691e935e8b3c3ddefa3ed Mon Sep 17 00:00:00 2001
From: Phil Estival <pe@7d.nz>
Date: Tue, 26 Nov 2024 12:01:48 +0100
Subject: [PATCH 06/10] ob-sql: expand body discarding nil prologue or epilogue

---
 lisp/ob-sql.el | 11 ++++-------
 1 file changed, 4 insertions(+), 7 deletions(-)

diff --git a/lisp/ob-sql.el b/lisp/ob-sql.el
index d20edb9fd..0f3c3c15d 100644
--- a/lisp/ob-sql.el
+++ b/lisp/ob-sql.el
@@ -435,7 +435,6 @@ SET COLSEP '|'
          (org-babel-pick-name (cdr (assq :rowname-names params))
                               (cdr (assq :rownames params))))))))

-
 (defun org-babel-edit-prep:sql (info)
   "Prepare Org-edit buffer.
 Set `sql-product' in Org edit buffer according to
@@ -448,11 +447,10 @@ the :engine header argument provided in INFO."
   (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-sql-expand-vars (body vars &optional sqlite)
@@ -704,7 +702,6 @@ its message buffer"
   (with-current-buffer (get-buffer-create "*ob-sql-result*")
     (insert string)))

-
 (provide 'ob-sql)

 ;;; ob-sql.el ends here
--
2.39.5

[-- Attachment #8: 0007-ob-sql-change-block-execution-to-support-session.patch --]
[-- Type: text/x-patch, Size: 15300 bytes --]

From 5b649d5b4c7745aba55d521c5916af8a809b667b Mon Sep 17 00:00:00 2001
From: Phil Estival <pe@7d.nz>
Date: Tue, 26 Nov 2024 12:04:24 +0100
Subject: [PATCH 07/10] ob-sql: change block execution to support session

---
 lisp/ob-sql.el | 235 +++++++++++++++++++++++++++++++------------------
 1 file changed, 149 insertions(+), 86 deletions(-)

diff --git a/lisp/ob-sql.el b/lisp/ob-sql.el
index 0f3c3c15d..3211b9dc8 100644
--- a/lisp/ob-sql.el
+++ b/lisp/ob-sql.el
@@ -281,96 +281,146 @@ 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))
+         (database   (org-babel-find-db-connection-param params :database))
          (dbinstance (org-babel-find-db-connection-param params :dbinstance))
-         (database (org-babel-find-db-connection-param params :database))
-         (engine (cdr (assq :engine params)))
          (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"
+         (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)
-                                 "/^+/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 \
+                (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 mariadb) (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)))))
+
+        (progn
+          (with-temp-file in-file
+            (insert
+             (pcase in-engine
+               (`dbi "/format partbox\n")
+               (`oracle "SET PAGESIZE 50000
 SET NEWPAGE 0
 SET TAB OFF
 SET SPACE 0
@@ -384,21 +434,23 @@ 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 "")
+               (`vertica "\\a\n")
+               (_ ""))
+             ;; "sqsh" requires "go" inserted at EOF.
+             (if (string= engine "sqsh") "\ngo" "")
+             (org-babel-expand-body:sql body params))) ;; insert body
+          (org-babel-eval command ""))))
+
+    ;; collect results
     (org-babel-result-cond result-params
       (with-temp-buffer
         (progn (insert-file-contents-literally out-file) (buffer-string)))
       (with-temp-buffer
         (cond
-         ((memq (intern engine) '(dbi mysql postgresql postgres saphana sqsh vertica))
+         ((memq in-engine '(dbi sqlite mysql postgresql postgres saphana sqsh vertica))
           ;; Add header row delimiter after column-names header in first line
           (cond
            (colnames-p
@@ -423,7 +475,18 @@ SET COLSEP '|'
               (goto-char (point-max))
               (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)
--
2.39.5

[-- Attachment #9: 0008-ob-sql-minor-changes-in-docstrings.patch --]
[-- Type: text/x-patch, Size: 2805 bytes --]

From 7de8b4a69cfd098724860d136be51f7fea4b24a2 Mon Sep 17 00:00:00 2001
From: Phil Estival <pe@7d.nz>
Date: Tue, 26 Nov 2024 12:12:00 +0100
Subject: [PATCH 08/10] ob-sql: minor changes in docstrings

---
 lisp/ob-sql.el | 25 +++++++++----------------
 1 file changed, 9 insertions(+), 16 deletions(-)

diff --git a/lisp/ob-sql.el b/lisp/ob-sql.el
index 3211b9dc8..51a6a2390 100644
--- a/lisp/ob-sql.el
+++ b/lisp/ob-sql.el
@@ -151,7 +151,8 @@
   "Header arguments accepted.")

 (defun org-babel-sql-dbstring-mysql (host port user password database)
-  "Make MySQL cmd line args for database connection.  Pass nil to omit that arg."
+  "Make MySQL command line arguments for database connection.
+nil arguments are ommited."
   (mapconcat
    #'identity
    (delq nil
@@ -163,8 +164,8 @@
    " "))

 (defun org-babel-sql-dbstring-postgresql (host port user database)
-  "Make PostgreSQL command line args for database connection.
-Pass nil to omit that arg."
+  "Make PostgreSQL command line arguments for database connection.
+nil arguments are ommited."
   (mapconcat
    #'identity
    (delq nil
@@ -176,18 +177,10 @@ Pass nil to omit that arg."

 (defun org-babel-sql-dbstring-oracle (host port user password database)
   "Make Oracle command line arguments for database connection.
-
 If HOST and PORT are nil then don't pass them.  This allows you
 to use names defined in your \"TNSNAMES\" file.  So you can
-connect with
-
-  <user>/<password>@<host>:<port>/<database>
-
-or
-
-  <user>/<password>@<database>
-
-using its alias."
+connect with <USER>/<PASSWORD>@<HOST>:<PORT>/<DATABASE>
+or <user>/<password>@<database> using its alias."
   (when user (setq user (shell-quote-argument user)))
   (when password (setq password (shell-quote-argument password)))
   (when database (setq database (shell-quote-argument database)))
@@ -213,7 +206,7 @@ SQL Server on Windows and Linux platform."

 (defun org-babel-sql-dbstring-sqsh (host user password database)
   "Make sqsh command line args for database connection.
-\"sqsh\" is one method to access Sybase or MS SQL via Linux platform"
+sqsh is one method to access Sybase or MS SQL via Linux platform."
   (mapconcat
    #'identity
    (delq nil
@@ -225,7 +218,7 @@ SQL Server on Windows and Linux platform."

 (defun org-babel-sql-dbstring-vertica (host port user password database)
   "Make Vertica command line args for database connection.
-Pass nil to omit that arg."
+nil arguments are ommited."
   (mapconcat
    #'identity
    (delq nil
@@ -238,7 +231,7 @@ Pass nil to omit that arg."

 (defun org-babel-sql-dbstring-saphana (host port instance user password database)
   "Make SAP HANA command line args for database connection.
-Pass nil to omit that arg."
+nil arguments are ommited."
   (mapconcat
    #'identity
    (delq nil
--
2.39.5

[-- Attachment #10: 0009-ob-sql-remove-org-version-assertion.patch --]
[-- Type: text/x-patch, Size: 500 bytes --]

From 1c0511f63cfefebfea5b723189226c9dc786dfe6 Mon Sep 17 00:00:00 2001
From: Phil Estival <pe@7d.nz>
Date: Tue, 26 Nov 2024 12:13:22 +0100
Subject: [PATCH 09/10] ob-sql: remove org version assertion

---
 lisp/ob-sql.el | 3 ---
 1 file changed, 3 deletions(-)

diff --git a/lisp/ob-sql.el b/lisp/ob-sql.el
index 51a6a2390..ccf307319 100644
--- a/lisp/ob-sql.el
+++ b/lisp/ob-sql.el
@@ -75,9 +75,6 @@

 ;;; Code:

-(require 'org-macs)
-(org-assert-version)
-
 (require 'ob)
 (require 'sql)

--
2.39.5

[-- Attachment #11: 0010-ob-sql-test-ob-sql.el-add-session-test.patch --]
[-- Type: text/x-patch, Size: 3483 bytes --]

From 5cf791dff41f0b4ae79efb723ae1813792ff2c2c Mon Sep 17 00:00:00 2001
From: Phil Estival <pe@7d.nz>
Date: Tue, 26 Nov 2024 13:20:56 +0100
Subject: [PATCH 10/10] test-ob-sql.el: add session tests on sqlite
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

— additional macro for result equality checks
— rename testing functions ob-sql/* → ob-test/*.
  as they are generic to any babel result check
— correct docstrings
---
 testing/lisp/test-ob-sql.el | 40 +++++++++++++++++++++++++++++++------
 1 file changed, 34 insertions(+), 6 deletions(-)

diff --git a/testing/lisp/test-ob-sql.el b/testing/lisp/test-ob-sql.el
index ac8a1ccb2..acea431de 100644
--- a/testing/lisp/test-ob-sql.el
+++ b/testing/lisp/test-ob-sql.el
@@ -31,7 +31,7 @@
        ,@body)))

 (defmacro ob-sql/command-should-contain (regexp sql-block)
-  "Check that REGEXP is contained in the command executed when evaluating SQL-BLOCK."
+  "Check that REGEXP matches the value returned by the evaluation of SQL-BLOCK."
   `(let ((regexps ,(if (listp regexp) regexp `(list ,regexp)))
          (command (ob-sql/command (org-test-with-temp-text
                                       ,sql-block
@@ -41,7 +41,7 @@
        (should (string-match-p regexp command)))))

 (defmacro ob-sql/command-should-not-contain (regexp sql-block)
-  "Check that REGEXP is not contained in the command executed when evaluating SQL-BLOCK."
+  "Check that REGEXP does ot match the returned value of the evaluation of SQL-BLOCK."
   `(let ((command (ob-sql/command
                    (org-test-with-temp-text
                        ,sql-block
@@ -49,6 +49,16 @@
                      (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 " "
@@ -371,9 +381,27 @@
   select * from dummy;
 #+end_src"))

-(ert-deftest ob-sql/engine-vertica-passes-port-if-provided ()
-  (ob-sql/command-should-contain " -p 12345 " "
-#+begin_src sql :engine vertica :dbport 12345
-  select * from dummy;

+(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)
--
2.39.5

^ permalink raw reply related	[flat|nested] 5+ messages in thread

* Re: [PATCH] ob-sql: session
  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
  1 sibling, 0 replies; 5+ messages in thread
From: Phil Estival @ 2024-11-26 17:40 UTC (permalink / raw)
  To: Org Mode List



* [2024-11-26 15:34] Phil Estival:
> 
>  From Org 9.7.16,
> this patch modifies ob-sql to add support for session.
> - reintroduces sqlite in ob-sql (even if there is ob-sqlite.el)
> - limitation: no line number in session (a block is provided
>    on one prompt line)
> - tests: some generic macros for checking results could go up/out
>    of this test set.

erratum: no line number → no error line number returned in session
(error is always displayed as LINE 1)


^ permalink raw reply	[flat|nested] 5+ messages in thread

* Re: [PATCH] ob-sql: session
  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
  1 sibling, 1 reply; 5+ messages in thread
From: Ihor Radchenko @ 2024-12-13 17:46 UTC (permalink / raw)
  To: Phil Estival; +Cc: Org Mode List

Phil Estival <pe@7d.nz> writes:

>  From Org 9.7.16,
> this patch modifies ob-sql to add support for session.
> - reintroduces sqlite in ob-sql (even if there is ob-sqlite.el)
> - limitation: no line number in session (a block is provided
>    on one prompt line)
> - tests: some generic macro for checking results could go up/out
>    of this test set.

Thanks a lot for the patch and for adding yourself as a maintainer!

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.

-- 
Ihor Radchenko // yantar92,
Org mode maintainer,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>


^ permalink raw reply	[flat|nested] 5+ messages in thread

* Re: [PATCH] ob-sql: session
  2024-12-13 17:46 ` Ihor Radchenko
@ 2025-01-07  5:44   ` Phil Estival
  2025-01-07 18:38     ` Ihor Radchenko
  0 siblings, 1 reply; 5+ messages in thread
From: Phil Estival @ 2025-01-07  5:44 UTC (permalink / raw)
  To: Ihor Radchenko; +Cc: Org Mode List

[-- 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

^ permalink raw reply related	[flat|nested] 5+ messages in thread

* Re: [PATCH] ob-sql: session
  2025-01-07  5:44   ` Phil Estival
@ 2025-01-07 18:38     ` Ihor Radchenko
  0 siblings, 0 replies; 5+ messages in thread
From: Ihor Radchenko @ 2025-01-07 18:38 UTC (permalink / raw)
  To: Phil Estival; +Cc: Org Mode List

Phil Estival <pe@7d.nz> writes:

> Hello. Here we go again.

Thanks!
See comments inline.

> 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.

I do not mind.
But please show which _other_ tests can benefit from the simplification.

> +(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" ))

All these `sql-set-product-feature' calls are overriding the defaults
from sql.el. They will not only affect Org babel blocks, but all the
interactive SQL sessions in Emacs. Such side effects are not acceptable.

May we somehow avoid modifying pre-existing sql features?

It is probably OK to add Org-specific settings after prepending them
with org-. For example, :batch-terminate -> :org-batch-terminate.
Although, I am not sure what is the benefit of storing these _new_
settings in the `sql-product-alist'.
  
> +(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)))))))

May you simply use `org-babel-comint-buffer-livep' instead?

> +(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)
> ...

Is there any specific reason why you are seemingly re-implementing what
`sql-product-interactive' does? May we re-use it instead?

-- 
Ihor Radchenko // yantar92,
Org mode maintainer,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>


^ permalink raw reply	[flat|nested] 5+ messages in thread

end of thread, other threads:[~2025-01-07 18:37 UTC | newest]

Thread overview: 5+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
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
2025-01-07 18:38     ` Ihor Radchenko

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).