dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

ob-sql.el (15952B)


      1 ;;; ob-sql.el --- Babel Functions for SQL            -*- lexical-binding: t; -*-
      2 
      3 ;; Copyright (C) 2009-2023 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     (condition-case nil
    117         (sql-set-product product)
    118       (user-error "Cannot set `sql-product' in Org Src edit buffer"))))
    119 
    120 (defun org-babel-sql-dbstring-mysql (host port user password database)
    121   "Make MySQL cmd line args for database connection.  Pass nil to omit that arg."
    122   (combine-and-quote-strings
    123    (delq nil
    124 	 (list (when host     (concat "-h" host))
    125 	       (when port     (format "-P%d" port))
    126 	       (when user     (concat "-u" user))
    127 	       (when password (concat "-p" password))
    128 	       (when database (concat "-D" database))))))
    129 
    130 (defun org-babel-sql-dbstring-postgresql (host port user database)
    131   "Make PostgreSQL command line args for database connection.
    132 Pass nil to omit that arg."
    133   (combine-and-quote-strings
    134    (delq nil
    135 	 (list (when host (concat "-h" host))
    136 	       (when port (format "-p%d" port))
    137 	       (when user (concat "-U" user))
    138 	       (when database (concat "-d" database))))))
    139 
    140 (defun org-babel-sql-dbstring-oracle (host port user password database)
    141   "Make Oracle command line arguments for database connection.
    142 
    143 If HOST and PORT are nil then don't pass them.  This allows you
    144 to use names defined in your \"TNSNAMES\" file.  So you can
    145 connect with
    146 
    147   <user>/<password>@<host>:<port>/<database>
    148 
    149 or
    150 
    151   <user>/<password>@<database>
    152 
    153 using its alias."
    154   (cond ((and user password database host port)
    155 	 (format "%s/%s@%s:%s/%s" user password host port database))
    156 	((and user password database)
    157 	 (format "%s/%s@%s" user password database))
    158 	(t (user-error "Missing information to connect to database"))))
    159 
    160 (defun org-babel-sql-dbstring-mssql (host user password database)
    161   "Make sqlcmd command line args for database connection.
    162 `sqlcmd' is the preferred command line tool to access Microsoft
    163 SQL Server on Windows and Linux platform."
    164   (mapconcat #'identity
    165 	     (delq nil
    166 		   (list (when host (format "-S \"%s\"" host))
    167 			 (when user (format "-U \"%s\"" user))
    168 			 (when password (format "-P \"%s\"" password))
    169 			 (when database (format "-d \"%s\"" database))))
    170 	     " "))
    171 
    172 (defun org-babel-sql-dbstring-sqsh (host user password database)
    173   "Make sqsh command line args for database connection.
    174 \"sqsh\" is one method to access Sybase or MS SQL via Linux platform"
    175   (mapconcat #'identity
    176              (delq nil
    177                    (list  (when host     (format "-S \"%s\"" host))
    178                           (when user     (format "-U \"%s\"" user))
    179                           (when password (format "-P \"%s\"" password))
    180                           (when database (format "-D \"%s\"" database))))
    181              " "))
    182 
    183 (defun org-babel-sql-dbstring-vertica (host port user password database)
    184   "Make Vertica command line args for database connection.
    185 Pass nil to omit that arg."
    186   (mapconcat #'identity
    187 	     (delq nil
    188 		   (list (when host     (format "-h %s" host))
    189 			 (when port     (format "-p %d" port))
    190 			 (when user     (format "-U %s" user))
    191 			 (when password (format "-w %s" (shell-quote-argument password) ))
    192 			 (when database (format "-d %s" database))))
    193 	     " "))
    194 
    195 (defun org-babel-sql-dbstring-saphana (host port instance user password database)
    196   "Make SAP HANA command line args for database connection.
    197 Pass nil to omit that arg."
    198   (mapconcat #'identity
    199              (delq nil
    200                    (list (and host port (format "-n %s:%s" host port))
    201                          (and host (not port) (format "-n %s" host))
    202                          (and instance (format "-i %d" instance))
    203                          (and user (format "-u %s" user))
    204                          (and password (format "-p %s"
    205                                                (shell-quote-argument password)))
    206                          (and database (format "-d %s" database))))
    207              " "))
    208 
    209 (defun org-babel-sql-convert-standard-filename (file)
    210   "Convert FILE to OS standard file name.
    211 If in Cygwin environment, uses Cygwin specific function to
    212 convert the file name.  In a Windows-NT environment, do nothing.
    213 Otherwise, use Emacs' standard conversion function."
    214   (cond ((fboundp 'cygwin-convert-file-name-to-windows)
    215 	 (format "%S" (cygwin-convert-file-name-to-windows file)))
    216 	((string= "windows-nt" system-type) file)
    217 	(t (format "%S" (convert-standard-filename file)))))
    218 
    219 (defun org-babel-find-db-connection-param (params name)
    220   "Return database connection parameter NAME.
    221 Given a parameter NAME, if :dbconnection is defined in PARAMS
    222 then look for the parameter into the corresponding connection
    223 defined in `sql-connection-alist', otherwise look into PARAMS.
    224 See `sql-connection-alist' (part of SQL mode) for how to define
    225 database connections."
    226   (or (cdr (assq name params))
    227       (and (assq :dbconnection params)
    228            (let* ((dbconnection (cdr (assq :dbconnection params)))
    229                   (name-mapping '((:dbhost . sql-server)
    230                                   (:dbport . sql-port)
    231                                   (:dbuser . sql-user)
    232                                   (:dbpassword . sql-password)
    233                                   (:dbinstance . sql-dbinstance)
    234                                   (:database . sql-database)))
    235                   (mapped-name (cdr (assq name name-mapping))))
    236              (cadr (assq mapped-name
    237                          (cdr (assoc dbconnection sql-connection-alist))))))))
    238 
    239 (defun org-babel-execute:sql (body params)
    240   "Execute a block of Sql code with Babel.
    241 This function is called by `org-babel-execute-src-block'."
    242   (let* ((result-params (cdr (assq :result-params params)))
    243          (cmdline (cdr (assq :cmdline params)))
    244          (dbhost (org-babel-find-db-connection-param params :dbhost))
    245          (dbport (org-babel-find-db-connection-param params :dbport))
    246          (dbuser (org-babel-find-db-connection-param params :dbuser))
    247          (dbpassword (org-babel-find-db-connection-param params :dbpassword))
    248          (dbinstance (org-babel-find-db-connection-param params :dbinstance))
    249          (database (org-babel-find-db-connection-param params :database))
    250          (engine (cdr (assq :engine params)))
    251          (colnames-p (not (equal "no" (cdr (assq :colnames params)))))
    252          (in-file (org-babel-temp-file "sql-in-"))
    253          (out-file (or (cdr (assq :out-file params))
    254                        (org-babel-temp-file "sql-out-")))
    255 	 (header-delim "")
    256          (command (cl-case (intern engine)
    257                     (dbi (format "dbish --batch %s < %s | sed '%s' > %s"
    258 				 (or cmdline "")
    259 				 (org-babel-process-file-name in-file)
    260 				 "/^+/d;s/^|//;s/(NULL)/ /g;$d"
    261 				 (org-babel-process-file-name out-file)))
    262                     (monetdb (format "mclient -f tab %s < %s > %s"
    263 				     (or cmdline "")
    264 				     (org-babel-process-file-name in-file)
    265 				     (org-babel-process-file-name out-file)))
    266 		    (mssql (format "sqlcmd %s -s \"\t\" %s -i %s -o %s"
    267 				   (or cmdline "")
    268 				   (org-babel-sql-dbstring-mssql
    269 				    dbhost dbuser dbpassword database)
    270 				   (org-babel-sql-convert-standard-filename
    271 				    (org-babel-process-file-name in-file))
    272 				   (org-babel-sql-convert-standard-filename
    273 				    (org-babel-process-file-name out-file))))
    274                     (mysql (format "mysql %s %s %s < %s > %s"
    275 				   (org-babel-sql-dbstring-mysql
    276 				    dbhost dbport dbuser dbpassword database)
    277 				   (if colnames-p "" "-N")
    278 				   (or cmdline "")
    279 				   (org-babel-process-file-name in-file)
    280 				   (org-babel-process-file-name out-file)))
    281 		    ((postgresql postgres) (format
    282 					    "%s%s --set=\"ON_ERROR_STOP=1\" %s -A -P \
    283 footer=off -F \"\t\"  %s -f %s -o %s %s"
    284 					    (if dbpassword
    285 						(format "PGPASSWORD=%s " dbpassword)
    286 					      "")
    287                                             (or (bound-and-true-p
    288                                                  sql-postgres-program)
    289                                                 "psql")
    290 					    (if colnames-p "" "-t")
    291 					    (org-babel-sql-dbstring-postgresql
    292 					     dbhost dbport dbuser database)
    293 					    (org-babel-process-file-name in-file)
    294 					    (org-babel-process-file-name out-file)
    295 					    (or cmdline "")))
    296 		    (sqsh (format "sqsh %s %s -i %s -o %s -m csv"
    297 				  (or cmdline "")
    298 				  (org-babel-sql-dbstring-sqsh
    299 				   dbhost dbuser dbpassword database)
    300 				  (org-babel-sql-convert-standard-filename
    301 				   (org-babel-process-file-name in-file))
    302 				  (org-babel-sql-convert-standard-filename
    303 				   (org-babel-process-file-name out-file))))
    304 		    (vertica (format "vsql %s -f %s -o %s %s"
    305 				     (org-babel-sql-dbstring-vertica
    306 				      dbhost dbport dbuser dbpassword database)
    307 				     (org-babel-process-file-name in-file)
    308 				     (org-babel-process-file-name out-file)
    309 				     (or cmdline "")))
    310                     (oracle (format
    311 			     "sqlplus -s %s < %s > %s"
    312 			     (org-babel-sql-dbstring-oracle
    313 			      dbhost dbport dbuser dbpassword database)
    314 			     (org-babel-process-file-name in-file)
    315 			     (org-babel-process-file-name out-file)))
    316 		    (saphana (format "hdbsql %s -I %s -o %s %s"
    317 				     (org-babel-sql-dbstring-saphana
    318 				      dbhost dbport dbinstance dbuser dbpassword database)
    319 				     (org-babel-process-file-name in-file)
    320 				     (org-babel-process-file-name out-file)
    321 				     (or cmdline "")))
    322                     (t (user-error "No support for the %s SQL engine" engine)))))
    323     (with-temp-file in-file
    324       (insert
    325        (pcase (intern engine)
    326 	 (`dbi "/format partbox\n")
    327          (`oracle "SET PAGESIZE 50000
    328 SET NEWPAGE 0
    329 SET TAB OFF
    330 SET SPACE 0
    331 SET LINESIZE 9999
    332 SET TRIMOUT ON TRIMSPOOL ON
    333 SET ECHO OFF
    334 SET FEEDBACK OFF
    335 SET VERIFY OFF
    336 SET HEADING ON
    337 SET MARKUP HTML OFF SPOOL OFF
    338 SET COLSEP '|'
    339 
    340 ")
    341 	 ((or `mssql `sqsh) "SET NOCOUNT ON
    342 
    343 ")
    344 	 (`vertica "\\a\n")
    345 	 (_ ""))
    346        (org-babel-expand-body:sql body params)
    347        ;; "sqsh" requires "go" inserted at EOF.
    348        (if (string= engine "sqsh") "\ngo" "")))
    349     (org-babel-eval command "")
    350     (org-babel-result-cond result-params
    351       (with-temp-buffer
    352 	(progn (insert-file-contents-literally out-file) (buffer-string)))
    353       (with-temp-buffer
    354 	(cond
    355 	 ((memq (intern engine) '(dbi mysql postgresql postgres saphana sqsh vertica))
    356 	  ;; Add header row delimiter after column-names header in first line
    357 	  (cond
    358 	   (colnames-p
    359 	    (with-temp-buffer
    360 	      (insert-file-contents out-file)
    361 	      (goto-char (point-min))
    362 	      (forward-line 1)
    363 	      (insert "-\n")
    364 	      (setq header-delim "-")
    365 	      (write-file out-file)))))
    366 	 (t
    367 	  ;; Need to figure out the delimiter for the header row
    368 	  (with-temp-buffer
    369 	    (insert-file-contents out-file)
    370 	    (goto-char (point-min))
    371 	    (when (re-search-forward "^\\(-+\\)[^-]" nil t)
    372 	      (setq header-delim (match-string-no-properties 1)))
    373 	    (goto-char (point-max))
    374 	    (forward-char -1)
    375 	    (while (looking-at "\n")
    376 	      (delete-char 1)
    377 	      (goto-char (point-max))
    378 	      (forward-char -1))
    379 	    (write-file out-file))))
    380 	(org-table-import out-file (if (string= engine "sqsh") '(4) '(16)))
    381 	(org-babel-reassemble-table
    382 	 (mapcar (lambda (x)
    383 		   (if (string= (car x) header-delim)
    384 		       'hline
    385 		     x))
    386 		 (org-table-to-lisp))
    387 	 (org-babel-pick-name (cdr (assq :colname-names params))
    388 			      (cdr (assq :colnames params)))
    389 	 (org-babel-pick-name (cdr (assq :rowname-names params))
    390 			      (cdr (assq :rownames params))))))))
    391 
    392 (defun org-babel-sql-expand-vars (body vars &optional sqlite)
    393   "Expand the variables held in VARS in BODY.
    394 
    395 If SQLITE has been provided, prevent passing a format to
    396 `orgtbl-to-csv'.  This prevents overriding the default format, which if
    397 there were commas in the context of the table broke the table as an
    398 argument mechanism."
    399   (mapc
    400    (lambda (pair)
    401      (setq body
    402 	   (replace-regexp-in-string
    403 	    (format "$%s" (car pair))
    404 	    (let ((val (cdr pair)))
    405               (if (listp val)
    406                   (let ((data-file (org-babel-temp-file "sql-data-")))
    407                     (with-temp-file data-file
    408                       (insert (orgtbl-to-csv
    409                                val (if sqlite
    410                                        nil
    411                                      '(:fmt (lambda (el) (if (stringp el)
    412                                                              el
    413                                                            (format "%S" el))))))))
    414                     data-file)
    415                 (if (stringp val) val (format "%S" val))))
    416 	    body)))
    417    vars)
    418   body)
    419 
    420 (defun org-babel-prep-session:sql (_session _params)
    421   "Raise an error because Sql sessions aren't implemented."
    422   (error "SQL sessions not yet implemented"))
    423 
    424 (provide 'ob-sql)
    425 
    426 ;;; ob-sql.el ends here