inst/doc/DBI-advanced.R

In DBI: R Database Interface

## ----setup, include=FALSE-----------------------------------------------------
library(knitr)
opts_chunk$set(
  echo = TRUE,
  error = Sys.getenv("IN_PKGDOWN") != "true" || (getRversion() < "3.5")
)

knit_print.data.frame <- function(x, ...) {
  print(head(x, 3))
  if (nrow(x) > 3) {
    cat("Showing 3 out of", nrow(x), "rows.\n")
  }
  invisible(x)
}

registerS3method("knit_print", "data.frame", "knit_print.data.frame")

## -----------------------------------------------------------------------------
library(DBI)

con <- dbConnect(
  RMariaDB::MariaDB(),
  host = "db.relational-data.org",
  port = 3306,
  username = "guest",
  password = "relational",
  dbname = "sakila"
)

res <- dbSendQuery(con, "SELECT * FROM film WHERE rating = 'G'")
df <- dbFetch(res, n = 3)
dbClearResult(res)

head(df, 3)

## -----------------------------------------------------------------------------
res <- dbSendQuery(con, "SELECT * FROM film")
while (!dbHasCompleted(res)) {
  chunk <- dbFetch(res, n = 300)
  print(nrow(chunk))
}
dbClearResult(res)

## ----quote--------------------------------------------------------------------

safe_id <- dbQuoteIdentifier(con, "rating")
safe_param <- dbQuoteLiteral(con, "G")

query <- paste0("SELECT title, ", safe_id, " FROM film WHERE ", safe_id, " = ", safe_param)
query

res <- dbSendQuery(con, query)
dbFetch(res)
dbClearResult(res)

## -----------------------------------------------------------------------------
id <- "rating"
param <- "G"
query <- glue::glue_sql("SELECT title, {`id`} FROM film WHERE {`id`} = {param}", .con = con)

df <- dbGetQuery(con, query)
head(df, 3)

## ----params-------------------------------------------------------------------
params <- list("G")
safe_id <- dbQuoteIdentifier(con, "rating")

query <- paste0("SELECT * FROM film WHERE ", safe_id, " = ?")
query

res <- dbSendQuery(con, query, params = params)
dbFetch(res, n = 3)
dbClearResult(res)

## ----multi-param--------------------------------------------------------------
q_params <- list("G", 90)
query <- "SELECT title, rating, length FROM film WHERE rating = ? AND length >= ?"

res <- dbSendQuery(con, query, params = q_params)
dbFetch(res, n = 3)
dbClearResult(res)

## ----dbbind-------------------------------------------------------------------
res <- dbSendQuery(con, "SELECT * FROM film WHERE rating = ?")
dbBind(res, list("G"))
dbFetch(res, n = 3)
dbBind(res, list("PG"))
dbFetch(res, n = 3)
dbClearResult(res)

## ----bind_quotestring---------------------------------------------------------
res <- dbSendQuery(con, "SELECT * FROM film WHERE rating = ?")
dbBind(res, list(c("G", "PG")))
dbFetch(res, n = 3)
dbClearResult(res)

## ----bind-multi-param---------------------------------------------------------
q_params <- list(c("G", "PG"), c(90, 120))
query <- "SELECT title, rating, length FROM film WHERE rating = ? AND length >= ?"

res <- dbSendQuery(con, query, params = q_params)
dbFetch(res, n = 3)
dbClearResult(res)

## ----disconnect---------------------------------------------------------------
dbDisconnect(con)

## -----------------------------------------------------------------------------
library(DBI)
con <- dbConnect(RSQLite::SQLite(), ":memory:")

dbWriteTable(con, "cars", head(cars, 3))

dbExecute(
  con,
  "INSERT INTO cars (speed, dist) VALUES (1, 1), (2, 2), (3, 3)"
)

rs <- dbSendStatement(
  con,
  "INSERT INTO cars (speed, dist) VALUES (4, 4), (5, 5), (6, 6)"
)
dbGetRowsAffected(rs)
dbClearResult(rs)

dbReadTable(con, "cars")

## -----------------------------------------------------------------------------
dbDisconnect(con)

## -----------------------------------------------------------------------------
con <- dbConnect(RSQLite::SQLite(), ":memory:")

dbWriteTable(con, "cash", data.frame(amount = 100))
dbWriteTable(con, "account", data.frame(amount = 2000))

withdraw <- function(amount) {
  # All operations must be carried out as logical unit:
  dbExecute(con, "UPDATE cash SET amount = amount + ?", list(amount))
  dbExecute(con, "UPDATE account SET amount = amount - ?", list(amount))
}

withdraw_transacted <- function(amount) {
  # Ensure atomicity
  dbBegin(con)

  # Perform operation
  withdraw(amount)

  # Persist results
  dbCommit(con)
}

withdraw_transacted(300)

## -----------------------------------------------------------------------------
dbReadTable(con, "cash")
dbReadTable(con, "account")

## -----------------------------------------------------------------------------
withdraw_if_funds <- function(amount) {
  dbBegin(con)
  withdraw(amount)
  # Rolling back after detecting negative value on account:
  if (dbReadTable(con, "account")$amount >= 0) {
    dbCommit(con)
    TRUE
  } else {
    message("Insufficient funds")
    dbRollback(con)
    FALSE
  }
}

withdraw_if_funds(5000)
dbReadTable(con, "cash")
dbReadTable(con, "account")

## ----error = TRUE-------------------------------------------------------------
withdraw_safely <- function(amount) {
  dbWithTransaction(con, {
    withdraw(amount)
    if (dbReadTable(con, "account")$amount < 0) {
      stop("Error: insufficient funds", call. = FALSE)
    }
  })
}

withdraw_safely(5000)
dbReadTable(con, "cash")
dbReadTable(con, "account")

## -----------------------------------------------------------------------------
dbDisconnect(con)