procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add sqlite3 support to Emacs

Browse source 
* configure.ac: Add check for the sqlite library.
* doc/lispref/text.texi (Database): Document it.

* lisp/sqlite.el: New file.

* lisp/term/w32-win.el (dynamic-library-alist): Add a mapping.

* src/Makefile.in (SQLITE3_LIBS): Add the libraries.

* src/alloc.c (union emacs_align_type): Add a Lisp_Sqlite struct.

* src/data.c (Ftype_of): Add sqlite.

* src/emacs.c (main): Load the syms.

* src/lisp.h (DEFINE_GDB_SYMBOL_BEGIN): Add PVEC_SQLITE.
(GCALIGNED_STRUCT): New struct to keep data for sqlite database
objects and statement objects.
(SQLITEP, SQLITE, CHECK_SQLITE, XSQLITE): New macros for accessing
the objects.

* src/pdumper.c (dump_vectorlike): Update hash.
(dump_vectorlike): Don't dump it.

* src/print.c (print_vectorlike): Add a printer for the sqlite
object.

* src/sqlite.c: New file.

* test/src/sqlite-tests.el: Add tests.
This commit is contained in:
Lars Ingebrigtsen 2021-12-11 04:55:57 +01:00
parent af1c5ec0fc
commit 3d38d1d134
15 changed files with 1161 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
admin/CPP-DEFINES
View file

@ -288,6 +288,7 @@ HAVE_UTMP_H
HAVE_VFORK
HAVE_VFORK_H
HAVE_WEBP
HAVE_SQLITE3
HAVE_WCHAR_H
HAVE_WCHAR_T
HAVE_WINDOW_SYSTEM

20
configure.ac
View file

@ -448,6 +448,7 @@ OPTION_DEFAULT_ON([gif],[don't compile with GIF image support])
OPTION_DEFAULT_ON([png],[don't compile with PNG image support])
OPTION_DEFAULT_ON([rsvg],[don't compile with SVG image support])
OPTION_DEFAULT_ON([webp],[don't compile with WebP image support])
OPTION_DEFAULT_ON([sqlite3],[don't compile with sqlite3 support])
OPTION_DEFAULT_ON([lcms2],[don't compile with Little CMS support])
OPTION_DEFAULT_ON([libsystemd],[don't compile with libsystemd support])
OPTION_DEFAULT_ON([cairo],[don't compile with Cairo drawing])
@ -2681,6 +2682,22 @@ if test "${with_webp}" != "no"; then
fi
fi
### Use -lsqlite3 if available, unless '--with-sqlite3=no'
HAVE_SQLITE3=no
if test "${with_sqlite3}" != "no"; then
AC_CHECK_LIB(sqlite3, sqlite3_open_v2, HAVE_SQLITE3=yes, HAVE_SQLITE3=no)
if test "$HAVE_SQLITE3" = "yes"; then
SQLITE3_LIBS=-lsqlite3
AC_SUBST(SQLITE3_LIBS)
LIBS="$SQLITE3_LIBS $LIBS"
AC_DEFINE(HAVE_SQLITE3, 1, [Define to 1 if you have the libsqlite3 library (-lsqlite).])
# Windows loads libwebp dynamically
if test "${opsys}" = "mingw32"; then
SQLITE3_LIBS=
fi
fi
fi
HAVE_IMAGEMAGICK=no
if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" = "yes" || test "${HAVE_W32}" = "yes" || \
test "${HAVE_BE_APP}" = "yes"; then
@ -6155,7 +6172,7 @@ emacs_config_features=
for opt in ACL BE_APP CAIRO DBUS FREETYPE GCONF GIF GLIB GMP GNUTLS GPM GSETTINGS \
HARFBUZZ IMAGEMAGICK JPEG JSON LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 \
M17N_FLT MODULES NATIVE_COMP NOTIFY NS OLDXMENU PDUMPER PNG RSVG SECCOMP \
SOUND THREADS TIFF TOOLKIT_SCROLL_BARS \
SOUND SQLITE3 THREADS TIFF TOOLKIT_SCROLL_BARS \
UNEXEC WEBP X11 XAW3D XDBE XFT XIM XINPUT2 XPM XWIDGETS X_TOOLKIT \
ZLIB; do
@ -6202,6 +6219,7 @@ AS_ECHO([" Does Emacs use -lXaw3d? ${HAVE_XAW3D
Does Emacs use a png library? ${HAVE_PNG} $LIBPNG
Does Emacs use -lrsvg-2? ${HAVE_RSVG}
Does Emacs use -lwebp? ${HAVE_WEBP}
Does Emacs use -lsqlite3? ${HAVE_SQLITE3}
Does Emacs use cairo? ${HAVE_CAIRO}
Does Emacs use -llcms2? ${HAVE_LCMS2}
Does Emacs use imagemagick? ${HAVE_IMAGEMAGICK}

1
doc/lispref/elisp.texi
View file

@ -1224,6 +1224,7 @@ Text
* Base 64:: Conversion to or from base 64 encoding.
* Checksum/Hash:: Computing cryptographic hashes.
* GnuTLS Cryptography:: Cryptographic algorithms imported from GnuTLS.
* Database:: Interacting with an SQL database.
* Parsing HTML/XML:: Parsing HTML and XML.
* Atomic Changes:: Installing several buffer changes atomically.
* Change Hooks:: Supplying functions to be run when text is changed.

146
doc/lispref/text.texi
View file

@ -60,6 +60,7 @@ the character after point.
* Base 64:: Conversion to or from base 64 encoding.
* Checksum/Hash:: Computing cryptographic hashes.
* GnuTLS Cryptography:: Cryptographic algorithms imported from GnuTLS.
* Database:: Interacting with an SQL database.
* Parsing HTML/XML:: Parsing HTML and XML.
* Parsing JSON:: Parsing and generating JSON values.
* JSONRPC:: JSON Remote Procedure Call protocol
@ -5135,6 +5136,151 @@ On success, it returns a list of a binary string (the output) and the
IV used.
@end defun
@node Database
@section Database
Emacs can be compiled with built-in SQLite support.
@defun sqlite-available-p
The function returns non-@code{nil} if built-in SQLite support is
available in this Emacs session.
@end defun
When SQLite support is available, the following functions can be used.
@defun sqlite-open &optional file
This function opens @var{file} as a database file. If it doesn't
exist, a new database will be created and stored there. If this
argument is missing or @code{nil}, a new in-memory database is created
instead.
The return value is a @dfn{database object} that can be used as the
argument to most of the subsequent functions in this section of the
manual.
@end defun
@defun sqlitep
The database object returned by the @code{sqlite-open} function
satisfies this predicate.
@end defun
@defun sqlite-close db
Close the database @var{db}. It's usually not necessary to call this
function explicitly---the database will automatically be closed if
Emacs shuts down or the database object is garbage collected.
@end defun
@defun sqlite-execute db statement &optional values
Execute the @acronym{SQL} @var{statement}. For instance:
@lisp
(sqlite-execute db "insert into foo values ('bar', 2)")
@end lisp
If the optional @var{values} parameter is present, it should be either
a list or a vector of values to bind while executing the statement.
For instance:
@lisp
(sqlite-execute db "insert into foo values (?, ?)" '("bar" 2))
@end lisp
This has exactly the same effect as the first form, but is more
efficient and safer (because it doesn't involve any string parsing or
interpolation).
The number of affected rows is returned. For instance, an
@samp{insert} statement will return @samp{1}, but an @samp{update}
statement may return zero or a higher number.
@end defun
@defun sqlite-select db query &optional values result-type
Select some data from @var{db} and return them. For instance:
@lisp
(sqlite-select db "select * from foo where key = 2")
@result{} (("bar" 2))
@end lisp
As with the @code{sqlite-execute} command, you can pass in a list or a
vector of values that will be bound before executing the select:
@lisp
(sqlite-select db "select * from foo where key = ?" [2])
@result{} (("bar" 2))
@end lisp
This is usually more efficient and safer than the first method.
This function, by default, returns a list of matching rows, where each
row is a list of column values. If @var{return-type} is @code{full},
the names of the columns (as a list of strings) will be returned as
the first element in the return value.
If @var{return-type} is @code{set}, this function will return a
@dfn{statement object} instead. This object can be interrogated by
the @code{sqlite-next}, @code{sqlite-columns} and @code{sqlite-more-p}
functions. If the result set is small, it's often more convenient to
just return the data directly, but if the result set is large (or if
you won't be using all the data from the set), using the @code{set}
method will allocate a lot less data, and therefore be more efficient.
@end defun
@defun sqlite-next statement
This function returns the next row in the result set returned by
@code{sqlite-select}.
@lisp
(sqlite-next stmt)
@result{} ("bar" 2)
@end lisp
@end defun
@defun sqlite-columns statement
This function returns the column names of the result set returned by
@code{sqlite-select}.
@lisp
(sqlite-columns stmt)
@result{} ("name" "issue")
@end lisp
@end defun
@defun sqlite-more-p statement
This predicate says whether there is more data to be fetched in the
result set returned by @code{sqlite-select}.
@end defun
@defun sqlite-finalize statement
If @var{statement} is not going to be used any more, calling this
function will free the resources bound by @var{statement}. This is
usually not necessary---when the statement object is
garbage-collected, this will happen automatically.
@end defun
@defun sqlite-transaction db
Start a transaction in @var{db}. When in a transaction, other readers
of the database won't access the results until the transaction has
been committed.
@end defun
@defun sqlite-commit db
End a transaction and write the data out to file.
@end defun
@defun sqlite-rollback db
End a transaction and discard any changes that have been made.
@end defun
@defmac with-sqlite-transaction db &body body
Like @code{progn}, but executes @var{body} with a transaction held,
and do a commit at the end.
@end defmac
@defun sqlite-load-extension db module
Load an extension into @var{db}. Extensions are usually @file{.so} files.
@end defun
@node Parsing HTML/XML
@section Parsing HTML and XML
@cindex parsing html

42
lisp/sqlite.el Normal file
View file

@ -0,0 +1,42 @@
;;; sqlite.el --- Tests for empty.el -*- lexical-binding: t; -*-
;; Copyright (C) 2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(defmacro with-sqlite-transaction (db &rest body)
"Execute BODY while holding a transaction for DB."
(declare (indent 1) (debug (form body)))
(let ((db-var (gensym)))
`(let ((,db-var ,db))
(if (sqlite-available-p)
(unwind-protect
(progn
(sqlite-transaction ,db-var)
,@body)
(sqlite-commit ,db-var))
(progn
,@body)))))
(provide 'sqlite)
;;; sqlite.el ends here

1
lisp/term/w32-win.el
View file

@ -275,6 +275,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
'(gif "libgif-5.dll" "giflib4.dll" "libungif4.dll" "libungif.dll")))
'(svg "librsvg-2-2.dll")
'(webp "libwebp-7.dll" "libwebp.dll")
'(sqlite3 "libsqlite3-0.dll")
'(gdk-pixbuf "libgdk_pixbuf-2.0-0.dll")
'(glib "libglib-2.0-0.dll")
'(gio "libgio-2.0-0.dll")

7
src/Makefile.in
View file

@ -238,6 +238,8 @@ IMAGEMAGICK_CFLAGS= @IMAGEMAGICK_CFLAGS@
LIBXML2_LIBS = @LIBXML2_LIBS@
LIBXML2_CFLAGS = @LIBXML2_CFLAGS@
SQLITE3_LIBS = @SQLITE3_LIBS@
GETADDRINFO_A_LIBS = @GETADDRINFO_A_LIBS@
LCMS2_LIBS = @LCMS2_LIBS@
@ -426,7 +428,7 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \
doprnt.o intervals.o textprop.o composite.o xml.o lcms.o $(NOTIFY_OBJ) \
$(XWIDGETS_OBJ) \
profiler.o decompress.o \
thread.o systhread.o \
thread.o systhread.o sqlite.o \
$(if $(HYBRID_MALLOC),sheap.o) \
$(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) \
$(W32_OBJ) $(WINDOW_SYSTEM_OBJ) $(XGSELOBJ) $(JSON_OBJ) \
@ -549,7 +551,8 @@ LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(LIBX_BASE) $(LIBIMAGE) \
$(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(HARFBUZZ_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \
$(LIBGNUTLS_LIBS) $(LIB_PTHREAD) $(GETADDRINFO_A_LIBS) $(LCMS2_LIBS) \
$(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) $(LIBSYSTEMD_LIBS) \
$(JSON_LIBS) $(LIBGMP) $(LIBGCCJIT_LIBS) $(XINPUT_LIBS) $(HAIKU_LIBS)
$(JSON_LIBS) $(LIBGMP) $(LIBGCCJIT_LIBS) $(XINPUT_LIBS) $(HAIKU_LIBS) \
$(SQLITE3_LIBS)
## FORCE it so that admin/unidata can decide whether this file is
## up-to-date. Although since charprop depends on bootstrap-emacs,

1
src/alloc.c
View file

@ -125,6 +125,7 @@ union emacs_align_type
struct Lisp_Overlay Lisp_Overlay;
struct Lisp_Sub_Char_Table Lisp_Sub_Char_Table;
struct Lisp_Subr Lisp_Subr;
struct Lisp_Sqlite Lisp_Sqlite;
struct Lisp_User_Ptr Lisp_User_Ptr;
struct Lisp_Vector Lisp_Vector;
struct terminal terminal;

2
src/data.c
View file

@ -259,6 +259,8 @@ for example, (type-of 1) returns `integer'. */)
return Qxwidget;
case PVEC_XWIDGET_VIEW:
return Qxwidget_view;
case PVEC_SQLITE:
return Qsqlite;
/* "Impossible" cases. */
case PVEC_MISC_PTR:
case PVEC_OTHER:

1
src/emacs.c
View file

@ -2183,6 +2183,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
#endif
syms_of_window ();
syms_of_xdisp ();
syms_of_sqlite ();
syms_of_font ();
#ifdef HAVE_WINDOW_SYSTEM
syms_of_fringe ();

40
src/lisp.h
View file

@ -1083,6 +1083,7 @@ enum pvec_type
PVEC_CONDVAR,
PVEC_MODULE_FUNCTION,
PVEC_NATIVE_COMP_UNIT,
PVEC_SQLITE,
/* These should be last, for internal_equal and sxhash_obj. */
PVEC_COMPILED,
@ -2570,6 +2571,17 @@ xmint_pointer (Lisp_Object a)
return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Misc_Ptr)->pointer;
}
struct Lisp_Sqlite
{
union vectorlike_header header;
void *db;
void *stmt;
char *name;
void (*finalizer) (void *);
bool eof;
bool is_statement;
} GCALIGNED_STRUCT;
struct Lisp_User_Ptr
{
union vectorlike_header header;
@ -2647,6 +2659,31 @@ XUSER_PTR (Lisp_Object a)
return XUNTAG (a, Lisp_Vectorlike, struct Lisp_User_Ptr);
}
INLINE bool
SQLITEP (Lisp_Object x)
{
return PSEUDOVECTORP (x, PVEC_SQLITE);
}
INLINE bool
SQLITE (Lisp_Object a)
{
return PSEUDOVECTORP (a, PVEC_SQLITE);
}
INLINE void
CHECK_SQLITE (Lisp_Object x)
{
CHECK_TYPE (SQLITE (x), Qsqlitep, x);
}
INLINE struct Lisp_Sqlite *
XSQLITE (Lisp_Object a)
{
eassert (SQLITEP (a));
return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Sqlite);
}
INLINE bool
BIGNUMP (Lisp_Object x)
{
@ -3793,6 +3830,9 @@ extern Lisp_Object safe_eval (Lisp_Object);
extern bool pos_visible_p (struct window *, ptrdiff_t, int *,
int *, int *, int *, int *, int *);
/* Defined in sqlite.c. */
extern void syms_of_sqlite (void);
/* Defined in xsettings.c. */
extern void syms_of_xsettings (void);

4
src/pdumper.c
View file

@ -2948,7 +2948,7 @@ dump_vectorlike (struct dump_context *ctx,
Lisp_Object lv,
dump_off offset)
{
#if CHECK_STRUCTS && !defined HASH_pvec_type_F5BA506141
#if CHECK_STRUCTS && !defined HASH_pvec_type_19F6CF5169
# error "pvec_type changed. See CHECK_STRUCTS comment in config.h."
#endif
const struct Lisp_Vector *v = XVECTOR (lv);
@ -3028,6 +3028,8 @@ dump_vectorlike (struct dump_context *ctx,
error_unsupported_dump_object (ctx, lv, "mutex");
case PVEC_CONDVAR:
error_unsupported_dump_object (ctx, lv, "condvar");
case PVEC_SQLITE:
error_unsupported_dump_object (ctx, lv, "sqlite");
case PVEC_MODULE_FUNCTION:
error_unsupported_dump_object (ctx, lv, "module function");
default:

16
src/print.c
View file

@ -1875,6 +1875,22 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
}
break;
#endif
case PVEC_SQLITE:
{
print_c_string ("#<sqlite ", printcharfun);
int i = sprintf (buf, "db=%p", XSQLITE (obj)->db);
strout (buf, i, i, printcharfun);
if (XSQLITE (obj)->is_statement)
{
i = sprintf (buf, " stmt=%p", XSQLITE (obj)->stmt);
strout (buf, i, i, printcharfun);
}
i = sprintf (buf, " name=%s", XSQLITE (obj)->name);
strout (buf, i, i, printcharfun);
printchar ('>', printcharfun);
}
break;
default:
emacs_abort ();
}

708
src/sqlite.c Normal file
View file

@ -0,0 +1,708 @@
/*
Copyright (C) 2021 Free Software Foundation, Inc.
This file is part of GNU Emacs.
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
This file is based on the emacs-sqlite3 package written by Syohei
YOSHIDA <syohex@gmail.com>, which can be found at:
https://github.com/syohex/emacs-sqlite3
*/
#include <config.h>
#include "lisp.h"
#include "coding.h"
#ifdef HAVE_SQLITE3
#include <sqlite3.h>
#ifdef WINDOWSNT
# include <windows.h>
# include "w32common.h"
# include "w32.h"
DEF_DLL_FN (SQLITE_API int, sqlite3_finalize, (sqlite3_stmt*));
DEF_DLL_FN (SQLITE_API int, sqlite3_close, (sqlite3*));
DEF_DLL_FN (SQLITE_API int, sqlite3_open_v2,
(const char*, sqlite3**, int, const char*));
DEF_DLL_FN (SQLITE_API int, sqlite3_reset, (sqlite3_stmt*));
DEF_DLL_FN (SQLITE_API int, sqlite3_bind_text,
(sqlite3_stmt*, int, const char*, int, void(*)(void*)));
DEF_DLL_FN (SQLITE_API int, sqlite3_bind_int64,
(sqlite3_stmt*, int, sqlite3_int64));
DEF_DLL_FN (SQLITE_API int, sqlite3_bind_double, (sqlite3_stmt*, int, double));
DEF_DLL_FN (SQLITE_API int, sqlite3_bind_null, (sqlite3_stmt*, int));
DEF_DLL_FN (SQLITE_API int, sqlite3_bind_int, (sqlite3_stmt*, int, int));
DEF_DLL_FN (SQLITE_API const char*, sqlite3_errmsg, (sqlite3*));
DEF_DLL_FN (SQLITE_API int, sqlite3_step, (sqlite3_stmt*));
DEF_DLL_FN (SQLITE_API int, sqlite3_changes, (sqlite3*));
DEF_DLL_FN (SQLITE_API int, sqlite3_column_count, (sqlite3_stmt*));
DEF_DLL_FN (SQLITE_API int, sqlite3_column_type, (sqlite3_stmt*, int));
DEF_DLL_FN (SQLITE_API sqlite3_int64, sqlite3_column_int64,
(sqlite3_stmt*, int));
DEF_DLL_FN (SQLITE_API double, sqlite3_column_double, (sqlite3_stmt*, int));
DEF_DLL_FN (SQLITE_API const void*, sqlite3_column_blob,
(sqlite3_stmt*, int));
DEF_DLL_FN (SQLITE_API int, sqlite3_column_bytes, (sqlite3_stmt*, int));
DEF_DLL_FN (SQLITE_API const unsigned char*, sqlite3_column_text,
(sqlite3_stmt*, int));
DEF_DLL_FN (SQLITE_API const char*, sqlite3_column_name, (sqlite3_stmt*, int));
DEF_DLL_FN (SQLITE_API int, sqlite3_exec,
(sqlite3*, const char*, int (*callback)(void*,int,char**,char**),
void*, char**));
DEF_DLL_FN (SQLITE_API int, sqlite3_load_extension,
(sqlite3*, const char*, const char*, char**));
DEF_DLL_FN (SQLITE_API int, sqlite3_prepare_v2,
(sqlite3*, const char*, int, sqlite3_stmt**, const char**));
# undef sqlite3_finalize
# undef sqlite3_close
# undef sqlite3_open_v2
# undef sqlite3_reset
# undef sqlite3_bind_text
# undef sqlite3_bind_int64
# undef sqlite3_bind_double
# undef sqlite3_bind_null
# undef sqlite3_bind_int
# undef sqlite3_errmsg
# undef sqlite3_step
# undef sqlite3_changes
# undef sqlite3_column_count
# undef sqlite3_column_type
# undef sqlite3_column_int64
# undef sqlite3_column_double
# undef sqlite3_column_blob
# undef sqlite3_column_bytes
# undef sqlite3_column_text
# undef sqlite3_column_name
# undef sqlite3_exec
# undef sqlite3_load_extension
# undef sqlite3_prepare_v2
# define sqlite3_finalize fn_sqlite3_finalize
# define sqlite3_close fn_sqlite3_close
# define sqlite3_open_v2 fn_sqlite3_open_v2
# define sqlite3_reset fn_sqlite3_reset
# define sqlite3_bind_text fn_sqlite3_bind_text
# define sqlite3_bind_int64 fn_sqlite3_bind_int64
# define sqlite3_bind_double fn_sqlite3_bind_double
# define sqlite3_bind_null fn_sqlite3_bind_null
# define sqlite3_bind_int fn_sqlite3_bind_int
# define sqlite3_errmsg fn_sqlite3_errmsg
# define sqlite3_step fn_sqlite3_step
# define sqlite3_changes fn_sqlite3_changes
# define sqlite3_column_count fn_sqlite3_column_count
# define sqlite3_column_type fn_sqlite3_column_type
# define sqlite3_column_int64 fn_sqlite3_column_int64
# define sqlite3_column_double fn_sqlite3_column_double
# define sqlite3_column_blob fn_sqlite3_column_blob
# define sqlite3_column_bytes fn_sqlite3_column_bytes
# define sqlite3_column_text fn_sqlite3_column_text
# define sqlite3_column_name fn_sqlite3_column_name
# define sqlite3_exec fn_sqlite3_exec
# define sqlite3_load_extension fn_sqlite3_load_extension
# define sqlite3_prepare_v2 fn_sqlite3_prepare_v2
static bool
load_dll_functions (HMODULE library)
{
LOAD_DLL_FN (library, sqlite3_finalize);
LOAD_DLL_FN (library, sqlite3_close);
LOAD_DLL_FN (library, sqlite3_open_v2);
LOAD_DLL_FN (library, sqlite3_reset);
LOAD_DLL_FN (library, sqlite3_bind_text);
LOAD_DLL_FN (library, sqlite3_bind_int64);
LOAD_DLL_FN (library, sqlite3_bind_double);
LOAD_DLL_FN (library, sqlite3_bind_null);
LOAD_DLL_FN (library, sqlite3_bind_int);
LOAD_DLL_FN (library, sqlite3_errmsg);
LOAD_DLL_FN (library, sqlite3_step);
LOAD_DLL_FN (library, sqlite3_changes);
LOAD_DLL_FN (library, sqlite3_column_count);
LOAD_DLL_FN (library, sqlite3_column_type);
LOAD_DLL_FN (library, sqlite3_column_int64);
LOAD_DLL_FN (library, sqlite3_column_double);
LOAD_DLL_FN (library, sqlite3_column_blob);
LOAD_DLL_FN (library, sqlite3_column_bytes);
LOAD_DLL_FN (library, sqlite3_column_text);
LOAD_DLL_FN (library, sqlite3_column_name);
LOAD_DLL_FN (library, sqlite3_exec);
LOAD_DLL_FN (library, sqlite3_load_extension);
LOAD_DLL_FN (library, sqlite3_prepare_v2);
return true;
}
static bool
sqlite_loaded_p (void)
{
Lisp_Object found = Fassq (Qsqlite3, Vlibrary_cache);
return CONSP (found) && EQ (XCDR (found), Qt);
}
#endif /* WINDOWSNT */
static bool
init_sqlite_functions (void)
{
#ifdef WINDOWSNT
if (sqlite_loaded_p ())
return true;
else
{
HMODULE library;
if (!(library = w32_delayed_load (Qsqlite3)))
{
message1 ("sqlite3 library not found");
return false;
}
if (! load_dll_functions (library))
goto bad_library;
Vlibrary_cache = Fcons (Fcons (Qsqlite3, Qt), Vlibrary_cache);
return true;
}
bad_library:
Vlibrary_cache = Fcons (Fcons (Qsqlite3, Qnil), Vlibrary_cache);
return false;
#else /* !WINDOWSNT */
return true;
#endif /* !WINDOWSNT */
}
static void
sqlite_free (void *arg)
{
struct Lisp_Sqlite *ptr = (struct Lisp_Sqlite *)arg;
if (ptr->is_statement)
sqlite3_finalize (ptr->stmt);
else if (ptr->db)
sqlite3_close (ptr->db);
xfree (ptr->name);
xfree (ptr);
}
static Lisp_Object
encode_string (Lisp_Object string)
{
if (STRING_MULTIBYTE (string))
return encode_string_utf_8 (string, Qnil, 0, Qt, Qt);
else
return string;
}
static Lisp_Object
make_sqlite (bool is_statement, void *db, void *stmt, char *name)
{
struct Lisp_Sqlite *ptr
= ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Sqlite, PVEC_SQLITE);
ptr->is_statement = is_statement;
ptr->finalizer = sqlite_free;
ptr->db = db;
ptr->name = name;
ptr->stmt = stmt;
ptr->eof = false;
return make_lisp_ptr (ptr, Lisp_Vectorlike);
}
static void
check_sqlite (Lisp_Object db, bool is_statement)
{
init_sqlite_functions ();
CHECK_SQLITE (db);
if (is_statement && !XSQLITE (db)->is_statement)
xsignal1 (Qerror, build_string ("Invalid set object"));
else if (!is_statement && XSQLITE (db)->is_statement)
xsignal1 (Qerror, build_string ("Invalid database object"));
if (!is_statement && !XSQLITE (db)->db)
xsignal1 (Qerror, build_string ("Database closed"));
else if (is_statement && !XSQLITE (db)->db)
xsignal1 (Qerror, build_string ("Statement closed"));
}
static int db_count = 0;
DEFUN ("sqlite-open", Fsqlite_open, Ssqlite_open, 0, 1, 0,
doc: /* Open FILE as an sqlite database.
If FILE is nil, an in-memory database will be opened instead. */)
(Lisp_Object file)
{
char *name;
init_sqlite_functions ();
if (!NILP (file))
{
CHECK_STRING (file);
name = xstrdup (SSDATA (Fexpand_file_name (file, Qnil)));
}
else
/* In-memory database. These have to have different names to
refer to different databases. */
name = xstrdup (SSDATA (CALLN (Fformat, build_string (":memory:%d"),
make_int (++db_count))));
sqlite3 *sdb;
int ret = sqlite3_open_v2 (name,
&sdb,
SQLITE_OPEN_FULLMUTEX
| SQLITE_OPEN_READWRITE
| SQLITE_OPEN_CREATE
| (NILP (file) ? SQLITE_OPEN_MEMORY : 0)
#ifdef SQLITE_OPEN_URI
| SQLITE_OPEN_URI
#endif
| 0, NULL);
if (ret != SQLITE_OK)
return Qnil;
return make_sqlite (false, sdb, NULL, name);
}
DEFUN ("sqlite-close", Fsqlite_close, Ssqlite_close, 1, 1, 0,
doc: /* Close the database DB. */)
(Lisp_Object db)
{
check_sqlite (db, false);
sqlite3_close (XSQLITE (db)->db);
XSQLITE (db)->db = NULL;
return Qnil;
}
/* Bind values in a statement like
"insert into foo values (?, ?, ?)". */
static const char *
bind_values (sqlite3 *db, sqlite3_stmt *stmt, Lisp_Object values)
{
sqlite3_reset (stmt);
int len;
if (VECTORP (values))
len = ASIZE (values);
else
len = list_length (values);
for (int i = 0; i < len; ++i)
{
int ret = SQLITE_MISMATCH;
Lisp_Object value;
if (VECTORP (values))
value = AREF (values, i);
else
{
value = XCAR (values);
values = XCDR (values);
}
Lisp_Object type = Ftype_of (value);
if (EQ (type, Qstring))
{
Lisp_Object encoded = encode_string (value);
ret = sqlite3_bind_text (stmt, i + 1,
SSDATA (encoded), SBYTES (encoded),
NULL);
}
else if (EQ (type, Qinteger))
{
if (BIGNUMP (value))
ret = sqlite3_bind_int64 (stmt, i + 1, bignum_to_intmax (value));
else
ret = sqlite3_bind_int64 (stmt, i + 1, XFIXNUM (value));
}
else if (EQ (type, Qfloat))
ret = sqlite3_bind_double (stmt, i + 1, XFLOAT_DATA (value));
else if (NILP (value))
ret = sqlite3_bind_null (stmt, i + 1);
else if (EQ (value, Qt))
ret = sqlite3_bind_int (stmt, i + 1, 1);
else if (EQ (value, Qfalse))
ret = sqlite3_bind_int (stmt, i + 1, 0);
else
return "invalid argument";
if (ret != SQLITE_OK)
return sqlite3_errmsg (db);
}
return NULL;
}
DEFUN ("sqlite-execute", Fsqlite_execute, Ssqlite_execute, 2, 3, 0,
doc: /* Execute a non-select SQL statement.
If VALUES is non-nil, it should be a list of values to bind when
executing a statement like
insert into foo values (?, ?, ...)
The number of affected rows is returned. */)
(Lisp_Object db, Lisp_Object query, Lisp_Object values)
{
check_sqlite (db, false);
CHECK_STRING (query);
if (!(NILP (values) || CONSP (values) || VECTORP (values)))
xsignal1 (Qerror, build_string ("VALUES must be a list or a vector"));
sqlite3 *sdb = XSQLITE (db)->db;
Lisp_Object retval = Qnil;
const char *errmsg = NULL;
Lisp_Object encoded = encode_string (query);
sqlite3_stmt *stmt = NULL;
/* We only execute the first statement -- if there's several
(separated by a semicolon), the subsequent statements won't be
done. */
int ret = sqlite3_prepare_v2 (sdb, SSDATA (encoded), -1, &stmt, NULL);
if (ret != SQLITE_OK)
{
if (stmt != NULL)
{
sqlite3_finalize (stmt);
sqlite3_reset (stmt);
}
errmsg = sqlite3_errmsg (sdb);
goto exit;
}
/* Bind ? values. */
if (!NILP (values)) {
const char *err = bind_values (sdb, stmt, values);
if (err != NULL)
{
errmsg = err;
goto exit;
}
}
ret = sqlite3_step (stmt);
sqlite3_finalize (stmt);
if (ret != SQLITE_OK && ret != SQLITE_DONE)
{
errmsg = sqlite3_errmsg (sdb);
goto exit;
}
retval = make_fixnum (sqlite3_changes (sdb));
exit:
if (errmsg != NULL)
xsignal1 (Qerror, build_string (errmsg));
return retval;
}
static Lisp_Object
row_to_value (sqlite3_stmt *stmt)
{
int len = sqlite3_column_count (stmt);
Lisp_Object values = Qnil;
for (int i = 0; i < len; ++i)
{
Lisp_Object v = Qnil;
switch (sqlite3_column_type (stmt, i))
{
case SQLITE_INTEGER:
v = make_int (sqlite3_column_int64 (stmt, i));
break;
case SQLITE_FLOAT:
v = make_float (sqlite3_column_double (stmt, i));
break;
case SQLITE_BLOB:
v =
code_convert_string_norecord
(make_string (sqlite3_column_blob (stmt, i),
sqlite3_column_bytes (stmt, i)),
Qutf_8, false);
break;
case SQLITE_NULL:
v = Qnil;
break;
case SQLITE_TEXT:
v =
code_convert_string_norecord
(make_string ((const char*)sqlite3_column_text (stmt, i),
sqlite3_column_bytes (stmt, i)),
Qutf_8, false);
break;
}
values = Fcons (v, values);
}
return Fnreverse (values);
}
static Lisp_Object
column_names (sqlite3_stmt *stmt)
{
Lisp_Object columns = Qnil;
int count = sqlite3_column_count (stmt);
for (int i = 0; i < count; ++i)
columns = Fcons (build_string (sqlite3_column_name (stmt, i)), columns);
return Fnreverse (columns);
}
DEFUN ("sqlite-select", Fsqlite_select, Ssqlite_select, 2, 4, 0,
doc: /* Select data from the database DB that matches QUERY.
If VALUES is non-nil, they are values that will be interpolated into a
parametrised statement.
By default, the return value is a list where the first element is a
list of column names, and the rest of the elements are the matching data.
RETURN-TYPE can be either nil (which means that the matching data
should be returned as a list of rows), or `full' (the same, but the
first element in the return list will be the column names), or `set',
which means that we return a set object that can be queried with
`sqlite-next' and other functions to get the data. */)
(Lisp_Object db, Lisp_Object query, Lisp_Object values,
Lisp_Object return_type)
{
check_sqlite (db, false);
CHECK_STRING (query);
if (!(NILP (values) || CONSP (values) || VECTORP (values)))
xsignal1 (Qerror, build_string ("VALUES must be a list or a vector"));
sqlite3 *sdb = XSQLITE (db)->db;
Lisp_Object retval = Qnil;
const char *errmsg = NULL;
Lisp_Object encoded = encode_string (query);
sqlite3_stmt *stmt = NULL;
int ret = sqlite3_prepare_v2 (sdb, SSDATA (encoded), SBYTES (encoded),
&stmt, NULL);
if (ret != SQLITE_OK)
{
if (stmt)
sqlite3_finalize (stmt);
goto exit;
}
/* Query with parameters. */
if (!NILP (values))
{
const char *err = bind_values (sdb, stmt, values);
if (err != NULL)
{
sqlite3_finalize (stmt);
errmsg = err;
goto exit;
}
}
/* Return a handle to get the data. */
if (EQ (return_type, Qset))
{
retval = make_sqlite (true, db, stmt, XSQLITE (db)->name);
goto exit;
}
/* Return the data directly. */
Lisp_Object data = Qnil;
while ((ret = sqlite3_step (stmt)) == SQLITE_ROW)
data = Fcons (row_to_value (stmt), data);
if (EQ (return_type, Qfull))
retval = Fcons (column_names (stmt), Fnreverse (data));
else
retval = Fnreverse (data);
sqlite3_finalize (stmt);
exit:
if (errmsg != NULL)
xsignal1 (Qerror, build_string (errmsg));
return retval;
}
static Lisp_Object
sqlite_exec (sqlite3 *sdb, const char *query)
{
int ret = sqlite3_exec (sdb, query, NULL, NULL, NULL);
if (ret != SQLITE_OK)
return Qnil;
return Qt;
}
DEFUN ("sqlite-transaction", Fsqlite_transaction, Ssqlite_transaction, 1, 1, 0,
doc: /* Start a transaction in DB. */)
(Lisp_Object db)
{
check_sqlite (db, false);
return sqlite_exec (XSQLITE (db)->db, "begin");
}
DEFUN ("sqlite-commit", Fsqlite_commit, Ssqlite_commit, 1, 1, 0,
doc: /* Commit a transaction in DB. */)
(Lisp_Object db)
{
check_sqlite (db, false);
return sqlite_exec (XSQLITE (db)->db, "commit");
}
DEFUN ("sqlite-rollback", Fsqlite_rollback, Ssqlite_rollback, 1, 1, 0,
doc: /* Roll back a transaction in DB. */)
(Lisp_Object db)
{
check_sqlite (db, false);
return sqlite_exec (XSQLITE (db)->db, "rollback");
}
DEFUN ("sqlite-load-extension", Fsqlite_load_extension,
Ssqlite_load_extension, 2, 2, 0,
doc: /* Load a an SQlite module into DB.
MODULE should be the file name of an SQlite module .so file. */)
(Lisp_Object db, Lisp_Object module)
{
check_sqlite (db, false);
CHECK_STRING (module);
sqlite3 *sdb = XSQLITE (db)->db;
int result = sqlite3_load_extension (sdb,
SSDATA (Fexpand_file_name (module, Qnil)),
NULL, NULL);
if (result == SQLITE_OK)
return Qt;
return Qnil;
}
DEFUN ("sqlite-next", Fsqlite_next, Ssqlite_next, 1, 1, 0,
doc: /* Return the next result set from SET. */)
(Lisp_Object set)
{
check_sqlite (set, true);
int ret = sqlite3_step (XSQLITE (set)->stmt);
if (ret != SQLITE_ROW && ret != SQLITE_OK && ret != SQLITE_DONE)
xsignal1 (Qerror, build_string (sqlite3_errmsg (XSQLITE (set)->db)));
if (ret == SQLITE_DONE)
{
XSQLITE (set)->eof = true;
return Qnil;
}
return row_to_value (XSQLITE (set)->stmt);
}
DEFUN ("sqlite-columns", Fsqlite_columns, Ssqlite_columns, 1, 1, 0,
doc: /* Return the column names of SET. */)
(Lisp_Object set)
{
check_sqlite (set, true);
return column_names (XSQLITE (set)->stmt);
}
DEFUN ("sqlite-more-p", Fsqlite_more_p, Ssqlite_more_p, 1, 1, 0,
doc: /* Say whether there's any further results in SET. */)
(Lisp_Object set)
{
check_sqlite (set, true);
if (XSQLITE (set)->eof)
return Qnil;
else
return Qt;
}
DEFUN ("sqlite-finalize", Fsqlite_finalize, Ssqlite_finalize, 1, 1, 0,
doc: /* Mark this SET as being finished.
This will free the resources held by SET. */)
(Lisp_Object set)
{
check_sqlite (set, true);
sqlite3_finalize (XSQLITE (set)->stmt);
return Qt;
}
#endif /* HAVE_SQLITE3 */
DEFUN ("sqlitep", Fsqlitep, Ssqlitep, 1, 1, 0,
doc: /* Say whether OBJECT is an SQlite object. */)
(Lisp_Object object)
{
#ifdef HAVE_SQLITE3
return SQLITE (object)? Qt: Qnil;
#else
return Qnil;
#endif
}
DEFUN ("sqlite-available-p", Fsqlite_available_p, Ssqlite_available_p, 0, 0, 0,
doc: /* Return t if sqlite3 support is available in this instance of Emacs.*/)
(void)
{
#ifdef HAVE_SQLITE3
# ifdef WINDOWSNT
Lisp_Object found = Fassq (Qsqlite3, Vlibrary_cache);
if (CONSP (found))
return XCDR (found);
else
{
Lisp_Object status;
status = init_sqlite_functions () ? Qt : Qnil;
Vlibrary_cache = Fcons (Fcons (Qsqlite3, status), Vlibrary_cache);
return status;
}
# else
return Qt;
#endif
#else
return Qnil;
#endif
}
void
syms_of_sqlite (void)
{
#ifdef HAVE_SQLITE3
defsubr (&Ssqlite_open);
defsubr (&Ssqlite_close);
defsubr (&Ssqlite_execute);
defsubr (&Ssqlite_select);
defsubr (&Ssqlite_transaction);
defsubr (&Ssqlite_commit);
defsubr (&Ssqlite_rollback);
defsubr (&Ssqlite_load_extension);
defsubr (&Ssqlite_next);
defsubr (&Ssqlite_columns);
defsubr (&Ssqlite_more_p);
defsubr (&Ssqlite_finalize);
DEFSYM (Qset, "set");
DEFSYM (Qfull, "full");
#endif
defsubr (&Ssqlitep);
DEFSYM (Qsqlitep, "sqlitep");
defsubr (&Ssqlite_available_p);
DEFSYM (Qfalse, "false");
DEFSYM (Qsqlite, "sqlite");
DEFSYM (Qsqlite3, "sqlite3");
}

175
test/src/sqlite-tests.el Normal file
View file

@ -0,0 +1,175 @@
;;; sqlite-tests.el --- Tests for sqlite.el -*- lexical-binding: t; -*-
;; Copyright (C) 2021 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'ert)
(require 'ert-x)
(ert-deftest sqlite-select ()
(skip-unless (sqlite-available-p))
(let ((db (sqlite-open)))
(should (eq (type-of db) 'sqlite))
(should (sqlitep db))
(should-not (sqlitep 'foo))
(should
(zerop
(sqlite-execute
db "create table if not exists test1 (col1 text, col2 integer, col3 float, col4 blob)")))
(should-error
(sqlite-execute
db "insert into test1 (col1, col2, col3, col4) values ('foo', 2, 9.45, 'bar', 'zot')"))
(should
(=
(sqlite-execute
db "insert into test1 (col1, col2, col3, col4) values ('foo', 2, 9.45, 'bar')")
1))
(should
(equal
(sqlite-select db "select * from test1" nil 'full)
'(("col1" "col2" "col3" "col4") ("foo" 2 9.45 "bar"))))))
;; (setq db (sqlite-open))
(ert-deftest sqlite-set ()
(skip-unless (sqlite-available-p))
(let ((db (sqlite-open))
set)
(should
(zerop
(sqlite-execute
db "create table if not exists test1 (col1 text, col2 integer)")))
(should
(=
(sqlite-execute db "insert into test1 (col1, col2) values ('foo', 1)")
1))
(should
(=
(sqlite-execute db "insert into test1 (col1, col2) values ('bar', 2)")
1))
(setq set (sqlite-select db "select * from test1" nil 'set))
(should (sqlitep set))
(should (sqlite-more-p set))
(should (equal (sqlite-next set)
'("foo" 1)))
(should (equal (sqlite-next set)
'("bar" 2)))
(should-not (sqlite-next set))
(should-not (sqlite-more-p set))))
(ert-deftest sqlite-chars ()
(skip-unless (sqlite-available-p))
(let (db)
(setq db (sqlite-open))
(sqlite-execute
db "create table if not exists test2 (col1 text, col2 integer)")
(sqlite-execute
db "insert into test2 (col1, col2) values ('fóo', 3)")
(sqlite-execute
db "insert into test2 (col1, col2) values ('fó‚o', 3)")
(sqlite-execute
db "insert into test2 (col1, col2) values ('f‚o', 4)")
(should
(equal (sqlite-select db "select * from test2" nil 'full)
'(("col1" "col2") ("fóo" 3) ("fó‚o" 3) ("f‚o" 4))))))
(ert-deftest sqlite-numbers ()
(skip-unless (sqlite-available-p))
(let (db)
(setq db (sqlite-open))
(sqlite-execute
db "create table if not exists test3 (col1 integer)")
(let ((big (expt 2 50))
(small (expt 2 10)))
(sqlite-execute db (format "insert into test3 values (%d)" small))
(sqlite-execute db (format "insert into test3 values (%d)" big))
(should
(equal
(sqlite-select db "select * from test3")
(list (list small) (list big)))))))
(ert-deftest sqlite-param ()
(skip-unless (sqlite-available-p))
(let (db)
(setq db (sqlite-open))
(sqlite-execute
db "create table if not exists test4 (col1 text, col2 number)")
(sqlite-execute db "insert into test4 values (?, ?)" (list "foo" 1))
(should
(equal
(sqlite-select db "select * from test4 where col2 = ?" '(1))
'(("foo" 1))))
(should
(equal
(sqlite-select db "select * from test4 where col2 = ?" [1])
'(("foo" 1))))))
(ert-deftest sqlite-binary ()
(skip-unless (sqlite-available-p))
(let (db)
(setq db (sqlite-open))
(sqlite-execute
db "create table if not exists test5 (col1 text, col2 number)")
(let ((string (with-temp-buffer
(set-buffer-multibyte nil)
(insert 0 1 2)
(buffer-string))))
(should-not (multibyte-string-p string))
(sqlite-execute
db "insert into test5 values (?, ?)" (list string 2))
(let ((out (caar
(sqlite-select db "select col1 from test5 where col2 = 2"))))
(should (equal out string))))))
(ert-deftest sqlite-different-dbs ()
(skip-unless (sqlite-available-p))
(let (db1 db2)
(setq db1 (sqlite-open))
(setq db2 (sqlite-open))
(sqlite-execute
db1 "create table if not exists test6 (col1 text, col2 number)")
(sqlite-execute
db2 "create table if not exists test6 (col1 text, col2 number)")
(sqlite-execute
db1 "insert into test6 values (?, ?)" '("foo" 2))
(should (sqlite-select db1 "select * from test6"))
(should-not (sqlite-select db2 "select * from test6"))))
(ert-deftest sqlite-close-dbs ()
(skip-unless (sqlite-available-p))
(let (db)
(setq db (sqlite-open))
(sqlite-execute
db "create table if not exists test6 (col1 text, col2 number)")
(sqlite-execute db "insert into test6 values (?, ?)" '("foo" 2))
(should (sqlite-select db "select * from test6"))
(sqlite-close db)
(should-error (sqlite-select db "select * from test6"))))
;;; sqlite-tests.el ends here