/* Support for accessing SQLite databases.

Copyright (C) 2021-2023 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_blob,
	    (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 int, sqlite3_extended_errcode, (sqlite3*));
DEF_DLL_FN (SQLITE_API const char*, sqlite3_errmsg, (sqlite3*));
#if SQLITE_VERSION_NUMBER >= 3007015
DEF_DLL_FN (SQLITE_API const char*, sqlite3_errstr, (int));
#endif
DEF_DLL_FN (SQLITE_API const char*, sqlite3_libversion, (void));
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_prepare_v2,
	    (sqlite3*, const char*, int, sqlite3_stmt**, const char**));

# ifdef HAVE_SQLITE3_LOAD_EXTENSION
DEF_DLL_FN (SQLITE_API int, sqlite3_load_extension,
	    (sqlite3*, const char*, const char*, char**));
#  undef sqlite3_load_extension
#  define sqlite3_load_extension fn_sqlite3_load_extension
# endif

# undef sqlite3_finalize
# undef sqlite3_close
# undef sqlite3_open_v2
# undef sqlite3_reset
# undef sqlite3_bind_text
# undef sqlite3_bind_blob
# undef sqlite3_bind_int64
# undef sqlite3_bind_double
# undef sqlite3_bind_null
# undef sqlite3_bind_int
# undef sqlite3_extended_errcode
# undef sqlite3_errmsg
# if SQLITE_VERSION_NUMBER >= 3007015
#  undef sqlite3_errstr
# endif
# undef sqlite3_libversion
# 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_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_blob fn_sqlite3_bind_blob
# 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_extended_errcode fn_sqlite3_extended_errcode
# define sqlite3_errmsg fn_sqlite3_errmsg
# if SQLITE_VERSION_NUMBER >= 3007015
#  define sqlite3_errstr fn_sqlite3_errstr
# endif
# define sqlite3_libversion fn_sqlite3_libversion
# 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_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_blob);
  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_extended_errcode);
  LOAD_DLL_FN (library, sqlite3_errmsg);
#if SQLITE_VERSION_NUMBER >= 3007015
  LOAD_DLL_FN (library, sqlite3_errstr);
#endif
  LOAD_DLL_FN (library, sqlite3_libversion);
  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);
# ifdef HAVE_SQLITE3_LOAD_EXTENSION
  LOAD_DLL_FN (library, sqlite3_load_extension);
# endif
  LOAD_DLL_FN (library, sqlite3_prepare_v2);
  return true;
}
#endif /* WINDOWSNT */

static bool
init_sqlite_functions (void)
{
#ifdef WINDOWSNT
  static bool sqlite3_initialized;

  if (!sqlite3_initialized)
    {
      HMODULE library = w32_delayed_load (Qsqlite3);

      if (!library)
	message1 ("sqlite3 library was not found");
      else if (load_dll_functions (library))
	{
	  sqlite3_initialized = true;
	  Vlibrary_cache = Fcons (Fcons (Qsqlite3, Qt), Vlibrary_cache);
	}
      else
	{
	  message1 ("sqlite3 library was found, but could not be loaded successfully");
	  Vlibrary_cache = Fcons (Fcons (Qsqlite3, Qnil), Vlibrary_cache);
	}
    }
  return sqlite3_initialized;
#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 (Qsqlite_error, build_string ("Invalid set object"));
  else if (!is_statement && XSQLITE (db)->is_statement)
    xsignal1 (Qsqlite_error, build_string ("Invalid database object"));
  if (!is_statement && !XSQLITE (db)->db)
    xsignal1 (Qsqlite_error, build_string ("Database closed"));
  else if (is_statement && !XSQLITE (db)->db)
    xsignal1 (Qsqlite_error, 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)
{
  Lisp_Object name;
  int flags = (SQLITE_OPEN_CREATE  | SQLITE_OPEN_READWRITE);
#ifdef SQLITE_OPEN_FULLMUTEX
  flags |= SQLITE_OPEN_FULLMUTEX;
#endif
#ifdef SQLITE_OPEN_URI
  flags |= SQLITE_OPEN_URI;
#endif

  if (!init_sqlite_functions ())
    xsignal1 (Qsqlite_error, build_string ("sqlite support is not available"));

  if (!NILP (file))
    name = ENCODE_FILE (Fexpand_file_name (file, Qnil));
  else
    {
#ifdef SQLITE_OPEN_MEMORY
      /* In-memory database.  These have to have different names to
	 refer to different databases.  */
      AUTO_STRING (memory_fmt, ":memory:%d");
      name = CALLN (Fformat, memory_fmt, make_int (++db_count));
      flags |= SQLITE_OPEN_MEMORY;
#else
      xsignal1 (Qsqlite_error, build_string ("sqlite in-memory is not available"));
#endif
    }

  sqlite3 *sdb;
  if (sqlite3_open_v2 (SSDATA (name), &sdb, flags, NULL) != SQLITE_OK)
    return Qnil;

  return make_sqlite (false, sdb, NULL, xstrdup (SSDATA (name)));
}

DEFUN ("sqlite-close", Fsqlite_close, Ssqlite_close, 1, 1, 0,
       doc: /* Close the sqlite database DB.  */)
  (Lisp_Object db)
{
  check_sqlite (db, false);
  sqlite3_close (XSQLITE (db)->db);
  XSQLITE (db)->db = NULL;
  return Qt;
}

/* 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;
	  bool blob = false;

	  if (SBYTES (value) == 0)
	    encoded = value;
	  else
	    {
	      Lisp_Object coding_system =
		Fget_text_property (make_fixnum (0), Qcoding_system, value);
	      if (NILP (coding_system))
		/* Default to utf-8.  */
		encoded = encode_string (value);
	      else if (EQ (coding_system, Qbinary))
		blob = true;
	      else
		encoded = Fencode_coding_string (value, coding_system,
						 Qnil, Qnil);
	    }

	  if (blob)
	    {
	      if (SBYTES (value) != SCHARS (value))
		xsignal1 (Qsqlite_error, build_string ("BLOB values must be unibyte"));
	    ret = sqlite3_bind_blob (stmt, i + 1,
				       SSDATA (value), SBYTES (value),
				       NULL);
	    }
	    else
	      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;
}

static Lisp_Object
row_to_value (sqlite3_stmt *stmt)
{
  int len = sqlite3_column_count (stmt);
  Lisp_Object values = Qnil;

  for (int i = len - 1; i >= 0; 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 = make_unibyte_string (sqlite3_column_blob (stmt, i),
				   sqlite3_column_bytes (stmt, i));
	  break;

	case SQLITE_NULL:
	  v = Qnil;
	  break;

	case SQLITE_TEXT:
	  v =
	    code_convert_string_norecord
	    (make_unibyte_string ((const char *)sqlite3_column_text (stmt, i),
				  sqlite3_column_bytes (stmt, i)),
	     Qutf_8, false);
	  break;
	}

      values = Fcons (v, values);
    }

  return values;
}

static Lisp_Object
sqlite_prepare_errdata (int code, sqlite3 *sdb)
{
  Lisp_Object errcode = make_fixnum (code);
  const char *errmsg = sqlite3_errmsg (sdb);
  Lisp_Object lerrmsg = errmsg ? build_string (errmsg) : Qnil;
  Lisp_Object errstr, ext_errcode;

#if SQLITE_VERSION_NUMBER >= 3007015
  errstr = build_string (sqlite3_errstr (code));
#else
  /* The internet says this is identical to sqlite3_errstr (code).  */
  errstr = lerrmsg;
#endif

  /* More details about what went wrong.  */
#if SQLITE_VERSION_NUMBER >= 3006005
  ext_errcode = make_fixnum (sqlite3_extended_errcode (sdb));
#else
  /* What value to use here?  */
  ext_errcode = make_fixnum (0);
#endif

  return list4 (errstr, lerrmsg, errcode, ext_errcode);
}

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 vector or a list of values
to bind when executing a statement like

   insert into foo values (?, ?, ...)

Value is the number of affected rows.  */)
  (Lisp_Object db, Lisp_Object query, Lisp_Object values)
{
  check_sqlite (db, false);
  CHECK_STRING (query);
  if (!(NILP (values) || CONSP (values) || VECTORP (values)))
    xsignal1 (Qsqlite_error, build_string ("VALUES must be a list or a vector"));

  sqlite3 *sdb = XSQLITE (db)->db;
  Lisp_Object errmsg = Qnil,
    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 = sqlite_prepare_errdata (ret, sdb);
      goto exit;
    }

  /* Bind ? values.  */
  if (!NILP (values))
    {
      const char *err = bind_values (sdb, stmt, values);
      if (err != NULL)
	{
	  errmsg = build_string (err);
	  goto exit;
	}
    }

  ret = sqlite3_step (stmt);

  if (ret == SQLITE_ROW)
    {
      Lisp_Object data = Qnil;
      do
	data = Fcons (row_to_value (stmt), data);
      while (sqlite3_step (stmt) == SQLITE_ROW);

      sqlite3_finalize (stmt);
      return Fnreverse (data);
    }
  else if (ret == SQLITE_OK || ret == SQLITE_DONE)
    {
      Lisp_Object rows = make_fixnum (sqlite3_changes (sdb));
      sqlite3_finalize (stmt);
      return rows;
    }
  else
    errmsg = build_string (sqlite3_errmsg (sdb));

 exit:
  sqlite3_finalize (stmt);
  xsignal1 (ret == SQLITE_LOCKED || ret == SQLITE_BUSY?
	    Qsqlite_locked_error: Qsqlite_error,
	    errmsg);
}

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, it should be a list or a vector specifying the
values that will be interpolated into a parameterized statement.

By default, the return value is a list, whose contents depend on
the value of the optional argument RETURN-TYPE.

If RETURN-TYPE is nil or omitted, the function returns a list of rows
matching QUERY.  If RETURN-TYPE is `full', the function returns a
list whose first element is the list of column names, and the rest
of the elements are the rows matching QUERY.  If RETURN-TYPE is `set',
the function returns a set object that can be queried with functions
like `sqlite-next' etc., in order 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 (Qsqlite_error, build_string ("VALUES must be a list or a vector"));

  sqlite3 *sdb = XSQLITE (db)->db;
  Lisp_Object retval = Qnil, errmsg = Qnil,
    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);
      errmsg = sqlite_prepare_errdata (ret, sdb);
      goto exit;
    }

  /* Query with parameters.  */
  if (!NILP (values))
    {
      const char *err = bind_values (sdb, stmt, values);
      if (err != NULL)
	{
	  sqlite3_finalize (stmt);
	  errmsg = build_string (err);
	  goto exit;
	}
    }

  /* Return a handle to get the data.  */
  if (EQ (return_type, Qset))
    {
      retval = make_sqlite (true, sdb, stmt, XSQLITE (db)->name);
      goto exit;
    }

  /* Return the data directly.  */
  Lisp_Object data = Qnil;
  while (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 (! NILP (errmsg))
    xsignal1 (Qsqlite_error, 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-pragma", Fsqlite_pragma, Ssqlite_pragma, 2, 2, 0,
       doc: /* Execute PRAGMA in DB.  */)
  (Lisp_Object db, Lisp_Object pragma)
{
  check_sqlite (db, false);
  CHECK_STRING (pragma);

  return sqlite_exec (XSQLITE (db)->db,
		      SSDATA (concat2 (build_string ("PRAGMA "), pragma)));
}

#ifdef HAVE_SQLITE3_LOAD_EXTENSION
DEFUN ("sqlite-load-extension", Fsqlite_load_extension,
       Ssqlite_load_extension, 2, 2, 0,
       doc: /* Load an SQlite MODULE into DB.
MODULE should be the name of an SQlite module's file, a
shared library in the system-dependent format and having a
system-dependent file-name extension.

Only modules on Emacs' list of allowed modules can be loaded.  */)
  (Lisp_Object db, Lisp_Object module)
{
  check_sqlite (db, false);
  CHECK_STRING (module);

  /* Add names of useful and free modules here.  */
  const char *allowlist[3] = { "pcre", "csvtable", NULL };
  char *name = SSDATA (Ffile_name_nondirectory (module));
  /* Possibly skip past a common prefix.  */
  const char *prefix = "libsqlite3_mod_";
  if (!strncmp (name, prefix, strlen (prefix)))
    name += strlen (prefix);

  bool do_allow = false;
  for (const char **allow = allowlist; *allow; allow++)
    {
      if (strlen (*allow) < strlen (name)
	  && !strncmp (*allow, name, strlen (*allow))
	  && (!strcmp (name + strlen (*allow), ".so")
	      || !strcmp (name + strlen (*allow), ".DLL")))
	{
	  do_allow = true;
	  break;
	}
    }

  if (!do_allow)
    xsignal1 (Qsqlite_error, build_string ("Module name not on allowlist"));

  int result = sqlite3_load_extension
		       (XSQLITE (db)->db,
			SSDATA (ENCODE_FILE (Fexpand_file_name (module, Qnil))),
			NULL, NULL);
  if (result ==  SQLITE_OK)
    return Qt;
  return Qnil;
}
#endif /* HAVE_SQLITE3_LOAD_EXTENSION */

DEFUN ("sqlite-next", Fsqlite_next, Ssqlite_next, 1, 1, 0,
       doc: /* Return the next result set from SET.
Return nil when the statement has finished executing successfully.  */)
  (Lisp_Object set)
{
  check_sqlite (set, true);

  if (XSQLITE (set)->eof)
    return Qnil;

  int ret = sqlite3_step (XSQLITE (set)->stmt);
  if (ret != SQLITE_ROW && ret != SQLITE_OK && ret != SQLITE_DONE)
    xsignal1 (Qsqlite_error, 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 are 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);
  XSQLITE (set)->db = NULL;
  return Qt;
}

DEFUN ("sqlite-version", Fsqlite_version, Ssqlite_version, 0, 0, 0,
       doc: /* Return the version string of the SQLite library.
Signal an error if SQLite support is not available.  */)
  (void)
{
  if (!init_sqlite_functions ())
    error ("sqlite support is not available");
  return build_string (sqlite3_libversion ());
}

#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
    return init_sqlite_functions () ? Qt : Qnil;
# 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_pragma);
#ifdef HAVE_SQLITE3_LOAD_EXTENSION
  defsubr (&Ssqlite_load_extension);
#endif
  defsubr (&Ssqlite_next);
  defsubr (&Ssqlite_columns);
  defsubr (&Ssqlite_more_p);
  defsubr (&Ssqlite_finalize);
  defsubr (&Ssqlite_version);
  DEFSYM (Qset, "set");
  DEFSYM (Qfull, "full");
#endif
  defsubr (&Ssqlitep);
  defsubr (&Ssqlite_available_p);

  DEFSYM (Qsqlite_error, "sqlite-error");
  Fput (Qsqlite_error, Qerror_conditions,
	Fpurecopy (list2 (Qsqlite_error, Qerror)));
  Fput (Qsqlite_error, Qerror_message,
	build_pure_c_string ("Database error"));

  DEFSYM (Qsqlite_locked_error, "sqlite-locked-error");
  Fput (Qsqlite_locked_error, Qerror_conditions,
	Fpurecopy (list3 (Qsqlite_locked_error, Qsqlite_error, Qerror)));
  Fput (Qsqlite_locked_error, Qerror_message,
	build_pure_c_string ("Database locked"));

  DEFSYM (Qsqlitep, "sqlitep");
  DEFSYM (Qfalse, "false");
  DEFSYM (Qsqlite, "sqlite");
  DEFSYM (Qsqlite3, "sqlite3");
  DEFSYM (Qbinary, "binary");
  DEFSYM (Qcoding_system, "coding-system");
}