emacsql-sqlite.el (7392B)
1 ;;; emacsql-sqlite.el --- EmacSQL back-end for SQLite -*- lexical-binding: t; -*- 2 3 ;; This is free and unencumbered software released into the public domain. 4 5 ;; Author: Christopher Wellons <wellons@nullprogram.com> 6 ;; URL: https://github.com/skeeto/emacsql 7 ;; Version: 1.0.0 8 ;; Package-Requires: ((emacs "25.1") (emacsql "2.0.0")) 9 10 ;;; Commentary: 11 12 ;; During package installation EmacSQL will attempt to compile a 13 ;; custom native binary for communicating with a SQLite database. 14 15 ;;; Code: 16 17 (require 'cl-lib) 18 (require 'cl-generic) 19 (require 'eieio) 20 (require 'url) 21 (require 'url-http) 22 (require 'emacsql) 23 24 ;;; SQLite connection 25 26 (defvar emacsql-sqlite-data-root 27 (file-name-directory (or load-file-name buffer-file-name)) 28 "Directory where EmacSQL is installed.") 29 30 (defvar emacsql-sqlite-executable 31 (expand-file-name (if (memq system-type '(windows-nt cygwin ms-dos)) 32 "sqlite/emacsql-sqlite.exe" 33 "sqlite/emacsql-sqlite") 34 emacsql-sqlite-data-root) 35 "Path to the EmacSQL backend (this is not the sqlite3 shell).") 36 37 (defvar emacsql-sqlite-reserved 38 (emacsql-register-reserved 39 '(ABORT ACTION ADD AFTER ALL ALTER ANALYZE AND AS ASC ATTACH 40 AUTOINCREMENT BEFORE BEGIN BETWEEN BY CASCADE CASE CAST CHECK 41 COLLATE COLUMN COMMIT CONFLICT CONSTRAINT CREATE CROSS 42 CURRENT_DATE CURRENT_TIME CURRENT_TIMESTAMP DATABASE DEFAULT 43 DEFERRABLE DEFERRED DELETE DESC DETACH DISTINCT DROP EACH ELSE END 44 ESCAPE EXCEPT EXCLUSIVE EXISTS EXPLAIN FAIL FOR FOREIGN FROM FULL 45 GLOB GROUP HAVING IF IGNORE IMMEDIATE IN INDEX INDEXED INITIALLY 46 INNER INSERT INSTEAD INTERSECT INTO IS ISNULL JOIN KEY LEFT LIKE 47 LIMIT MATCH NATURAL NO NOT NOTNULL NULL OF OFFSET ON OR ORDER 48 OUTER PLAN PRAGMA PRIMARY QUERY RAISE RECURSIVE REFERENCES REGEXP 49 REINDEX RELEASE RENAME REPLACE RESTRICT RIGHT ROLLBACK ROW 50 SAVEPOINT SELECT SET TABLE TEMP TEMPORARY THEN TO TRANSACTION 51 TRIGGER UNION UNIQUE UPDATE USING VACUUM VALUES VIEW VIRTUAL WHEN 52 WHERE WITH WITHOUT)) 53 "List of all of SQLite's reserved words. 54 http://www.sqlite.org/lang_keywords.html") 55 56 (defclass emacsql-sqlite-connection (emacsql-connection emacsql-protocol-mixin) 57 ((file :initarg :file 58 :type (or null string) 59 :documentation "Database file name.") 60 (types :allocation :class 61 :reader emacsql-types 62 :initform '((integer "INTEGER") 63 (float "REAL") 64 (object "TEXT") 65 (nil nil)))) 66 (:documentation "A connection to a SQLite database.")) 67 68 (cl-defmethod initialize-instance :after 69 ((connection emacsql-sqlite-connection) &rest _) 70 (emacsql-sqlite-ensure-binary) 71 (let* ((process-connection-type nil) ; use a pipe 72 (coding-system-for-write 'utf-8-auto) 73 (coding-system-for-read 'utf-8-auto) 74 (file (slot-value connection 'file)) 75 (buffer (generate-new-buffer " *emacsql-sqlite*")) 76 (fullfile (if file (expand-file-name file) ":memory:")) 77 (process (start-process 78 "emacsql-sqlite" buffer emacsql-sqlite-executable fullfile))) 79 (setf (slot-value connection 'process) process) 80 (setf (process-sentinel process) 81 (lambda (proc _) (kill-buffer (process-buffer proc)))) 82 (emacsql-wait connection) 83 (emacsql connection [:pragma (= busy-timeout $s1)] 84 (/ (* emacsql-global-timeout 1000) 2)) 85 (emacsql-register connection))) 86 87 (cl-defun emacsql-sqlite (file &key debug) 88 "Open a connected to database stored in FILE. 89 If FILE is nil use an in-memory database. 90 91 :debug LOG -- When non-nil, log all SQLite commands to a log 92 buffer. This is for debugging purposes." 93 (let ((connection (make-instance 'emacsql-sqlite-connection :file file))) 94 (when debug 95 (emacsql-enable-debugging connection)) 96 connection)) 97 98 (cl-defmethod emacsql-close ((connection emacsql-sqlite-connection)) 99 "Gracefully exits the SQLite subprocess." 100 (let ((process (emacsql-process connection))) 101 (when (process-live-p process) 102 (process-send-eof process)))) 103 104 (cl-defmethod emacsql-send-message ((connection emacsql-sqlite-connection) message) 105 (let ((process (emacsql-process connection))) 106 (process-send-string process (format "%d " (string-bytes message))) 107 (process-send-string process message) 108 (process-send-string process "\n"))) 109 110 (defvar emacsql-sqlite-condition-alist 111 '(((1 4 9 12 17 18 20 21 22 25) emacsql-error) 112 ((2) emacsql-internal) 113 ((3 8 10 13 14 15 23) emacsql-access) 114 ((5 6) emacsql-locked) 115 ((7) emacsql-memory) 116 ((11 16 24 26) emacsql-corruption) 117 ((19) emacsql-constraint) 118 ((27 28) emacsql-warning)) 119 "List of regexp's mapping sqlite3 output to conditions.") 120 121 (cl-defmethod emacsql-handle ((_ emacsql-sqlite-connection) code message) 122 "Get condition for MESSAGE provided from SQLite." 123 (signal 124 (or (cl-second (cl-assoc code emacsql-sqlite-condition-alist :test #'memql)) 125 'emacsql-error) 126 (list message))) 127 128 ;;; SQLite compilation 129 130 (defun emacsql-sqlite-compile-switches () 131 "Return the compilation switches from the Makefile under sqlite/." 132 (let ((makefile (expand-file-name "sqlite/Makefile" emacsql-sqlite-data-root)) 133 (case-fold-search nil)) 134 (with-temp-buffer 135 (insert-file-contents makefile) 136 (setf (point) (point-min)) 137 (cl-loop while (re-search-forward "-D[A-Z0-9_=]+" nil :no-error) 138 collect (match-string 0))))) 139 140 (defun emacsql-sqlite-compile (&optional o-level async) 141 "Compile the SQLite back-end for EmacSQL, returning non-nil on success. 142 If called with non-nil ASYNC the return value is meaningless." 143 (let* ((cc (executable-find "cc")) 144 (src (expand-file-name "sqlite" emacsql-sqlite-data-root)) 145 (files (mapcar (lambda (f) (expand-file-name f src)) 146 '("sqlite3.c" "emacsql.c"))) 147 (cflags (list (format "-I%s" src) (format "-O%d" (or o-level 2)))) 148 (ldlibs (if (memq system-type '(windows-nt berkeley-unix)) 149 (list "-lm") 150 (list "-lm" "-ldl"))) 151 (options (emacsql-sqlite-compile-switches)) 152 (output (list "-o" emacsql-sqlite-executable)) 153 (arguments (nconc cflags options files ldlibs output))) 154 (cond ((not cc) 155 (prog1 nil 156 (message "Could not find C compiler, skipping SQLite build"))) 157 (t (message "Compiling EmacSQL SQLite binary ...") 158 (let ((log (get-buffer-create byte-compile-log-buffer))) 159 (with-current-buffer log 160 (let ((inhibit-read-only t)) 161 (insert (mapconcat #'identity (cons cc arguments) " ") "\n") 162 (eql 0 (apply #'call-process cc nil (if async 0 t) t 163 arguments))))))))) 164 165 ;;; Ensure the SQLite binary is available 166 167 (defun emacsql-sqlite-ensure-binary () 168 "Ensure the EmacSQL SQLite binary is available, signaling an error if not." 169 (unless (file-exists-p emacsql-sqlite-executable) 170 ;; try compiling at the last minute 171 (unless (ignore-errors (emacsql-sqlite-compile 2)) 172 (error "No EmacSQL SQLite binary available, aborting")))) 173 174 (provide 'emacsql-sqlite) 175 176 ;;; emacsql-sqlite.el ends here