;;; 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 ;; Maintainer: Jonas Bernoulli ;; Homepage: https://github.com/magit/emacsql ;; Package-Version: 3.1.1.50-git ;; Package-Requires: ((emacs "25.1") (emacsql "3.1.1")) ;; SPDX-License-Identifier: Unlicense ;;; Commentary: ;; This package provides the original EmacSQL back-end for SQLite, ;; which uses a custom binary for communicating with a SQLite database. ;; During package installation an attempt is made to compile the binary. ;;; Code: (require 'cl-lib) (require 'cl-generic) (require 'eieio) (require 'emacsql) (emacsql-register-reserved emacsql-sqlite-reserved) ;;; 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-path (if (memq system-type '(windows-nt cygwin ms-dos)) "sqlite/emacsql-sqlite.exe" "sqlite/emacsql-sqlite") "Relative path to emacsql executable.") (defvar emacsql-sqlite-executable (expand-file-name emacsql-sqlite-executable-path (if (or (file-writable-p emacsql-sqlite-data-root) (file-exists-p (expand-file-name emacsql-sqlite-executable-path emacsql-sqlite-data-root))) emacsql-sqlite-data-root (expand-file-name (concat "emacsql/" emacsql-version) user-emacs-directory))) "Path to the EmacSQL backend (this is not the sqlite3 shell).") (defvar emacsql-sqlite-c-compilers '("cc" "gcc" "clang") "List of names to try when searching for a C compiler. Each is queried using `executable-find', so full paths are allowed. Only the first compiler which is successfully found will used.") (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 _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-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"))) (cl-defmethod emacsql-handle ((_ emacsql-sqlite-connection) errcode errmsg) "Get condition for ERRCODE and ERRMSG provided from SQLite." (pcase-let ((`(,_ ,_ ,signal ,errstr) (assq errcode emacsql-sqlite-error-codes))) (signal (or signal 'emacsql-error) (list errmsg errcode nil errstr)))) ;;; 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) (goto-char (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 (cl-loop for option in emacsql-sqlite-c-compilers for path = (executable-find option) if path return it)) (src (expand-file-name "sqlite" emacsql-sqlite-data-root)) (files (mapcar (lambda (f) (expand-file-name f src)) '("sqlite3.c" "emacsql.c"))) (cflags (list (format "-I%s" src) (format "-O%d" (or o-level 2)))) (ldlibs (cl-case system-type (windows-nt (list)) (berkeley-unix (list "-lm")) (otherwise (list "-lm" "-ldl")))) (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 ...") (mkdir (file-name-directory emacsql-sqlite-executable) t) (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