]> code.delx.au - gnu-emacs/blobdiff - lisp/org/ob-sql.el
Merge Org version 8.2.3a.
[gnu-emacs] / lisp / org / ob-sql.el
index 131fa46f147577600aca5d105f710ea6867636a1..658a54f1d8a333d2964026693bbfee45b4118e84 100644 (file)
 ;;
 ;; Also SQL evaluation generally takes place inside of a database.
 ;;
-;; For now lets just allow a generic ':cmdline' header argument.
+;; Header args used:
+;; - engine
+;; - cmdline
+;; - dbhost
+;; - dbuser
+;; - dbpassword
+;; - database
+;; - colnames (default, nil, means "yes")
+;; - result-params
+;; - out-file
+;; The following are used but not really implemented for SQL:
+;; - colname-names
+;; - rownames
+;; - rowname-names
 ;;
 ;; TODO:
 ;;
 ;; - support for sessions
-;; - add more useful header arguments (user, passwd, database, etc...)
 ;; - support for more engines (currently only supports mysql)
 ;; - what's a reasonable way to drop table data into SQL?
 ;;
 
 (defvar org-babel-default-header-args:sql '())
 
-(defvar org-babel-header-args:sql
-  '((engine   . :any)
-    (out-file . :any)))
+(defconst org-babel-header-args:sql
+  '((engine           . :any)
+    (out-file         . :any)
+    (dbhost           . :any)
+    (dbuser           . :any)
+    (dbpassword               . :any)
+    (database         . :any))
+  "SQL-specific header arguments.")
 
 (defun org-babel-expand-body:sql (body params)
   "Expand BODY according to the values of PARAMS."
   (org-babel-sql-expand-vars
    body (mapcar #'cdr (org-babel-get-header params :var))))
 
+(defun dbstring-mysql (host user password database)
+  "Make MySQL cmd line args for database connection.  Pass nil to omit that arg."
+  (combine-and-quote-strings
+   (remq nil
+        (list (when host     (concat "-h" host))
+              (when user     (concat "-u" user))
+              (when password (concat "-p" password))
+              (when database (concat "-D" database))))))
+
 (defun org-babel-execute:sql (body params)
   "Execute a block of Sql code with Babel.
 This function is called by `org-babel-execute-src-block'."
   (let* ((result-params (cdr (assoc :result-params params)))
          (cmdline (cdr (assoc :cmdline params)))
+         (dbhost (cdr (assoc :dbhost params)))
+         (dbuser (cdr (assoc :dbuser params)))
+         (dbpassword (cdr (assoc :dbpassword params)))
+         (database (cdr (assoc :database params)))
          (engine (cdr (assoc :engine params)))
+         (colnames-p (not (equal "no" (cdr (assoc :colnames params)))))
          (in-file (org-babel-temp-file "sql-in-"))
          (out-file (or (cdr (assoc :out-file params))
                        (org-babel-temp-file "sql-out-")))
         (header-delim "")
          (command (case (intern engine)
-                    ('dbi (format "dbish --batch '%s' < %s | sed '%s' > %s"
+                    ('dbi (format "dbish --batch %s < %s | sed '%s' > %s"
                                  (or cmdline "")
                                  (org-babel-process-file-name in-file)
-                                 "/^+/d;s/^\|//;$d"
+                                 "/^+/d;s/^\|//;s/(NULL)/ /g;$d"
                                  (org-babel-process-file-name out-file)))
                     ('monetdb (format "mclient -f tab %s < %s > %s"
                                       (or cmdline "")
@@ -85,7 +116,9 @@ This function is called by `org-babel-execute-src-block'."
                                      (or cmdline "")
                                      (org-babel-process-file-name in-file)
                                      (org-babel-process-file-name out-file)))
-                    ('mysql (format "mysql %s < %s > %s"
+                    ('mysql (format "mysql %s %s %s < %s > %s"
+                                   (dbstring-mysql dbhost dbuser dbpassword database)
+                                   (if colnames-p "" "-N")
                                     (or cmdline "")
                                    (org-babel-process-file-name in-file)
                                    (org-babel-process-file-name out-file)))
@@ -102,28 +135,39 @@ This function is called by `org-babel-execute-src-block'."
         (t ""))
        (org-babel-expand-body:sql body params)))
     (message command)
-    (shell-command command)
-    (if (or (member "scalar" result-params)
-           (member "verbatim" result-params)
-           (member "html" result-params)
-           (member "code" result-params)
-           (equal (point-min) (point-max)))
-       (with-temp-buffer
+    (org-babel-eval command "")
+    (org-babel-result-cond result-params
+      (with-temp-buffer
          (progn (insert-file-contents-literally out-file) (buffer-string)))
       (with-temp-buffer
-       ;; need to figure out what the delimiter is 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))
+       (cond
+         ((or (eq (intern engine) 'mysql)
+              (eq (intern engine) 'dbi)
+              (eq (intern engine) 'postgresql))
+          ;; 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 '(16))
        (org-babel-reassemble-table
         (mapcar (lambda (x)