1
#' DBMS Connections which disconnect themselves.
2
#'
3
#' Connections to Database Management Systems which automatically disconnect. In
4
#' particular connections which are created with `DBI::dbConnect()` and closed
5
#' with `DBI::dbDisconnect()`.
6
#'
7
#' @template with
8
#' @param con For `with_db_connection()` a named list with the connection(s) to
9
#' create. For `local_db_connection()` the code to create a single connection,
10
#' which is then returned.
11
#' @param .local_envir `[environment]`\cr The environment to use for scoping.
12
#' @importFrom stats setNames
13
#' @examples
14
#' db <- tempfile()
15
#' with_db_connection(
16
#'   list(con = DBI::dbConnect(RSQLite::SQLite(), db)), {
17
#'     DBI::dbWriteTable(con, "mtcars", mtcars)
18
#' })
19
#'
20
#' head_db_table <- function(...) {
21
#'   con <- local_db_connection(DBI::dbConnect(RSQLite::SQLite(), db))
22
#'   head(DBI::dbReadTable(con, "mtcars"), ...)
23
#' }
24
#' head_db_table()
25
#' unlink(db)
26
#' @export
27
with_db_connection <- function(con, code) {
28 1
  requireNamespace("DBI")
29

30 1
  stopifnot(all(is.named(con)))
31 1
  stopifnot(all(vlapply(con, methods::is, "DBIConnection")))
32

33 1
  nme <- tempfile()
34 1
  (get("attach", baseenv()))(con, name = nme, warn.conflicts = FALSE)
35 1
  on.exit({
36 1
    for (connection in con) DBI::dbDisconnect(connection)
37 1
    detach(nme, character.only = TRUE)
38
  })
39 1
  force(code)
40
}
41

42
#' @rdname with_db_connection
43
#' @export
44
local_db_connection <- function(con, .local_envir = parent.frame()) {
45 1
  requireNamespace("DBI")
46 1
  stopifnot(methods::is(con, "DBIConnection"))
47

48 1
  defer(DBI::dbDisconnect(con), envir = .local_envir)
49 1
  con
50
}

Read our documentation on viewing source code .

Loading