1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
|
#' DBMS Connections which disconnect themselves.
#'
#' Connections to Database Management Systems which automatically disconnect. In
#' particular connections which are created with `DBI::dbConnect()` and closed
#' with `DBI::dbDisconnect()`.
#'
#' @template with
#' @param con For `with_db_connection()` a named list with the connection(s) to
#' create. For `local_db_connection()` the code to create a single connection,
#' which is then returned.
#' @param .local_envir `[environment]`\cr The environment to use for scoping.
#' @examples
#' db <- tempfile()
#' with_db_connection(
#' list(con = DBI::dbConnect(RSQLite::SQLite(), db)), {
#' DBI::dbWriteTable(con, "mtcars", mtcars)
#' })
#'
#' head_db_table <- function(...) {
#' con <- local_db_connection(DBI::dbConnect(RSQLite::SQLite(), db))
#' head(DBI::dbReadTable(con, "mtcars"), ...)
#' }
#' head_db_table()
#' unlink(db)
#' @export
with_db_connection <- function(con, code) {
requireNamespace("DBI", quietly = TRUE)
stopifnot(all(is.named(con)))
stopifnot(all(vlapply(con, methods::is, "DBIConnection")))
nme <- tempfile()
(get("attach", baseenv()))(con, name = nme, warn.conflicts = FALSE)
on.exit({
for (connection in con) DBI::dbDisconnect(connection)
detach(nme, character.only = TRUE)
})
force(code)
}
#' @rdname with_db_connection
#' @export
local_db_connection <- function(con, .local_envir = parent.frame()) {
requireNamespace("DBI", quietly = TRUE)
stopifnot(methods::is(con, "DBIConnection"))
defer(DBI::dbDisconnect(con), envir = .local_envir)
con
}
|
