dotemacs

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

orgtbl-sqlinsert.el (4282B)

      1 ;;; orgtbl-sqlinsert.el --- orgtbl to SQL insert statements.
      2 
      3 ;; Copyright (C) 2008-2021  Free Software Foundation, Inc.
      4 
      5 ;; Author: Jason Riedy <jason@acm.org>
      6 ;; Keywords: org, tables, sql
      7 
      8 ;; This file is not part of GNU Emacs.
      9 
     10 ;; This program is free software; you can redistribute it and/or modify
     11 ;; it under the terms of the GNU General Public License as published by
     12 ;; the Free Software Foundation, either version 3 of the License, or
     13 ;; (at your option) any later version.
     14 
     15 ;; This program is distributed in the hope that it will be useful,
     16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     18 ;; GNU General Public License for more details.
     19 
     20 ;; You should have received a copy of the GNU General Public License
     21 ;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
     22 
     23 ;;; Commentary:
     24 
     25 ;; Converts an orgtbl to a sequence of SQL insertion commands.
     26 ;; Table cells are quoted and escaped very conservatively.
     27 
     28 ;;; Code:
     29 
     30 (defun orgtbl-to-sqlinsert (table params)
     31   "Convert the orgtbl-mode TABLE to SQL insert statements.
     32 TABLE is a list, each entry either the symbol `hline' for a horizontal
     33 separator line, or a list of fields for that line.
     34 PARAMS is a property list of parameters that can influence the conversion.
     35 
     36 Names and strings are modified slightly by default.  Single-ticks
     37 are doubled as per SQL's standard mechanism.  Backslashes and
     38 dollar signs are deleted.  And tildes are changed to spaces.
     39 These modifications were chosen for use with TeX.  See
     40 ORGTBL-SQL-STRIP-AND-QUOTE.
     41 
     42 Supports all parameters from ORGTBL-TO-GENERIC.  New to this function
     43 are:
     44 
     45 :sqlname   The name of the database table; defaults to the name of the
     46            target region.
     47 
     48 :nowebname If not nil, used as a wrapping noweb fragment name.
     49 
     50 The most important parameters of ORGTBL-TO-GENERIC for SQL are:
     51 
     52 :splice    When set to t, return only insert statements, don't wrap
     53            them in a transaction.  Default is nil.
     54 
     55 :tstart, :tend
     56            The strings used to begin and commit the transaction.
     57 
     58 :hfmt      A function that gathers the quoted header names into a
     59            dynamically scoped variable HDRLIST.  Probably should
     60            not be changed by the user.
     61 
     62 The general parameters :skip and :skipcols have already been applied when
     63 this function is called."
     64   (let* (hdrlist
     65 	 (alignment (mapconcat (lambda (x) (if x "r" "l"))
     66 			       org-table-last-alignment ""))
     67 	 (nowebname (plist-get params :nowebname))
     68 	 (breakvals (plist-get params :breakvals))
     69          (firstheader t)
     70          (*orgtbl-default-fmt* 'orgtbl-sql-strip-and-quote)
     71 	 (params2
     72 	  (list
     73 	   :sqlname (plist-get params :sqlname)
     74 	   :tstart (lambda () (concat (if nowebname
     75 					  (format "<<%s>>= \n" nowebname)
     76 					"")
     77 				      "BEGIN TRANSACTION;"))
     78 	   :tend (lambda () (concat "COMMIT;" (if nowebname "\n@ " "")))
     79 	   :hfmt (lambda (f) (progn (if firstheader (push f hdrlist) "")))
     80 	   :hlfmt (lambda (&rest cells) (setq firstheader nil))
     81 	   :lstart (lambda () (concat "INSERT INTO "
     82 				      sqlname "( "
     83 				      (mapconcat 'identity (reverse hdrlist)
     84 						 ", ")
     85 				      " )" (if breakvals "\n" " ")
     86 				      "VALUES ( "))
     87 	   :lend " );"
     88 	   :sep " , "
     89 	   :hline nil
     90 	   :remove-nil-lines t))
     91 	 (params (org-combine-plists params2 params))
     92          (sqlname (plist-get params :sqlname)))
     93     (orgtbl-to-generic table params)))
     94 
     95 (defun orgtbl-sql-quote (str)
     96   "Convert single ticks to doubled single ticks and wrap in single ticks."
     97   (concat "'" (mapconcat 'identity (split-string str "'") "''") "'"))
     98 
     99 (defun orgtbl-sql-strip-dollars-escapes-tildes (str)
    100   "Strip dollarsigns and backslash escapes, replace tildes with spaces."
    101   (mapconcat 'identity
    102 	     (split-string (mapconcat 'identity
    103 				      (split-string str "\\$\\|\\\\")
    104 				      "")
    105 			   "~")
    106 	     " "))
    107 
    108 (defun orgtbl-sql-strip-and-quote (str)
    109   "Apply ORGBTL-SQL-QUOTE and ORGTBL-SQL-STRIP-DOLLARS-ESCAPES-TILDES
    110 to sanitize STR for use in SQL statements."
    111   (cond ((stringp str)
    112          (orgtbl-sql-quote (orgtbl-sql-strip-dollars-escapes-tildes str)))
    113         ((sequencep str) (mapcar 'orgtbl-sql-strip-and-quote str))
    114         (t nil)))
    115 
    116 (provide 'orgtbl-sqlinsert)
    117 
    118 ;;; orgtbl-sqlinsert.el ends here