config

Personal configuration.
git clone git://code.dwrz.net/config
Log | Files | Refs

ob-sql.el (15858B)


      1 ;;; ob-sql.el --- Babel Functions for SQL            -*- lexical-binding: t; -*-
      2 
      3 ;; Copyright (C) 2009-2024 Free Software Foundation, Inc.
      4 
      5 ;; Author: Eric Schulte
      6 ;; Maintainer: Daniel Kraus <daniel@kraus.my>
      7 ;; Keywords: literate programming, reproducible research
      8 ;; URL: https://orgmode.org
      9 
     10 ;; This file is part of GNU Emacs.
     11 
     12 ;; GNU Emacs is free software: you can redistribute it and/or modify
     13 ;; it under the terms of the GNU General Public License as published by
     14 ;; the Free Software Foundation, either version 3 of the License, or
     15 ;; (at your option) any later version.
     16 
     17 ;; GNU Emacs is distributed in the hope that it will be useful,
     18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     20 ;; GNU General Public License for more details.
     21 
     22 ;; You should have received a copy of the GNU General Public License
     23 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
     24 
     25 ;;; Commentary:
     26 
     27 ;; Org-Babel support for evaluating sql source code.
     28 ;; (see also ob-sqlite.el)
     29 ;;
     30 ;; SQL is somewhat unique in that there are many different engines for
     31 ;; the evaluation of sql (Mysql, PostgreSQL, etc...), so much of this
     32 ;; file will have to be implemented engine by engine.
     33 ;;
     34 ;; Also SQL evaluation generally takes place inside of a database.
     35 ;;
     36 ;; Header args used:
     37 ;; - engine
     38 ;; - cmdline
     39 ;; - dbhost
     40 ;; - dbport
     41 ;; - dbuser
     42 ;; - dbpassword
     43 ;; - dbconnection (to reference connections in sql-connection-alist)
     44 ;; - dbinstance (currently only used by SAP HANA)
     45 ;; - database
     46 ;; - colnames (default, nil, means "yes")
     47 ;; - result-params
     48 ;; - out-file
     49 ;;
     50 ;; The following are used but not really implemented for SQL:
     51 ;; - colname-names
     52 ;; - rownames
     53 ;; - rowname-names
     54 ;;
     55 ;; Engines supported:
     56 ;; - mysql
     57 ;; - dbi
     58 ;; - mssql
     59 ;; - sqsh
     60 ;; - postgresql (postgres)
     61 ;; - oracle
     62 ;; - vertica
     63 ;; - saphana
     64 ;;
     65 ;; TODO:
     66 ;;
     67 ;; - support for sessions
     68 ;; - support for more engines
     69 ;; - what's a reasonable way to drop table data into SQL?
     70 ;;
     71 
     72 ;;; Code:
     73 
     74 (require 'org-macs)
     75 (org-assert-version)
     76 
     77 (require 'ob)
     78 
     79 (declare-function org-table-import "org-table" (file arg))
     80 (declare-function orgtbl-to-csv "org-table" (table params))
     81 (declare-function org-table-to-lisp "org-table" (&optional txt))
     82 (declare-function cygwin-convert-file-name-to-windows "cygw32.c" (file &optional absolute-p))
     83 (declare-function sql-set-product "sql" (product))
     84 
     85 (defvar sql-connection-alist)
     86 (defvar org-babel-default-header-args:sql '())
     87 
     88 (defconst org-babel-header-args:sql
     89   '((engine	       . :any)
     90     (out-file	       . :any)
     91     (dbhost	       . :any)
     92     (dbport	       . :any)
     93     (dbuser	       . :any)
     94     (dbpassword	       . :any)
     95     (dbinstance	       . :any)
     96     (database	       . :any))
     97   "SQL-specific header arguments.")
     98 
     99 (defun org-babel-expand-body:sql (body params)
    100   "Expand BODY according to the values of PARAMS."
    101   (let ((prologue (cdr (assq :prologue params)))
    102 	(epilogue (cdr (assq :epilogue params))))
    103     (mapconcat 'identity
    104                (list
    105                 prologue
    106                 (org-babel-sql-expand-vars
    107                  body (org-babel--get-vars params))
    108                 epilogue)
    109                "\n")))
    110 
    111 (defun org-babel-edit-prep:sql (info)
    112   "Set `sql-product' in Org edit buffer.
    113 Set `sql-product' in Org edit buffer according to the
    114 corresponding :engine source block header argument."
    115   (let ((product (cdr (assq :engine (nth 2 info)))))
    116     (sql-set-product product)))
    117 
    118 (defun org-babel-sql-dbstring-mysql (host port user password database)
    119   "Make MySQL cmd line args for database connection.  Pass nil to omit that arg."
    120   (combine-and-quote-strings
    121    (delq nil
    122 	 (list (when host     (concat "-h" host))
    123 	       (when port     (format "-P%d" port))
    124 	       (when user     (concat "-u" user))
    125 	       (when password (concat "-p" password))
    126 	       (when database (concat "-D" database))))))
    127 
    128 (defun org-babel-sql-dbstring-postgresql (host port user database)
    129   "Make PostgreSQL command line args for database connection.
    130 Pass nil to omit that arg."
    131   (combine-and-quote-strings
    132    (delq nil
    133 	 (list (when host (concat "-h" host))
    134 	       (when port (format "-p%d" port))
    135 	       (when user (concat "-U" user))
    136 	       (when database (concat "-d" database))))))
    137 
    138 (defun org-babel-sql-dbstring-oracle (host port user password database)
    139   "Make Oracle command line arguments for database connection.
    140 
    141 If HOST and PORT are nil then don't pass them.  This allows you
    142 to use names defined in your \"TNSNAMES\" file.  So you can
    143 connect with
    144 
    145   <user>/<password>@<host>:<port>/<database>
    146 
    147 or
    148 
    149   <user>/<password>@<database>
    150 
    151 using its alias."
    152   (cond ((and user password database host port)
    153 	 (format "%s/%s@%s:%s/%s" user password host port database))
    154 	((and user password database)
    155 	 (format "%s/%s@%s" user password database))
    156 	(t (user-error "Missing information to connect to database"))))
    157 
    158 (defun org-babel-sql-dbstring-mssql (host user password database)
    159   "Make sqlcmd command line args for database connection.
    160 `sqlcmd' is the preferred command line tool to access Microsoft
    161 SQL Server on Windows and Linux platform."
    162   (mapconcat #'identity
    163 	     (delq nil
    164 		   (list (when host (format "-S \"%s\"" host))
    165 			 (when user (format "-U \"%s\"" user))
    166 			 (when password (format "-P \"%s\"" password))
    167 			 (when database (format "-d \"%s\"" database))))
    168 	     " "))
    169 
    170 (defun org-babel-sql-dbstring-sqsh (host user password database)
    171   "Make sqsh command line args for database connection.
    172 \"sqsh\" is one method to access Sybase or MS SQL via Linux platform"
    173   (mapconcat #'identity
    174              (delq nil
    175                    (list  (when host     (format "-S \"%s\"" host))
    176                           (when user     (format "-U \"%s\"" user))
    177                           (when password (format "-P \"%s\"" password))
    178                           (when database (format "-D \"%s\"" database))))
    179              " "))
    180 
    181 (defun org-babel-sql-dbstring-vertica (host port user password database)
    182   "Make Vertica command line args for database connection.
    183 Pass nil to omit that arg."
    184   (mapconcat #'identity
    185 	     (delq nil
    186 		   (list (when host     (format "-h %s" host))
    187 			 (when port     (format "-p %d" port))
    188 			 (when user     (format "-U %s" user))
    189 			 (when password (format "-w %s" (shell-quote-argument password) ))
    190 			 (when database (format "-d %s" database))))
    191 	     " "))
    192 
    193 (defun org-babel-sql-dbstring-saphana (host port instance user password database)
    194   "Make SAP HANA command line args for database connection.
    195 Pass nil to omit that arg."
    196   (mapconcat #'identity
    197              (delq nil
    198                    (list (and host port (format "-n %s:%s" host port))
    199                          (and host (not port) (format "-n %s" host))
    200                          (and instance (format "-i %d" instance))
    201                          (and user (format "-u %s" user))
    202                          (and password (format "-p %s"
    203                                                (shell-quote-argument password)))
    204                          (and database (format "-d %s" database))))
    205              " "))
    206 
    207 (defun org-babel-sql-convert-standard-filename (file)
    208   "Convert FILE to OS standard file name.
    209 If in Cygwin environment, uses Cygwin specific function to
    210 convert the file name.  In a Windows-NT environment, do nothing.
    211 Otherwise, use Emacs's standard conversion function."
    212   (cond ((fboundp 'cygwin-convert-file-name-to-windows)
    213 	 (format "%S" (cygwin-convert-file-name-to-windows file)))
    214 	((string= "windows-nt" system-type) file)
    215 	(t (format "%S" (convert-standard-filename file)))))
    216 
    217 (defun org-babel-find-db-connection-param (params name)
    218   "Return database connection parameter NAME.
    219 Given a parameter NAME, if :dbconnection is defined in PARAMS
    220 then look for the parameter into the corresponding connection
    221 defined in `sql-connection-alist', otherwise look into PARAMS.
    222 See `sql-connection-alist' (part of SQL mode) for how to define
    223 database connections."
    224   (or (cdr (assq name params))
    225       (and (assq :dbconnection params)
    226            (let* ((dbconnection (cdr (assq :dbconnection params)))
    227                   (name-mapping '((:dbhost . sql-server)
    228                                   (:dbport . sql-port)
    229                                   (:dbuser . sql-user)
    230                                   (:dbpassword . sql-password)
    231                                   (:dbinstance . sql-dbinstance)
    232                                   (:database . sql-database)))
    233                   (mapped-name (cdr (assq name name-mapping))))
    234              (cadr (assq mapped-name
    235                          (cdr (assoc-string dbconnection sql-connection-alist t))))))))
    236 
    237 (defun org-babel-execute:sql (body params)
    238   "Execute a block of Sql code with Babel.
    239 This function is called by `org-babel-execute-src-block'."
    240   (let* ((result-params (cdr (assq :result-params params)))
    241          (cmdline (cdr (assq :cmdline params)))
    242          (dbhost (org-babel-find-db-connection-param params :dbhost))
    243          (dbport (org-babel-find-db-connection-param params :dbport))
    244          (dbuser (org-babel-find-db-connection-param params :dbuser))
    245          (dbpassword (org-babel-find-db-connection-param params :dbpassword))
    246          (dbinstance (org-babel-find-db-connection-param params :dbinstance))
    247          (database (org-babel-find-db-connection-param params :database))
    248          (engine (cdr (assq :engine params)))
    249          (colnames-p (not (equal "no" (cdr (assq :colnames params)))))
    250          (in-file (org-babel-temp-file "sql-in-"))
    251          (out-file (or (cdr (assq :out-file params))
    252                        (org-babel-temp-file "sql-out-")))
    253 	 (header-delim "")
    254          (command (cl-case (intern engine)
    255                     (dbi (format "dbish --batch %s < %s | sed '%s' > %s"
    256 				 (or cmdline "")
    257 				 (org-babel-process-file-name in-file)
    258 				 "/^+/d;s/^|//;s/(NULL)/ /g;$d"
    259 				 (org-babel-process-file-name out-file)))
    260                     (monetdb (format "mclient -f tab %s < %s > %s"
    261 				     (or cmdline "")
    262 				     (org-babel-process-file-name in-file)
    263 				     (org-babel-process-file-name out-file)))
    264 		    (mssql (format "sqlcmd %s -s \"\t\" %s -i %s -o %s"
    265 				   (or cmdline "")
    266 				   (org-babel-sql-dbstring-mssql
    267 				    dbhost dbuser dbpassword database)
    268 				   (org-babel-sql-convert-standard-filename
    269 				    (org-babel-process-file-name in-file))
    270 				   (org-babel-sql-convert-standard-filename
    271 				    (org-babel-process-file-name out-file))))
    272                     (mysql (format "mysql %s %s %s < %s > %s"
    273 				   (org-babel-sql-dbstring-mysql
    274 				    dbhost dbport dbuser dbpassword database)
    275 				   (if colnames-p "" "-N")
    276 				   (or cmdline "")
    277 				   (org-babel-process-file-name in-file)
    278 				   (org-babel-process-file-name out-file)))
    279 		    ((postgresql postgres) (format
    280 					    "%s%s --set=\"ON_ERROR_STOP=1\" %s -A -P \
    281 footer=off -F \"\t\"  %s -f %s -o %s %s"
    282 					    (if dbpassword
    283 						(format "PGPASSWORD=%s " dbpassword)
    284 					      "")
    285                                             (or (bound-and-true-p
    286                                                  sql-postgres-program)
    287                                                 "psql")
    288 					    (if colnames-p "" "-t")
    289 					    (org-babel-sql-dbstring-postgresql
    290 					     dbhost dbport dbuser database)
    291 					    (org-babel-process-file-name in-file)
    292 					    (org-babel-process-file-name out-file)
    293 					    (or cmdline "")))
    294 		    (sqsh (format "sqsh %s %s -i %s -o %s -m csv"
    295 				  (or cmdline "")
    296 				  (org-babel-sql-dbstring-sqsh
    297 				   dbhost dbuser dbpassword database)
    298 				  (org-babel-sql-convert-standard-filename
    299 				   (org-babel-process-file-name in-file))
    300 				  (org-babel-sql-convert-standard-filename
    301 				   (org-babel-process-file-name out-file))))
    302 		    (vertica (format "vsql %s -f %s -o %s %s"
    303 				     (org-babel-sql-dbstring-vertica
    304 				      dbhost dbport dbuser dbpassword database)
    305 				     (org-babel-process-file-name in-file)
    306 				     (org-babel-process-file-name out-file)
    307 				     (or cmdline "")))
    308                     (oracle (format
    309 			     "sqlplus -s %s < %s > %s"
    310 			     (org-babel-sql-dbstring-oracle
    311 			      dbhost dbport dbuser dbpassword database)
    312 			     (org-babel-process-file-name in-file)
    313 			     (org-babel-process-file-name out-file)))
    314 		    (saphana (format "hdbsql %s -I %s -o %s %s"
    315 				     (org-babel-sql-dbstring-saphana
    316 				      dbhost dbport dbinstance dbuser dbpassword database)
    317 				     (org-babel-process-file-name in-file)
    318 				     (org-babel-process-file-name out-file)
    319 				     (or cmdline "")))
    320                     (t (user-error "No support for the %s SQL engine" engine)))))
    321     (with-temp-file in-file
    322       (insert
    323        (pcase (intern engine)
    324 	 (`dbi "/format partbox\n")
    325          (`oracle "SET PAGESIZE 50000
    326 SET NEWPAGE 0
    327 SET TAB OFF
    328 SET SPACE 0
    329 SET LINESIZE 9999
    330 SET TRIMOUT ON TRIMSPOOL ON
    331 SET ECHO OFF
    332 SET FEEDBACK OFF
    333 SET VERIFY OFF
    334 SET HEADING ON
    335 SET MARKUP HTML OFF SPOOL OFF
    336 SET COLSEP '|'
    337 
    338 ")
    339 	 ((or `mssql `sqsh) "SET NOCOUNT ON
    340 
    341 ")
    342 	 (`vertica "\\a\n")
    343 	 (_ ""))
    344        (org-babel-expand-body:sql body params)
    345        ;; "sqsh" requires "go" inserted at EOF.
    346        (if (string= engine "sqsh") "\ngo" "")))
    347     (org-babel-eval command "")
    348     (org-babel-result-cond result-params
    349       (with-temp-buffer
    350 	(progn (insert-file-contents-literally out-file) (buffer-string)))
    351       (with-temp-buffer
    352 	(cond
    353 	 ((memq (intern engine) '(dbi mysql postgresql postgres saphana sqsh vertica))
    354 	  ;; Add header row delimiter after column-names header in first line
    355 	  (cond
    356 	   (colnames-p
    357 	    (with-temp-buffer
    358 	      (insert-file-contents out-file)
    359 	      (goto-char (point-min))
    360 	      (forward-line 1)
    361 	      (insert "-\n")
    362 	      (setq header-delim "-")
    363 	      (write-file out-file)))))
    364 	 (t
    365 	  ;; Need to figure out the delimiter for the header row
    366 	  (with-temp-buffer
    367 	    (insert-file-contents out-file)
    368 	    (goto-char (point-min))
    369 	    (when (re-search-forward "^\\(-+\\)[^-]" nil t)
    370 	      (setq header-delim (match-string-no-properties 1)))
    371 	    (goto-char (point-max))
    372 	    (forward-char -1)
    373 	    (while (looking-at "\n")
    374 	      (delete-char 1)
    375 	      (goto-char (point-max))
    376 	      (forward-char -1))
    377 	    (write-file out-file))))
    378 	(org-table-import out-file (if (string= engine "sqsh") '(4) '(16)))
    379 	(org-babel-reassemble-table
    380 	 (mapcar (lambda (x)
    381 		   (if (string= (car x) header-delim)
    382 		       'hline
    383 		     x))
    384 		 (org-table-to-lisp))
    385 	 (org-babel-pick-name (cdr (assq :colname-names params))
    386 			      (cdr (assq :colnames params)))
    387 	 (org-babel-pick-name (cdr (assq :rowname-names params))
    388 			      (cdr (assq :rownames params))))))))
    389 
    390 (defun org-babel-sql-expand-vars (body vars &optional sqlite)
    391   "Expand the variables held in VARS in BODY.
    392 
    393 If SQLITE has been provided, prevent passing a format to
    394 `orgtbl-to-csv'.  This prevents overriding the default format, which if
    395 there were commas in the context of the table broke the table as an
    396 argument mechanism."
    397   (mapc
    398    (lambda (pair)
    399      (setq body
    400 	   (replace-regexp-in-string
    401 	    (format "$%s" (car pair))
    402 	    (let ((val (cdr pair)))
    403               (if (listp val)
    404                   (let ((data-file (org-babel-temp-file "sql-data-")))
    405                     (with-temp-file data-file
    406                       (insert (orgtbl-to-csv
    407                                val (if sqlite
    408                                        nil
    409                                      '(:fmt (lambda (el) (if (stringp el)
    410                                                         el
    411                                                       (format "%S" el))))))))
    412                     data-file)
    413                 (if (stringp val) val (format "%S" val))))
    414 	    body t t)))
    415    vars)
    416   body)
    417 
    418 (defun org-babel-prep-session:sql (_session _params)
    419   "Raise an error because Sql sessions aren't implemented."
    420   (error "SQL sessions not yet implemented"))
    421 
    422 (provide 'ob-sql)
    423 
    424 ;;; ob-sql.el ends here