config

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

ob-sqlite.el (5300B)


      1 ;;; ob-sqlite.el --- Babel Functions for SQLite Databases -*- lexical-binding: t; -*-
      2 
      3 ;; Copyright (C) 2010-2024 Free Software Foundation, Inc.
      4 
      5 ;; Author: Eric Schulte
      6 ;; Maintainer: Nick Savage <nick@nicksavage.ca>
      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 sqlite source code.
     28 
     29 ;;; Code:
     30 
     31 (require 'org-macs)
     32 (org-assert-version)
     33 
     34 (require 'ob)
     35 (require 'ob-sql)
     36 
     37 (declare-function org-table-convert-region "org-table"
     38 		  (beg0 end0 &optional separator))
     39 (declare-function orgtbl-to-csv "org-table" (table params))
     40 (declare-function org-table-to-lisp "org-table" (&optional txt))
     41 
     42 (defvar org-babel-default-header-args:sqlite '())
     43 
     44 (defvar org-babel-header-args:sqlite
     45   '((db        . :any)
     46     (header    . :any)
     47     (echo      . :any)
     48     (bail      . :any)
     49     (csv       . :any)
     50     (column    . :any)
     51     (html      . :any)
     52     (line      . :any)
     53     (list      . :any)
     54     (separator . :any)
     55     (nullvalue . :any))
     56   "Sqlite specific header args.")
     57 
     58 (defun org-babel-expand-body:sqlite (body params)
     59   "Expand BODY according to the values of PARAMS."
     60   (let ((prologue (cdr (assq :prologue params)))
     61 	(epilogue (cdr (assq :epilogue params))))
     62     (mapconcat 'identity
     63                (list
     64                 prologue
     65                 (org-babel-sql-expand-vars
     66                  body (org-babel--get-vars params) t)
     67                 epilogue)
     68                "\n")))
     69 
     70 (defvar org-babel-sqlite3-command "sqlite3")
     71 
     72 (defun org-babel-execute:sqlite (body params)
     73   "Execute Sqlite BODY according to PARAMS.
     74 This function is called by `org-babel-execute-src-block'."
     75   (let ((result-params (split-string (or (cdr (assq :results params)) "")))
     76 	(db (cdr (assq :db params)))
     77 	(separator (cdr (assq :separator params)))
     78 	(nullvalue (cdr (assq :nullvalue params)))
     79 	(headers-p (equal "yes" (cdr (assq :colnames params))))
     80 	(others (delq nil (mapcar
     81 			   (lambda (arg) (car (assq arg params)))
     82 			   (list :header :echo :bail :column
     83 				 :csv :html :line :list)))))
     84     (with-temp-buffer
     85       (insert
     86        (org-babel-eval
     87 	(org-fill-template
     88 	 "%cmd %header %separator %nullvalue %others %csv %db "
     89 	 (list
     90 	  (cons "cmd" org-babel-sqlite3-command)
     91 	  (cons "header" (if headers-p "-header" "-noheader"))
     92 	  (cons "separator"
     93 		(if separator (format "-separator %s" separator) ""))
     94 	  (cons "nullvalue"
     95 		(if nullvalue (format "-nullvalue %s" nullvalue) ""))
     96 	  (cons "others"
     97 		(mapconcat
     98 		 (lambda (arg) (format "-%s" (substring (symbol-name arg) 1)))
     99 		 others " "))
    100 	  ;; for easy table parsing, default header type should be -csv
    101 	  (cons "csv" (if (or (member :csv others) (member :column others)
    102 			      (member :line others) (member :list others)
    103 			      (member :html others) separator)
    104 			  ""
    105 			"-csv"))
    106           (cons "db" (or db ""))))
    107 	;; body of the code block
    108 	(org-babel-expand-body:sqlite body params)))
    109       (org-babel-result-cond result-params
    110 	(buffer-string)
    111 	(if (equal (point-min) (point-max))
    112 	    ""
    113 	  (org-table-convert-region (point-min) (point-max)
    114 				    (if (or (member :csv others)
    115 					    (member :column others)
    116 					    (member :line others)
    117 					    (member :list others)
    118 					    (member :html others) separator)
    119 					nil
    120 				      '(4)))
    121 	  (org-babel-sqlite-table-or-scalar
    122 	   (org-babel-sqlite-offset-colnames
    123 	    (org-table-to-lisp) headers-p)))))))
    124 
    125 (defun org-babel-sqlite-expand-vars (body vars)
    126   "Expand the variables held in VARS in BODY."
    127   (declare (obsolete "use `org-babel-sql-expand-vars' instead." "9.5"))
    128   (org-babel-sql-expand-vars body vars t))
    129 
    130 (defun org-babel-sqlite-table-or-scalar (result)
    131   "Cleanup cells in the RESULT table.
    132 If RESULT is a trivial 1x1 table, then unwrap it."
    133   (if (and (equal 1 (length result))
    134 	   (equal 1 (length (car result))))
    135       (org-babel-read (caar result) t)
    136     (mapcar (lambda (row)
    137 	      (if (eq 'hline row)
    138 		  'hline
    139 		(mapcar #'org-babel-sqlite--read-cell row)))
    140 	    result)))
    141 
    142 (defun org-babel-sqlite-offset-colnames (table headers-p)
    143   "If HEADERS-P is non-nil then offset the first row as column names in TABLE."
    144   (if headers-p
    145       (cons (car table) (cons 'hline (cdr table)))
    146     table))
    147 
    148 (defun org-babel-prep-session:sqlite (_session _params)
    149   "Raise an error because support for SQLite sessions isn't implemented.
    150 Prepare SESSION according to the header arguments specified in PARAMS."
    151   (error "SQLite sessions not yet implemented"))
    152 
    153 (defun org-babel-sqlite--read-cell (cell)
    154   "Process CELL to remove unnecessary characters."
    155   (org-babel-read cell t))
    156 
    157 (provide 'ob-sqlite)
    158 
    159 ;;; ob-sqlite.el ends here