R/tcl-dbtools.R

In tjpalanca/dbtools: Database Tools for R

#' @export
transact.dbtools <- function(object, ...) {

  tbl_db <- get_tbl_db(object)

  if (!in_transaction(tbl_db)) {
    begin(tbl_db)
  } else {
    tbl_db
  }

}

#' @export
begin.dbtools <- function(object, ...) {

  tbl_db <- get_tbl_db(object)

  # Create a new connection
  tbl_db$old <- tbl_db$src
  tbl_db$src <- src_dbi(dbClone(tbl_db$old$con))

  # Start a new transaction with it
  dbBegin(get_tbl_db_conn(tbl_db), ...)

  return(tbl_db)

}

#' @export
commit.dbtools <- function(object, ...) {

  tbl_db <- get_tbl_db(object)

  # Commit the transaction
  dbCommit(get_tbl_db_conn(tbl_db), ...)

  # Restore the old connection
  dbxDisconnect(get_tbl_db_conn(tbl_db))
  tbl_db$src <- tbl_db$old
  tbl_db$old <- NULL

  return(tbl_db)

}

#' @export
rollback.dbtools <- function(object, ...) {

  tbl_db <- get_tbl_db(object)

  # Rollback the transaction
  dbRollback(get_tbl_db_conn(tbl_db), ...)

  # Restore the old connection
  dbxDisconnect(get_tbl_db_conn(tbl_db))
  tbl_db$src <- tbl_db$old
  tbl_db$old <- NULL

  return(tbl_db)

}

#' @export
in_transaction.dbtools <- function(object, ...) {

  tbl_db <- get_tbl_db(object)

  !is.null(tbl_db$old) &&
    dbInTransaction(get_tbl_db_conn(tbl_db), ...)

}