RSQLiteFixed: 'SQLite' Interface for R

#' @include SQLiteConnection.R
#' @include SQLiteDriver.R
NULL

#' Connect to an SQLite database
#'
#' Together, `SQLite()` and `dbConnect()` allow you to connect to
#' a SQLite database file. See [DBI::dbSendQuery()] for how to issue queries
#' and receive results.
#'
#' Connections are automatically cleaned-up after they're deleted and
#' reclaimed by the GC. You can use [DBI::dbDisconnect()] to terminate the
#' connection early, but it will not actually close until all open result
#' sets have been closed (and you'll get a warning message to this effect).
#'
#' @seealso
#' The corresponding generic functions [DBI::dbConnect()] and [DBI::dbDisconnect()].
#'
#' @export
#' @param ... In previous versions, `SQLite()` took arguments. These
#'   have now all been moved to [dbConnect()], and any arguments here
#'   will be ignored with a warning.
#'
#' @return `SQLite()` returns an object of class [SQLiteDriver-class].
#' @import methods DBI
#' @aliases RSQLite RSQLite-package
SQLite <- function(...) {
  if (nargs() > 0) {
    warning("All arguments to RSQLite Driver are ignored.", call. = FALSE)
  }
  new("SQLiteDriver")
}

# From https://www.sqlite.org/c3ref/c_open_autoproxy.html
#' @export
SQLITE_RW <-  0x00000002L
#' @export
SQLITE_RO <-  0x00000001L
#' @export
SQLITE_RWC <- bitwOr(bitwOr(0x00000004L, 0x00000002L), 0x00000040L)
# read/write + create + url

#' @param drv,conn An objected generated by [SQLite()], or an existing
#'   \code{\linkS4class{SQLiteConnection}}. If an connection, the connection
#'   will be cloned.
#' @param dbname The path to the database file. SQLite keeps each database
#'   instance in one single file. The name of the database \emph{is} the file
#'   name, thus database names should be legal file names in the running
#'   platform. There are two exceptions:
#'
#'   \itemize{
#'   \item `""` will create a temporary on-disk database. The file
#'     will be deleted when the connection is closed.
#'   \item `":memory:"` or `"file::memory:"` will create a temporary
#'     in-memory database.
#'   }
#' @param cache_size Advanced option. A positive integer to change the maximum
#'   number of disk pages that SQLite holds in memory (SQLite's default is
#'   2000 pages). See \url{http://www.sqlite.org/pragma.html#pragma_cache_size}
#'   for details.
#' @param synchronous Advanced options. Possible values for `synchronous`
#'   are "off" (the default), "normal", or  "full".  Users have reported
#'   significant speed ups using `sychronous = "off"`, and the SQLite
#'   documentation itself implies considerable improved performance at the very
#'   modest risk of database corruption in the unlikely case of the operating
#'   system (\emph{not} the R application) crashing. See
#'   \url{http://www.sqlite.org/pragma.html#pragma_synchronous} for details.
#' @param flags `SQLITE_RWC`: open the database in read/write mode
#'   and create the database file if it does not already exist;
#'   `SQLITE_RW`: open the database in read/write mode. Raise an error
#'   if the file does not already exist; `SQLITE_RO`: open the database in
#'   read only mode.  Raise an error if the file does not already exist
#' @param loadable.extensions When `TRUE` (default) SQLite3
#'   loadable extensions are enabled. Setting this value to `FALSE`
#'   prevents extensions from being loaded.
#' @param default.extensions When `TRUE` (default) the [initExtension()]
#'   function will be called on the new connection.Setting this value to `FALSE`
#'   requires calling `initExtension()` manually.
#' @param vfs Select the SQLite3 OS interface. See
#'   \url{http://www.sqlite.org/vfs.html} for details. Allowed values are
#'   `"unix-posix"`, `"unix-unix-afp"`,
#'   `"unix-unix-flock"`, `"unix-dotfile"`, and
#'   `"unix-none"`.
#' @return `dbConnect()` returns an object of class [SQLiteConnection-class].
#'
#' @aliases SQLITE_RWC SQLITE_RW SQLITE_RO
#' @export
#' @rdname SQLite
#' @examples
#' library(DBI)
#' # Initialize a temporary in memory database and copy a data.frame into it
#' con <- dbConnect(RSQLite::SQLite(), ":memory:")
#' data(USArrests)
#' dbWriteTable(con, "USArrests", USArrests)
#' dbListTables(con)
#'
#' # Fetch all query results into a data frame:
#' dbGetQuery(con, "SELECT * FROM USArrests")
#'
#' # Or do it in batches
#' rs <- dbSendQuery(con, "SELECT * FROM USArrests")
#' d1 <- dbFetch(rs, n = 10)      # extract data in chunks of 10 rows
#' dbHasCompleted(rs)
#' d2 <- dbFetch(rs, n = -1)      # extract all remaining data
#' dbHasCompleted(rs)
#' dbClearResult(rs)
#'
#' # clean up
#' dbDisconnect(con)
setMethod("dbConnect", "SQLiteDriver",
  function(drv, dbname = "", ..., loadable.extensions = TRUE,
           default.extensions = loadable.extensions, cache_size = NULL,
           synchronous = "off", flags = SQLITE_RWC, vfs = NULL) {
    stopifnot(length(dbname) == 1, !is.na(dbname))

    if (!is_url_or_special_filename(dbname)) {
      dbname <- normalizePath(dbname, mustWork = FALSE)
    }

    dbname <- enc2utf8(dbname)

    vfs <- check_vfs(vfs)
    stopifnot(is.integer(flags), length(flags) == 1)

    con <- new("SQLiteConnection",
      ptr = connection_connect(dbname, loadable.extensions, flags, vfs),
      dbname = dbname,
      flags = flags,
      vfs = vfs,
      loadable.extensions = loadable.extensions,
      ref = new.env(parent = emptyenv())
    )

    ## experimental PRAGMAs
    if (!is.null(cache_size)) {
      cache_size <- as.integer(cache_size)
      tryCatch(
        dbExecute(con, sprintf("PRAGMA cache_size=%d", cache_size)),
        error = function(e) {
          warning("Couldn't set cache size: ", conditionMessage(e), "\n",
            "Use `cache_size` = NULL to turn off this warning.",
            call. = FALSE)
        }
      )
    }

    if (!is.null(synchronous)) {
      synchronous <- match.arg(synchronous, c("off", "normal", "full"))
      tryCatch(
        dbExecute(con, sprintf("PRAGMA synchronous=%s", synchronous)),
        error = function(e) {
          warning("Couldn't set synchronous mode: ", conditionMessage(e), "\n",
                  "Use `synchronous` = NULL to turn off this warning.",
                  call. = FALSE)
        }
      )
    }

    if (default.extensions) {
      initExtension(con)
    }

    con
  }
)

check_vfs <- function(vfs) {
  if (is.null(vfs) || vfs == "") return("")

  if (.Platform[["OS.type"]] == "windows") {
    warning("vfs customization not available on this platform.",
      " Ignoring value: vfs = ", vfs, call. = FALSE)
    return("")
  }

  match.arg(vfs, c("unix-posix", "unix-afp", "unix-flock", "unix-dotfile",
    "unix-none"))
}

# From the SQLite docs: If the filename is ":memory:", then a private,
# temporary in-memory database is created for the connection. This in-memory
# database will vanish when the database connection is closed. Future versions
# of SQLite might make use of additional special filenames that begin with the
# ":" character. It is recommended that when a database filename actually does
# begin with a ":" character you should prefix the filename with a pathname
# such as "./" to avoid ambiguity.
#
# This function checks for known protocols, or for a colon at the beginning.
is_url_or_special_filename <- function(x) grepl("^(?:file|http|ftp|https|):", x)

#' @export
#' @rdname SQLite
setMethod("dbConnect", "SQLiteConnection", function(drv, ...){
  if (drv@dbname %in% c("", ":memory:", "file::memory:")) {
    stop("Can't clone a temporary database", call. = FALSE)
  }

  dbConnect(SQLite(), drv@dbname, vfs = drv@vfs, flags = drv@flags,
    loadable.extensions = drv@loadable.extensions)
})


#' @export
#' @rdname SQLite
setMethod("dbDisconnect", "SQLiteConnection", function(conn, ...) {
  connection_release(conn@ptr)
  invisible(TRUE)
})