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
  0 siblings, 1 reply; 2+ 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] 2+ messages in thread

end of thread, other threads:[~2024-11-26 17:41 UTC | newest]

Thread overview: 2+ 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

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