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