From e7eb25d02930fb2b179d1c0336fdf8d5fc3d3a87 Mon Sep 17 00:00:00 2001 From: Phil Estival 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 +;; Maintainer: Philippe Estival ;; 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