Compare commits

..

5 Commits

55 changed files with 364 additions and 987 deletions

View File

@@ -1,6 +1,6 @@
Package: AVSDevR.DBClient Package: AVSDevR.DBClient
Title: AVSDev R Database Client Title: AVSDev R Database Client
Version: 1.0.0 Version: 0.0.2
Authors@R: Authors@R:
person("Craig", "Williams", , "craig@avsdev.uk", role = c("aut", "cre")) person("Craig", "Williams", , "craig@avsdev.uk", role = c("aut", "cre"))
Description: AVSDevR.DBClient provides a collection of utility methods for Description: AVSDevR.DBClient provides a collection of utility methods for
@@ -14,9 +14,6 @@ Imports:
dbplyr, dbplyr,
dplyr, dplyr,
R6, R6,
rlang,
tibble tibble
Suggests: Suggests:
RMariaDB,
RPostgres,
sf sf

View File

@@ -2,7 +2,3 @@
export(DBClient) export(DBClient)
export(DBConnection) export(DBConnection)
import(R6)
importFrom(R6,R6Class)
importFrom(rlang,":=")
importFrom(rlang,.data)

View File

@@ -1,29 +0,0 @@
conn <- NULL
#' @name DBClient$initialize
#' @title DBClient$initialize
#' @description
#' Initalises the DBClient instance with a DBConnection
#' @param conn <DBConnection> An instance of DBConnection
NULL
initialize <- function(conn) {
if (is.null(conn) || !R6::is.R6(conn) || !inherits(conn, "DBConnection")) {
stop("DBConnection instance required!")
}
private$conn <- conn
}
#' @name DBClient$getConnection
#' @title DBClient$getConnection
#' @description
#' Returns the DBConnection instance for this client
NULL
getConnection <- function() {
private$conn
}
.getDBConn <- function() {
private$conn$getConnection()
}

View File

@@ -1,14 +0,0 @@
#' @name DBClient$dbAction
#' @title DBClient$dbAction
#' @description
#' Executes a query/statement on a database which has no result
#' @param statement <character> Statement to run
#' @returns <logical> TRUE if the execution was successful, FALSE if not
NULL
dbAction <- function(statement) {
if (getOption("db.debug", FALSE)) {
cat("dbQuery:", statement, "\n")
}
DBI::dbExecute(private$getDBConn(), statement)
}

View File

@@ -1,84 +0,0 @@
#' @name DBClient$collectOrReturn
#' @title DBClient$collectOrReturn
#' @description
#' Utility method which returns the query and optionally runs dplyr::collect on
#' it first.
#' @param qry <character> A dplyr query
#' @param collect <logical> Collect the query. Defaults to checking parent frame
#' for the parameter value
#' @returns <complex> The query, optionally collect'd
NULL
collectOrReturn <- function(
qry, collect = get("collect", pos = parent.frame())
) {
res <- qry
if (length(collect) == 1 && collect[[1]] == TRUE) {
res <- dplyr::collect(res)
}
res
}
#' @name DBClient$collectGeometries
#' @title DBClient$collectGeometries
#' @description
#' Requires sf package.
#'
#' Runs dplyr::collect on a query, If there are gemoetry columns (specified by
#' gemoetry_cols or named geom or named proj) then they are translated into sf
#' geometry columns using sf::st_as_sfc with a CRS.
#'
#' The default CRS for a column named `geom` is 4326.
#' The default CRS for a column named `proj` is 3035.
#' The default CRS for other geometry columns is specified by `geometry_crs`
#'
#' @param qry <complex> The query to collect
#' @param geometry_cols <character> Any geometry columns to translate to sf
#' @param geometry_crs <complex> The CRS to assign to the columns. Either
#' specified by the CRS number or an sf::st_crs() object.
#' @param check_ring_dir <logical> Check the direction of rings during the
#' translation. See `sf::st_as_sfc` for further details.
#' @returns <complex> The collected query with translated geometry columns
NULL
collectGeometries <- function(
qry, geometry_cols = c("geometry"), geometry_crs = 4326, check_ring_dir = TRUE
) {
requireNamespace("sf")
res <- dplyr::collect(qry)
if (sum(geometry_cols %in% colnames(res)) > 0) {
res <- dplyr::mutate(
res,
dplyr::across(dplyr::any_of(geometry_cols), function(.col) {
sf::st_as_sfc(
.col,
EWKB = TRUE,
crs = geometry_crs,
check_ring_dir = check_ring_dir
)
})
)
}
if ("geom" %in% colnames(res) && sum("geom" %in% geometry_cols) == 0) {
res <- dplyr::mutate(
res,
geom = sf::st_as_sfc(
.data$geom, EWKB = TRUE, crs = 4326, check_ring_dir = check_ring_dir
)
)
}
if ("proj" %in% colnames(res) && sum("proj" %in% geometry_cols) == 0) {
res <- dplyr::mutate(
res,
proj = sf::st_as_sfc(
.data$proj, EWKB = TRUE, crs = 3035, check_ring_dir = check_ring_dir
)
)
}
res
}

View File

@@ -1,17 +0,0 @@
#' @name DBClient$dbQuery
#' @title DBClient$dbQuery
#' @description
#' Runs a query (statement) on a database and returns the results
#' @param statement <character> Query to run on the database
#' @returns <complex> A lazy data table with the results from the query
NULL
dbQuery <- function(statement) {
if (getOption("db.debug", FALSE)) {
cat("dbQuery:", statement, "\n")
}
query <- DBI::dbSendQuery(private$getDBConn(), statement)
res <- DBI::dbFetch(query)
DBI::dbClearResult(query)
res
}

View File

@@ -1,39 +0,0 @@
#' @name DBClient$withSchema
#' @title DBClient$withSchema
#' @description
#' Prefixes schema to the table name, if set in the configuration.
#' @param table_name <character> Table name to prefix schema to
#' @returns <character> Table name with prefixed schema
NULL
withSchema <- function(table_name) {
config <- private$conn$getConfiguration()
if (exists("schema", config)) {
DBI::dbQuoteIdentifier(
private$getDBConn(), DBI::Id(schema = config$schema, table = table_name)
)
} else {
DBI::dbQuoteIdentifier(
private$getDBConn(), DBI::Id(table = table_name)
)
}
}
#' @name DBClient$dplyrWithSchema
#' @title DBClient$dplyrWithSchema
#' @description
#' Prefixes schema to the table name, if set in the configuration. Specifically
#' uses the dbplyr::in_schema method rather than the direct
#' DBI::dbQuoteIdentifier method.
#' @param table_name <character> Table name to prefix schema to
#' @returns <character> Table name with prefixed schema
NULL
dplyrWithSchema <- function(table_name) {
config <- private$conn$getConfiguration()
if (exists("schema", config) && !is.null(config$schema)) {
dbplyr::in_schema(config$schema, table_name)
} else {
table_name
}
}

View File

@@ -1,14 +0,0 @@
#' @name DBClient$table
#' @title DBClient$table
#' @description
#' Creates a `dplyr::tbl` instantiation with the current database connection.
#' @param table_name <character> The database table name
#' @returns <complex> A dplyr::tbl instance
NULL
table <- function(table_name) {
if (getOption("db.debug", FALSE)) {
cat("dbTable:", table_name, "\n")
}
dplyr::tbl(private$getDBConn(), self$dplyrWithSchema(table_name))
}

View File

@@ -1,15 +0,0 @@
#' @name DBClient$withTransaction
#' @title DBClient$withTransaction
#' @description
#' Runs a given expression within a database transaction.
#' @param expr <expression> Expression to run in a transaction
#' @returns <logical> TRUE if transaction was successful
NULL
withTransaction <- function(expr) {
private$conn$beginTransaction()
on.exit(private$conn$rollbackTransaction())
expr
on.exit()
private$conn$commitTransaction()
}

View File

@@ -1,12 +1,13 @@
class_env <- new.env(parent = baseenv()) class_env <- new.env(parent = baseenv())
res <- lapply( res <- lapply(list.files("R/DBClientClass", pattern = ".R"), function(fn) {
list.files("R", pattern = "DBClient-.*\\.R"), eval(
function(fn) { parse(paste0("R/DBClientClass/", fn)),
eval(parse(paste0("R/", fn)), envir = class_env, enclos = emptyenv()) envir = class_env,
} enclos = emptyenv()
) )
})
fn_names <- names(which(vapply(class_env, is.function, logical(1)))) fn_names <- names(which(vapply(class_env, is.function, logical(1))))
fn_list <- lapply(fn_names, function(fn_name) { fn_list <- lapply(fn_names, function(fn_name) {
@@ -33,7 +34,6 @@ names(member_list) <- member_names
NULL NULL
#' @export #' @export
# nolint next: object_name_linter. R6Class
DBClient <- R6::R6Class( DBClient <- R6::R6Class(
"DBClient", "DBClient",
public = fn_list, public = fn_list,

View File

@@ -1,14 +1,18 @@
keyExists <- function(table_name, key_name, id) { keyExists <- function(table_name, key_name, id) {
key <- dbplyr::ident(key_name) key <- dbplyr::ident(key_name)
tbl <- self$table(table_name) res <- self$table(table_name) %>%
res <- dplyr::pull(dplyr::count(dplyr::filter(tbl, key == !!id)), .data$n) dplyr::filter(key == !!id) %>%
res[[1]] > 0 dplyr::count() %>%
dplyr::pull(n)
return(res[[1]] > 0)
} }
selectByKey <- function(table_name, key_name, id) { selectByKey <- function(table_name, key_name, id) {
key <- dbplyr::ident(key_name) key <- dbplyr::ident(key_name)
tbl <- self$table(table_name) res <- self$table(table_name) %>%
dplyr::collect(dplyr::filter(tbl, key %in% !!id)) dplyr::filter(key %in% !!id) %>%
dplyr::collect()
return(res)
} }
insertByKey <- function(table_name, key_name, id, ...) { insertByKey <- function(table_name, key_name, id, ...) {

View File

@@ -6,17 +6,17 @@
if (sum(keys %in% class(tbl$lazy_query$x)) == 0) { if (sum(keys %in% class(tbl$lazy_query$x)) == 0) {
tbl$lazy_query$x <- dbplyr::as.sql( tbl$lazy_query$x <- dbplyr::as.sql(
tbl$lazy_query$x, private$getDBConn() tbl$lazy_query$x, private$client$getConnection()
) )
} }
tbl return(tbl)
} }
insertRows <- function(table_name, rows, key_name = NULL) { insertRows <- function(table_name, rows, key_name = NULL) {
tbl <- self$table(table_name) tbl <- self$table(table_name)
new_rows <- dbplyr::copy_inline(private$getDBConn(), rows) new_rows <- dbplyr::copy_inline(private$client$getConnection(), rows)
if (getOption("db.simulate", FALSE)) { if (getOption("db.simulate", FALSE)) {
return(printDebug("insertRows", table_name, key_name, tbl, rows, TRUE)) return(printDebug("insertRows", table_name, key_name, tbl, rows, TRUE))
@@ -40,12 +40,12 @@ insertRows <- function(table_name, rows, key_name = NULL) {
return(dbplyr::get_returned_rows(tbl)) return(dbplyr::get_returned_rows(tbl))
} }
invisible(tbl) return(invisible(tbl))
} }
appendRows <- function(table_name, rows, key_name = NULL) { appendRows <- function(table_name, rows, key_name = NULL) {
tbl <- self$table(table_name) tbl <- self$table(table_name)
new_rows <- dbplyr::copy_inline(private$getDBConn(), rows) new_rows <- dbplyr::copy_inline(private$client$getConnection(), rows)
if (getOption("db.simulate", FALSE)) { if (getOption("db.simulate", FALSE)) {
return(printDebug("appendRows", table_name, key_name, tbl, rows, TRUE)) return(printDebug("appendRows", table_name, key_name, tbl, rows, TRUE))
@@ -64,21 +64,24 @@ appendRows <- function(table_name, rows, key_name = NULL) {
return(dbplyr::get_returned_rows(tbl)) return(dbplyr::get_returned_rows(tbl))
} }
invisible(TRUE) return(invisible(TRUE))
} }
upsertRows <- function(table_name, rows, key_name = NULL) { upsertRows <- function(table_name, rows, key_name = NULL) {
tbl <- self$table(table_name) tbl <- self$table(table_name)
new_rows <- dbplyr::copy_inline(private$getDBConn(), rows) new_rows <- dbplyr::copy_inline(private$client$getConnection(), rows)
tbl <- private$fix_dbplyr(tbl) tbl <- private$fix_dbplyr(tbl)
# NOTE: Temporary fix for issue: tidyverse/dbplyr#1279 # NOTE: Temporary fix for issue: tidyverse/dbplyr#1279
if ("MariaDBConnection" %in% class(private$getDBConn())) { if ("MariaDBConnection" %in% class(private$client$getConnection())) {
keys <- dplyr::pull(rows, !!key_name) keys <- rows %>%
tbl_keys <- dplyr::select(tbl, !!key_name) dplyr::pull(!!key_name)
filt_rows <- dplyr::filter(tbl_keys, !!as.symbol(key_name) %in% !!keys) n_rows <- tbl %>%
n_rows <- dplyr::pull(dplyr::count(filt_rows), .data$n) dplyr::select(!!key_name) %>%
dplyr::filter(!!as.symbol(key_name) %in% !!keys) %>%
dplyr::count() %>%
dplyr::pull(n)
if (n_rows == 0) { if (n_rows == 0) {
return(insertRows(table_name, rows, key_name)) return(insertRows(table_name, rows, key_name))
} else { } else {
@@ -98,12 +101,12 @@ upsertRows <- function(table_name, rows, key_name = NULL) {
} }
} }
invisible(TRUE) return(invisible(TRUE))
} }
updateRows <- function(table_name, rows, key_name = NULL) { updateRows <- function(table_name, rows, key_name = NULL) {
tbl <- self$table(table_name) tbl <- self$table(table_name)
new_rows <- dbplyr::copy_inline(private$getDBConn(), rows) new_rows <- dbplyr::copy_inline(private$client$getConnection(), rows)
if (getOption("db.simulate", FALSE)) { if (getOption("db.simulate", FALSE)) {
return(printDebug("updateRows", table_name, key_name, tbl, rows, TRUE)) return(printDebug("updateRows", table_name, key_name, tbl, rows, TRUE))
@@ -122,12 +125,12 @@ updateRows <- function(table_name, rows, key_name = NULL) {
return(dbplyr::get_returned_rows(tbl)) return(dbplyr::get_returned_rows(tbl))
} }
invisible(TRUE) return(invisible(TRUE))
} }
deleteRows <- function(table_name, rows, key_name = NULL) { deleteRows <- function(table_name, rows, key_name = NULL) {
tbl <- self$table(table_name) tbl <- self$table(table_name)
old_rows <- dbplyr::copy_inline(private$getDBConn(), rows) old_rows <- dbplyr::copy_inline(private$client$getConnection(), rows)
if (getOption("db.simulate", FALSE)) { if (getOption("db.simulate", FALSE)) {
return(printDebug("deleteRows", table_name, key_name, tbl, rows, TRUE)) return(printDebug("deleteRows", table_name, key_name, tbl, rows, TRUE))
@@ -151,5 +154,5 @@ deleteRows <- function(table_name, rows, key_name = NULL) {
return(dbplyr::get_returned_rows(tbl)) return(dbplyr::get_returned_rows(tbl))
} }
invisible(TRUE) return(invisible(TRUE))
} }

View File

@@ -0,0 +1,8 @@
client <- NULL
initialize <- function(client) {
if (is.null(client) || !R6::is.R6(client) || inherits(client, "DBClient")) {
stop("DBClient instance required!")
}
private$client <- client
}

View File

@@ -0,0 +1,6 @@
dbAction <- function(statement) {
if (getOption("db.debug", FALSE)) {
cat("dbQuery:", statement, "\n")
}
DBI::dbExecute(private$client$getConnection(), statement)
}

View File

@@ -0,0 +1,52 @@
collectOrReturn <- function(
qry, collect = get("collect", pos = parent.frame())
) {
if (length(collect) == 1 && collect[[1]] == TRUE) {
return(dplyr::collect(qry))
} else {
return(qry)
}
}
collectGeometries <- function(
qry, geometry_cols = c("geometry"), geometry_crs = 4326, check_ring_dir = TRUE
) {
requireNamespace("sf")
qry <- qry %>%
dplyr::collect()
if (sum(geometry_cols %in% colnames(qry)) > 0) {
qry <- qry %>%
dplyr::mutate(
dplyr::across(dplyr::any_of(geometry_cols), function(.col) {
sf::st_as_sfc(
.col,
EWKB = TRUE,
crs = geometry_crs,
check_ring_dir = check_ring_dir
)
})
)
}
if ("geom" %in% colnames(qry) && sum("geom" %in% geometry_cols) == 0) {
qry <- qry %>%
dplyr::mutate(
geom = sf::st_as_sfc(
geom, EWKB = TRUE, crs = 4326, check_ring_dir = check_ring_dir
)
)
}
if ("proj" %in% colnames(qry) && sum("proj" %in% geometry_cols) == 0) {
qry <- qry %>%
dplyr::mutate(
proj = sf::st_as_sfc(
proj, EWKB = TRUE, crs = 3035, check_ring_dir = check_ring_dir
)
)
}
return(qry)
}

View File

@@ -0,0 +1,9 @@
dbQuery <- function(statement) {
if (getOption("db.debug", FALSE)) {
cat("dbQuery:", statement, "\n")
}
query <- DBI::dbSendQuery(private$client$getConnection(), statement)
res <- DBI::dbFetch(query)
DBI::dbClearResult(query)
res
}

View File

@@ -0,0 +1,21 @@
withSchema <- function(table_name) {
config <- private$client$getConfiguration()
if (exists("schema", config)) {
return(DBI::dbQuoteIdentifier(
getConnection(), DBI::Id(schema = config$schema, table = table_name)
))
} else {
return(DBI::dbQuoteIdentifier(
getConnection(), DBI::Id(table = table_name)
))
}
}
dplyrWithSchema <- function(table_name) {
config <- private$client$getConfiguration()
if (exists("schema", config) && !is.null(config$schema)) {
return(dbplyr::in_schema(config$schema, table_name))
} else {
return(table_name)
}
}

View File

@@ -0,0 +1,7 @@
table <- function(table_name) {
if (getOption("db.debug", FALSE)) {
cat("dbTable:", table_name, "\n")
}
dplyr::tbl(private$client$getConnection(), self$dplyrWithSchema(table_name))
}

View File

@@ -0,0 +1,8 @@
withTransaction <- function(expr) {
private$client$beginTransaction()
on.exit(private$client$rollbackTransaction())
expr
on.exit()
private$client$commitTransaction()
}

View File

@@ -1,141 +0,0 @@
config <- NULL
.configureList <- function(db) {
was_connected <- FALSE
if (!is.null(private$conn)) {
was_connected <- TRUE
self$disconnect()
}
private$config <- db
if (was_connected) {
self$connect()
}
invisible(private$config)
}
#' Configures the DBClient instance.
#'
#' There are 2 options for configuration, either: pass in a named list; or use
#' named parameters.
#'
#' @param engine The database engine (mysql, postgres) as supported by DBI
#' @param host The database host
#' @param port The database port
#' @param user The database user to connect with
#' @param password The database password to connect with
#' @param dbname The database to use
#' @param schema The database schema to use (postgres)
#' @param autoconnect Autoconnect to the database if not already connected
#' @param name The database to use (alternative to dbname)
#'
#' @returns The configuration accepted
.configureDefault <- function(
host, port, user, password, dbname,
engine = NULL, name = NULL, schema = NULL, autoconnect = NULL
) {
if (is.null(autoconnect)) {
autoconnect <- getOption("db.autoconnect", FALSE)
}
private$configureList(list(
engine = engine,
host = host,
port = port,
user = user,
password = password,
name = ifelse(is.null(name), dbname, name),
schema = schema,
autoconnect = autoconnect
))
}
#' @name DBConnection$configure
#' @title DBConnection$configure
#' @description
#' Configures the DBClient instance.
#'
#' There are 2 options for configuration, either: pass in a named list; or use
#' named parameters.
#'
#' @param ... Named parameters for configuring the connection or a name list of
#' parameters
#'
#' @returns <list> The configuration that has loaded
NULL
configure <- function(...) {
args <- list(...)
if (sum("list" %in% class(args[[1]])) > 0) {
private$configureList(args[[1]])
} else {
do.call(private$configureDefault, args)
}
}
#' @name DBConnection$getConfiguration
#' @title DBConnection$getConfiguration
#' @description
#' Get the current configuration of the DBClient instance.
#' @returns <list> Current configuration. If not configured, NULL is returned
NULL
getConfiguration <- function() {
private$config
}
.loadConfigurationGlobalR <- function() {
if (!file.exists("global.R")) {
return(FALSE)
}
e <- new.env(parent = baseenv())
eval(parse("global.R"), envir = e)
if ("db" %in% ls(e)) {
self$configure(e$db)
} else if ("global" %in% ls(e)) {
self$configure(e$global$db)
} else {
return(FALSE)
}
TRUE
}
.loadConfigurationEnvR <- function() {
if (!file.exists(".env.R")) {
return(FALSE)
}
e <- new.env(parent = baseenv())
eval(parse(".env.R"), envir = e)
if ("db" %in% ls(e)) {
self$configure(e$db)
} else if ("global" %in% ls(e)) {
self$configure(e$global$db)
} else {
return(FALSE)
}
TRUE
}
#' @name DBConnection$loadConfiguration
#' @title DBConnection$loadConfiguration
#' @description
#' Attempts to load the configuration either from global.R or .env.R.
#' @param warn Emit a warning with which file it attempting to be loaded
#' @returns <logical> TRUE if configuration was successful, FALSE otherwise
NULL
loadConfiguration <- function(warn = FALSE) {
if (file.exists("global.R")) {
if (warn != FALSE) {
warning("Attempting to load default configuration from global.R")
}
private$loadConfigurationGlobalR()
} else if (file.exists(".env.R")) {
if (warn != FALSE) {
warning("Attempting to load default configuration from .env.R")
}
private$loadConfigurationEnvR()
} else {
FALSE
}
}

View File

@@ -1,114 +0,0 @@
conn <- NULL
#' @name DBConnection$connect
#' @title DBConnection$connect
#' @description
#' Attempts to connect to the database. If not already configured, will first
#' attempt to load the configuration.
#' @returns <logical> TRUE if connection was success, FALSE if it failed
NULL
connect <- function() {
if (is.null(private$config)) {
if (!self$loadConfiguration(warn = TRUE)) {
return(FALSE)
}
}
engine_fn <- NULL
if (exists("engine", private$config) && length(private$config$engine) > 0) {
engine_fn <- switch(
private$config$engine,
mariadb = RMariaDB::MariaDB,
postgres = RPostgres::Postgres
)
}
if (is.null(engine_fn)) {
if (exists("schema", private$config)) {
engine_fn <- RPostgres::Postgres
} else {
engine_fn <- RMariaDB::MariaDB
}
}
private$conn <- DBI::dbConnect(
engine_fn(),
host = private$config$host,
port = private$config$port,
dbname = private$config$name,
user = private$config$user,
password = private$config$password
)
res <- tryCatch(
{
DBI::dbListTables(private$conn)
TRUE
},
error = function(err) {
print("Database error:")
utils::str(err)
FALSE
}
)
invisible(res)
}
#' @name DBConnection$getConnection
#' @title DBConnection$getConnection
#' @param do_connect <logical> Forcibly connect if not already connected
#' @description
#' Returns the DBConnection instance for this client.
#' @returns <DBConnection> DBConnection instance
NULL
getConnection <- function(do_connect = NULL) {
if (!self$isConnected()) {
if ((!is.null(do_connect) && do_connect)
|| (is.null(do_connect) && private$conn$autoconnect)) {
connect()
} else {
warning("Database is not connected. Caller of getConnection() may error.")
}
}
private$conn
}
#' @name DBConnection$isConnected
#' @title DBConnection$isConnected
#' @description
#' Indicates if the instance has an active database connection.
#' @returns <logical> TRUE if connected to the database, FALSE otherwise
NULL
isConnected <- function() {
!is.null(private$conn)
}
#' @name DBConnection$disconnect
#' @title DBConnection$disconnect
#' @description
#' Disconnects the current database connection, if connected.
NULL
disconnect <- function() {
if (!is.null(private$conn)) {
DBI::dbDisconnect(private$conn)
private$conn <- NULL
}
invisible(NULL)
}
#' @name DBConnection$disconnectOnSessionEnd
#' @title DBConnection$disconnectOnSessionEnd
#' @param session <complex> The R Shiny session to register the callback with
#' @description
#' Registers a callback with an R Shiny session so that the connection is
#' disconnected once the session ends.
#' @returns <function> A function to cancel the onSessionEnded callback
NULL
disconnectOnSessionEnd <- function(session) {
session$onSessionEnded(self$disconnect)
}

View File

@@ -1,22 +0,0 @@
token <- NULL
#' @name DBConnection$initialize
#' @title DBConnection$initialize
#' @aliases DBConnection$initialize
#' @description
#' Initalises the DBConnection instance with an identity token.
NULL
initialize <- function() {
private$token <- paste0(collapse = "", sample(c(LETTERS, 0:9), 16, TRUE))
}
#' @name DBConnection$getToken
#' @title DBConnection$getToken
#' @description
#' Returns the identity token for this DBConnection instance.
NULL
getToken <- function() {
private$token
}

View File

@@ -1,69 +0,0 @@
transactionLevel <- 0
#' @name DBConnection$beginTransaction
#' @title DBConnection$beginTransaction
#' @param session <complex> The R Shiny session to register the callback with
#' @description
#' Registers a callback with an R Shiny session so that the connection is
#' disconnected once the session ends.
#' @returns <function> A function to cancel the onSessionEnded callback
NULL
beginTransaction <- function(allowRecursive = FALSE, quietly = FALSE) {
if (private$transactionLevel > 0) {
if (allowRecursive == FALSE) {
if (quietly != FALSE) {
stop("Transaction already started. Aborting.")
}
return(FALSE)
}
}
private$transactionLevel <- private$transactionLevel + 1
DBI::dbBegin(self$getConnection())
}
#' @name DBConnection$rollbackTransaction
#' @title DBConnection$rollbackTransaction
#' @param session <complex> The R Shiny session to register the callback with
#' @description
#' Registers a callback with an R Shiny session so that the connection is
#' disconnected once the session ends.
#' @returns <function> A function to cancel the onSessionEnded callback
NULL
rollbackTransaction <- function(quietly = FALSE) {
if (private$transactionLevel == 0) {
if (quietly != FALSE) {
stop("No transaction to rollback. Aborting.")
}
return(FALSE)
}
DBI::dbRollback(self$getConnection())
}
#' @name DBConnection$commitTransaction
#' @title DBConnection$commitTransaction
#' @param quietly <logical> If there is no transaction, will cause a `stop()`
#' if TRUE
#' @description
#' Commits the current database transaction. If nested, will not actually commit
#' until the last level is committed.
#'
#' If `rollbackTransaction()`
#'
#' @returns <function> A function to cancel the onSessionEnded callback
NULL
commitTransaction <- function(quietly = FALSE) {
if (private$transactionLevel == 0) {
if (quietly != FALSE) {
stop("No transaction to commit. Aborting.")
}
return(FALSE)
}
private$transactionLevel <- private$transactionLevel - 1
if (transactionLevel > 0) {
return(TRUE)
}
DBI::dbCommit(self$getConnection())
}

View File

@@ -1,12 +1,13 @@
class_env <- new.env(parent = baseenv()) class_env <- new.env(parent = baseenv())
res <- lapply( res <- lapply(list.files("R/DBConnectionClass", pattern = ".R"), function(fn) {
list.files("R", pattern = "DBConnection-.*\\.R"), eval(
function(fn) { parse(paste0("R/DBConnectionClass/", fn)),
eval(parse(paste0("R/", fn)), envir = class_env, enclos = emptyenv()) envir = class_env,
} enclos = emptyenv()
) )
})
fn_names <- names(which(vapply(class_env, is.function, logical(1)))) fn_names <- names(which(vapply(class_env, is.function, logical(1))))
fn_list <- lapply(fn_names, function(fn_name) { fn_list <- lapply(fn_names, function(fn_name) {
@@ -29,12 +30,10 @@ names(member_list) <- member_names
#' @name DBConnection #' @name DBConnection
#' @title DBConnection #' @title DBConnection
#' @description #' @description Database Connection class
#' Database Connection class.
NULL NULL
#' @export #' @export
# nolint next: object_name_linter. R6Class
DBConnection <- R6::R6Class( DBConnection <- R6::R6Class(
"DBConnection", "DBConnection",
public = fn_list, public = fn_list,

View File

@@ -0,0 +1,68 @@
config <- NULL
.configureList <- function(db) {
was_connected <- FALSE
if (!is.null(private$conn)) {
was_connected <- TRUE
disconnect()
}
private$config <- db
if (was_connected) {
connect()
}
return(invisible(private$config))
}
.configureDefault <- function(
host, port, user, password, dbname,
engine = NULL, name = NULL, schema = NULL, autoconnect = NULL
) {
if (is.null(autoconnect)) {
autoconnect <- getOption("db.autoconnect", FALSE)
}
private$configureList(list(
engine = engine,
host = host,
port = port,
user = user,
password = password,
name = ifelse(is.null(name), dbname, name),
schema = schema,
autoconnect = autoconnect
))
}
#' Configures the DBClient instance.
#'
#' There are 2 options for configuration, either: pass in a named list; or use
#' named parameters. The required elements are:
#'
#' @param ... Named parameters for configuring the connection or a name list of
#' parameters
#' @param engine The database engine (mysql, postgres) as supported by DBI
#' @param host The database host
#' @param port The database port
#' @param user The database user to connect with
#' @param password The database password to connect with
#' @param dbname The database to use
#' @param schema The database schema to use (postgres)
#' @param autoconnect Autoconnect to the database if not already connected
#'
#' @return The configuration accepted
configure <- function(...) {
args <- list(...)
if (sum("list" %in% class(args[[1]])) > 0) {
private$configureList(args[[1]])
} else {
do.call(private$configureDefault, args)
}
}
#' Get the current configuration of the DBClient instance.
getConfiguration <- function() {
private$config
}

View File

@@ -0,0 +1,85 @@
conn <- NULL
connect <- function() {
if (is.null(private$config)) {
if (!file.exists("global.R")) {
return(FALSE)
}
warning("Attempting to load default configuration from global.R")
e <- new.env(parent = baseenv())
eval(parse("global.R"), envir = e)
if ("db" %in% ls(e)) {
self$configure(e$db)
} else if ("global" %in% ls(e)) {
self$configure(e$global$db)
} else {
return(FALSE)
}
}
engine_fn <- NULL
if (exists("engine", private$config) && length(private$config$engine) > 0) {
engine_fn <- switch(
private$config$engine,
mariadb = RMariaDB::MariaDB,
postgres = RPostgres::Postgres
)
}
if (is.null(engine_fn)) {
if (exists("schema", private$config)) {
engine_fn <- RPostgres::Postgres
} else {
engine_fn <- RMariaDB::MariaDB
}
}
private$conn <- DBI::dbConnect(
engine_fn(),
host = private$config$host,
port = private$config$port,
dbname = private$config$name,
user = private$config$user,
password = private$config$password
)
res <- tryCatch(
{
DBI::dbListTables(private$conn)
TRUE
},
error = function(err) {
print("Database error:")
utils::str(err)
return(FALSE)
}
)
return(res)
}
getConnection <- function(do_connect = NULL) {
if (!self$isConnected()) {
if ((!is.null(do_connect) && do_connect)
|| (is.null(do_connect) && private$conn$autoconnect)) {
connect()
} else {
warning("Database is not connected. Caller of getConnection() may error.")
}
}
return(private$conn)
}
isConnected <- function() {
return(!is.null(private$conn))
}
disconnect <- function() {
if (!is.null(private$conn)) {
DBI::dbDisconnect(private$conn)
private$conn <- NULL
}
}
disconnectOnSessionEnd <- function(session) {
session$onSessionEnded(self$disconnect)
}

View File

@@ -0,0 +1,39 @@
transactionLevel <- 0
beginTransaction <- function(allowRecursive = FALSE, quietly = FALSE) {
if (private$transactionLevel > 0) {
if (allowRecursive == FALSE) {
if (quietly != FALSE) {
stop("Transaction already started. Aborting.")
}
return(FALSE)
}
}
private$transactionLevel <- private$transactionLevel + 1
DBI::dbBegin(self$getConnection())
}
rollbackTransaction <- function(quietly = FALSE) {
if (private$transactionLevel == 0) {
if (quietly != FALSE) {
stop("No transaction to rollback. Aborting.")
}
return(FALSE)
}
DB::dbRollback(self$getConnection())
}
commitTransaction <- function(quietly = FALSE) {
if (private$transactionLevel == 0) {
if (quietly != FALSE) {
stop("No transaction to commit. Aborting.")
}
return(FALSE)
}
private$transactionLevel <- private$transactionLevel - 1
if (transactionLevel > 0) {
return(TRUE)
}
DB::dbRollback(self$getConnection())
}

View File

@@ -79,14 +79,19 @@ printDebug <- function(fn_name, table, key, tbl, rows, query_only = FALSE) {
} }
return_keys <- NULL return_keys <- NULL
if (!(key %in% colnames(rows))) { if (key %in% colnames(rows)) {
rows <- dplyr::mutate( return_keys <- rows |>
dplyr::bind_rows(rows, tibble::tibble(!!key := character(0))), dplyr::select(key)
!!key := dplyr::coalesce( } else {
!!!dplyr::sym(key), return_keys <- rows |>
paste0("<<NEW_ID::", round(stats::runif(1, 1, 100000)), ">>") dplyr::bind_rows(tibble::tibble(!!key := character(0))) |>
) dplyr::mutate(
) !!key := dplyr::coalesce(
!!!dplyr::sym(key),
paste0("<<NEW_ID::", round(stats::runif(1, 1, 100000)), ">>")
)
) |>
dplyr::select(key)
} }
invisible(dplyr::select(rows, key)) return(invisible(return_keys))
} }

View File

@@ -1,8 +0,0 @@
if (getRversion() >= "2.15.1") utils::globalVariables(c("self"))
if (getRversion() >= "2.15.1") utils::globalVariables(c("private"))
#' @importFrom rlang :=
#' @importFrom rlang .data
#' @importFrom R6 R6Class
#' @import R6
NULL

View File

@@ -1,30 +0,0 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/DBClient-dbCollect.R
\name{DBClient$collectGeometries}
\alias{DBClient$collectGeometries}
\title{DBClient$collectGeometries}
\arguments{
\item{qry}{\if{html}{\out{<complex>}} The query to collect}
\item{geometry_cols}{\if{html}{\out{<character>}} Any geometry columns to translate to sf}
\item{geometry_crs}{\if{html}{\out{<complex>}} The CRS to assign to the columns. Either
specified by the CRS number or an sf::st_crs() object.}
\item{check_ring_dir}{\if{html}{\out{<logical>}} Check the direction of rings during the
translation. See \code{sf::st_as_sfc} for further details.}
}
\value{
\if{html}{\out{<complex>}} The collected query with translated geometry columns
}
\description{
Requires sf package.
Runs dplyr::collect on a query, If there are gemoetry columns (specified by
gemoetry_cols or named geom or named proj) then they are translated into sf
geometry columns using sf::st_as_sfc with a CRS.
The default CRS for a column named \code{geom} is 4326.
The default CRS for a column named \code{proj} is 3035.
The default CRS for other geometry columns is specified by \code{geometry_crs}
}

View File

@@ -1,18 +0,0 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/DBClient-dbCollect.R
\name{DBClient$collectOrReturn}
\alias{DBClient$collectOrReturn}
\title{DBClient$collectOrReturn}
\arguments{
\item{qry}{\if{html}{\out{<character>}} A dplyr query}
\item{collect}{\if{html}{\out{<logical>}} Collect the query. Defaults to checking parent frame
for the parameter value}
}
\value{
\if{html}{\out{<complex>}} The query, optionally collect'd
}
\description{
Utility method which returns the query and optionally runs dplyr::collect on
it first.
}

View File

@@ -1,14 +0,0 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/DBClient-dbAction.R
\name{DBClient$dbAction}
\alias{DBClient$dbAction}
\title{DBClient$dbAction}
\arguments{
\item{statement}{\if{html}{\out{<character>}} Statement to run}
}
\value{
\if{html}{\out{<logical>}} TRUE if the execution was successful, FALSE if not
}
\description{
Executes a query/statement on a database which has no result
}

View File

@@ -1,14 +0,0 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/DBClient-dbQuery.R
\name{DBClient$dbQuery}
\alias{DBClient$dbQuery}
\title{DBClient$dbQuery}
\arguments{
\item{statement}{\if{html}{\out{<character>}} Query to run on the database}
}
\value{
\if{html}{\out{<complex>}} A lazy data table with the results from the query
}
\description{
Runs a query (statement) on a database and returns the results
}

View File

@@ -1,16 +0,0 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/DBClient-dbSchema.R
\name{DBClient$dplyrWithSchema}
\alias{DBClient$dplyrWithSchema}
\title{DBClient$dplyrWithSchema}
\arguments{
\item{table_name}{\if{html}{\out{<character>}} Table name to prefix schema to}
}
\value{
\if{html}{\out{<character>}} Table name with prefixed schema
}
\description{
Prefixes schema to the table name, if set in the configuration. Specifically
uses the dbplyr::in_schema method rather than the direct
DBI::dbQuoteIdentifier method.
}

View File

@@ -1,8 +0,0 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/DBClient-Initialize.R
\name{DBClient$getConnection}
\alias{DBClient$getConnection}
\title{DBClient$getConnection}
\description{
Returns the DBConnection instance for this client
}

View File

@@ -1,11 +0,0 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/DBClient-Initialize.R
\name{DBClient$initialize}
\alias{DBClient$initialize}
\title{DBClient$initialize}
\arguments{
\item{conn}{\if{html}{\out{<DBConnection>}} An instance of DBConnection}
}
\description{
Initalises the DBClient instance with a DBConnection
}

View File

@@ -1,14 +0,0 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/DBClient-dbTable.R
\name{DBClient$table}
\alias{DBClient$table}
\title{DBClient$table}
\arguments{
\item{table_name}{\if{html}{\out{<character>}} The database table name}
}
\value{
\if{html}{\out{<complex>}} A dplyr::tbl instance
}
\description{
Creates a \code{dplyr::tbl} instantiation with the current database connection.
}

View File

@@ -1,14 +0,0 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/DBClient-dbSchema.R
\name{DBClient$withSchema}
\alias{DBClient$withSchema}
\title{DBClient$withSchema}
\arguments{
\item{table_name}{\if{html}{\out{<character>}} Table name to prefix schema to}
}
\value{
\if{html}{\out{<character>}} Table name with prefixed schema
}
\description{
Prefixes schema to the table name, if set in the configuration.
}

View File

@@ -1,14 +0,0 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/DBClient-dbTransaction.R
\name{DBClient$withTransaction}
\alias{DBClient$withTransaction}
\title{DBClient$withTransaction}
\arguments{
\item{expr}{\if{html}{\out{<expression>}} Expression to run in a transaction}
}
\value{
\if{html}{\out{<logical>}} TRUE if transaction was successful
}
\description{
Runs a given expression within a database transaction.
}

View File

@@ -1,15 +0,0 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/DBConnection-Transaction.R
\name{DBConnection$beginTransaction}
\alias{DBConnection$beginTransaction}
\title{DBConnection$beginTransaction}
\arguments{
\item{session}{\if{html}{\out{<complex>}} The R Shiny session to register the callback with}
}
\value{
\if{html}{\out{<function>}} A function to cancel the onSessionEnded callback
}
\description{
Registers a callback with an R Shiny session so that the connection is
disconnected once the session ends.
}

View File

@@ -1,18 +0,0 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/DBConnection-Transaction.R
\name{DBConnection$commitTransaction}
\alias{DBConnection$commitTransaction}
\title{DBConnection$commitTransaction}
\arguments{
\item{quietly}{\if{html}{\out{<logical>}} If there is no transaction, will cause a \code{stop()}
if TRUE}
}
\value{
\if{html}{\out{<function>}} A function to cancel the onSessionEnded callback
}
\description{
Commits the current database transaction. If nested, will not actually commit
until the last level is committed.
If \code{rollbackTransaction()}
}

View File

@@ -1,18 +0,0 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/DBConnection-Configure.R
\name{DBConnection$configure}
\alias{DBConnection$configure}
\title{DBConnection$configure}
\arguments{
\item{...}{Named parameters for configuring the connection or a name list of
parameters}
}
\value{
\if{html}{\out{<list>}} The configuration that has loaded
}
\description{
Configures the DBClient instance.
There are 2 options for configuration, either: pass in a named list; or use
named parameters.
}

View File

@@ -1,12 +0,0 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/DBConnection-Connect.R
\name{DBConnection$connect}
\alias{DBConnection$connect}
\title{DBConnection$connect}
\value{
\if{html}{\out{<logical>}} TRUE if connection was success, FALSE if it failed
}
\description{
Attempts to connect to the database. If not already configured, will first
attempt to load the configuration.
}

View File

@@ -1,8 +0,0 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/DBConnection-Connect.R
\name{DBConnection$disconnect}
\alias{DBConnection$disconnect}
\title{DBConnection$disconnect}
\description{
Disconnects the current database connection, if connected.
}

View File

@@ -1,15 +0,0 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/DBConnection-Connect.R
\name{DBConnection$disconnectOnSessionEnd}
\alias{DBConnection$disconnectOnSessionEnd}
\title{DBConnection$disconnectOnSessionEnd}
\arguments{
\item{session}{\if{html}{\out{<complex>}} The R Shiny session to register the callback with}
}
\value{
\if{html}{\out{<function>}} A function to cancel the onSessionEnded callback
}
\description{
Registers a callback with an R Shiny session so that the connection is
disconnected once the session ends.
}

View File

@@ -1,11 +0,0 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/DBConnection-Configure.R
\name{DBConnection$getConfiguration}
\alias{DBConnection$getConfiguration}
\title{DBConnection$getConfiguration}
\value{
\if{html}{\out{<list>}} Current configuration. If not configured, NULL is returned
}
\description{
Get the current configuration of the DBClient instance.
}

View File

@@ -1,14 +0,0 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/DBConnection-Connect.R
\name{DBConnection$getConnection}
\alias{DBConnection$getConnection}
\title{DBConnection$getConnection}
\arguments{
\item{do_connect}{\if{html}{\out{<logical>}} Forcibly connect if not already connected}
}
\value{
\if{html}{\out{<DBConnection>}} DBConnection instance
}
\description{
Returns the DBConnection instance for this client.
}

View File

@@ -1,8 +0,0 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/DBConnection-Initialize.R
\name{DBConnection$getToken}
\alias{DBConnection$getToken}
\title{DBConnection$getToken}
\description{
Returns the identity token for this DBConnection instance.
}

View File

@@ -1,8 +0,0 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/DBConnection-Initialize.R
\name{DBConnection$initialize}
\alias{DBConnection$initialize}
\title{DBConnection$initialize}
\description{
Initalises the DBConnection instance with an identity token.
}

View File

@@ -1,11 +0,0 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/DBConnection-Connect.R
\name{DBConnection$isConnected}
\alias{DBConnection$isConnected}
\title{DBConnection$isConnected}
\value{
\if{html}{\out{<logical>}} TRUE if connected to the database, FALSE otherwise
}
\description{
Indicates if the instance has an active database connection.
}

View File

@@ -1,14 +0,0 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/DBConnection-Configure.R
\name{DBConnection$loadConfiguration}
\alias{DBConnection$loadConfiguration}
\title{DBConnection$loadConfiguration}
\arguments{
\item{warn}{Emit a warning with which file it attempting to be loaded}
}
\value{
\if{html}{\out{<logical>}} TRUE if configuration was successful, FALSE otherwise
}
\description{
Attempts to load the configuration either from global.R or .env.R.
}

View File

@@ -1,15 +0,0 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/DBConnection-Transaction.R
\name{DBConnection$rollbackTransaction}
\alias{DBConnection$rollbackTransaction}
\title{DBConnection$rollbackTransaction}
\arguments{
\item{session}{\if{html}{\out{<complex>}} The R Shiny session to register the callback with}
}
\value{
\if{html}{\out{<function>}} A function to cancel the onSessionEnded callback
}
\description{
Registers a callback with an R Shiny session so that the connection is
disconnected once the session ends.
}

View File

@@ -4,5 +4,5 @@
\alias{DBConnection} \alias{DBConnection}
\title{DBConnection} \title{DBConnection}
\description{ \description{
Database Connection class. Database Connection class
} }

View File

@@ -1,44 +0,0 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/DBConnection-Configure.R
\name{.configureDefault}
\alias{.configureDefault}
\title{Configures the DBClient instance.}
\usage{
.configureDefault(
host,
port,
user,
password,
dbname,
engine = NULL,
name = NULL,
schema = NULL,
autoconnect = NULL
)
}
\arguments{
\item{host}{The database host}
\item{port}{The database port}
\item{user}{The database user to connect with}
\item{password}{The database password to connect with}
\item{dbname}{The database to use}
\item{engine}{The database engine (mysql, postgres) as supported by DBI}
\item{name}{The database to use (alternative to dbname)}
\item{schema}{The database schema to use (postgres)}
\item{autoconnect}{Autoconnect to the database if not already connected}
}
\value{
The configuration accepted
}
\description{
There are 2 options for configuration, either: pass in a named list; or use
named parameters.
}