1#' Interpolate strings with SQL escaping 2#' 3#' SQL databases often have custom quotation syntax for identifiers and strings 4#' which make writing SQL queries error prone and cumbersome to do. `glue_sql()` and 5#' `glue_data_sql()` are analogs to [glue()] and [glue_data()] which handle the 6#' SQL quoting. `glue_sql_collapse()` can be used to collapse [DBI::SQL()] objects. 7#' 8#' They automatically quote character results, quote identifiers if the glue 9#' expression is surrounded by backticks '\verb{`}' and do not quote 10#' non-characters such as numbers. If numeric data is stored in a character 11#' column (which should be quoted) pass the data to `glue_sql()` as a 12#' character. 13#' 14#' Returning the result with [DBI::SQL()] will suppress quoting if desired for 15#' a given value. 16#' 17#' Note [parameterized queries](https://db.rstudio.com/best-practices/run-queries-safely#parameterized-queries) 18#' are generally the safest and most efficient way to pass user defined 19#' values in a query, however not every database driver supports them. 20#' 21#' If you place a `*` at the end of a glue expression the values will be 22#' collapsed with commas. This is useful for the [SQL IN Operator](https://www.w3schools.com/sql/sql_in.asp) 23#' for instance. 24#' @inheritParams glue 25#' @seealso [glue_sql_collapse()] to collapse [DBI::SQL()] objects. 26#' @param .con \[`DBIConnection`]:A DBI connection object obtained from [DBI::dbConnect()]. 27#' @return A [DBI::SQL()] object with the given query. 28#' @examples 29#' con <- DBI::dbConnect(RSQLite::SQLite(), ":memory:") 30#' iris2 <- iris 31#' colnames(iris2) <- gsub("[.]", "_", tolower(colnames(iris))) 32#' DBI::dbWriteTable(con, "iris", iris2) 33#' var <- "sepal_width" 34#' tbl <- "iris" 35#' num <- 2 36#' val <- "setosa" 37#' glue_sql(" 38#' SELECT {`var`} 39#' FROM {`tbl`} 40#' WHERE {`tbl`}.sepal_length > {num} 41#' AND {`tbl`}.species = {val} 42#' ", .con = con) 43#' 44#' # If sepal_length is store on the database as a character explicitly convert 45#' # the data to character to quote appropriately. 46#' glue_sql(" 47#' SELECT {`var`} 48#' FROM {`tbl`} 49#' WHERE {`tbl`}.sepal_length > {as.character(num)} 50#' AND {`tbl`}.species = {val} 51#' ", .con = con) 52#' 53#' 54#' # `glue_sql()` can be used in conjuction with parameterized queries using 55#' # `DBI::dbBind()` to provide protection for SQL Injection attacks 56#' sql <- glue_sql(" 57#' SELECT {`var`} 58#' FROM {`tbl`} 59#' WHERE {`tbl`}.sepal_length > ? 60#' ", .con = con) 61#' query <- DBI::dbSendQuery(con, sql) 62#' DBI::dbBind(query, list(num)) 63#' DBI::dbFetch(query, n = 4) 64#' DBI::dbClearResult(query) 65#' 66#' # `glue_sql()` can be used to build up more complex queries with 67#' # interchangeable sub queries. It returns `DBI::SQL()` objects which are 68#' # properly protected from quoting. 69#' sub_query <- glue_sql(" 70#' SELECT * 71#' FROM {`tbl`} 72#' ", .con = con) 73#' 74#' glue_sql(" 75#' SELECT s.{`var`} 76#' FROM ({sub_query}) AS s 77#' ", .con = con) 78#' 79#' # If you want to input multiple values for use in SQL IN statements put `*` 80#' # at the end of the value and the values will be collapsed and quoted appropriately. 81#' glue_sql("SELECT * FROM {`tbl`} WHERE sepal_length IN ({vals*})", 82#' vals = 1, .con = con) 83#' 84#' glue_sql("SELECT * FROM {`tbl`} WHERE sepal_length IN ({vals*})", 85#' vals = 1:5, .con = con) 86#' 87#' glue_sql("SELECT * FROM {`tbl`} WHERE species IN ({vals*})", 88#' vals = "setosa", .con = con) 89#' 90#' glue_sql("SELECT * FROM {`tbl`} WHERE species IN ({vals*})", 91#' vals = c("setosa", "versicolor"), .con = con) 92#' 93#' # If you need to reference variables from multiple tables use `DBI::Id()`. 94#' # Here we create a new table of nicknames, join the two tables together and 95#' # select columns from both tables. Using `DBI::Id()` and the special 96#' # `glue_sql()` syntax ensures all the table and column identifiers are quoted 97#' # appropriately. 98#' 99#' iris_db <- "iris" 100#' nicknames_db <- "nicknames" 101#' 102#' nicknames <- data.frame( 103#' species = c("setosa", "versicolor", "virginica"), 104#' nickname = c("Beachhead Iris", "Harlequin Blueflag", "Virginia Iris"), 105#' stringsAsFactors = FALSE 106#' ) 107#' 108#' DBI::dbWriteTable(con, nicknames_db, nicknames) 109#' 110#' cols <- list( 111#' DBI::Id(table = iris_db, column = "sepal_length"), 112#' DBI::Id(table = iris_db, column = "sepal_width"), 113#' DBI::Id(table = nicknames_db, column = "nickname") 114#' ) 115#' 116#' iris_species <- DBI::Id(table = iris_db, column = "species") 117#' nicknames_species <- DBI::Id(table = nicknames_db, column = "species") 118#' 119#' query <- glue_sql(" 120#' SELECT {`cols`*} 121#' FROM {`iris_db`} 122#' JOIN {`nicknames_db`} 123#' ON {`iris_species`}={`nicknames_species`}", 124#' .con = con 125#' ) 126#' query 127#' 128#' DBI::dbGetQuery(con, query, n = 5) 129#' 130#' DBI::dbDisconnect(con) 131#' @export 132glue_sql <- function(..., .con, .envir = parent.frame(), .na = DBI::SQL("NULL")) { 133 DBI::SQL(glue(..., .envir = .envir, .na = .na, .transformer = sql_quote_transformer(.con, .na))) 134} 135 136#' @rdname glue_sql 137#' @export 138glue_data_sql <- function(.x, ..., .con, .envir = parent.frame(), .na = DBI::SQL("NULL")) { 139 DBI::SQL(glue_data(.x, ..., .envir = .envir, .na = .na, .transformer = sql_quote_transformer(.con, .na))) 140} 141 142#' @rdname glue_collapse 143#' @export 144glue_sql_collapse <- function(x, sep = "", width = Inf, last = "") { 145 DBI::SQL(glue_collapse(x, sep = sep, width = width, last = last)) 146} 147 148sql_quote_transformer <- function(connection, .na) { 149 if (is.null(.na)) { 150 .na <- DBI::SQL(NA) 151 } 152 153 function(text, envir) { 154 should_collapse <- grepl("[*][[:space:]]*$", text) 155 if (should_collapse) { 156 text <- sub("[*][[:space:]]*$", "", text) 157 } 158 m <- gregexpr("^`|`$", text) 159 is_quoted <- any(m[[1]] != -1) 160 if (is_quoted) { 161 regmatches(text, m) <- "" 162 res <- eval(parse(text = text, keep.source = FALSE), envir) 163 164 if (length(res) == 1) { 165 res <- DBI::dbQuoteIdentifier(conn = connection, res) 166 } else { 167 168 # Support lists as well 169 res[] <- lapply(res, DBI::dbQuoteIdentifier, conn = connection) 170 } 171 } else { 172 res <- eval(parse(text = text, keep.source = FALSE), envir) 173 if (inherits(res, "SQL")) { 174 if (should_collapse) { 175 res <- glue_collapse(res, ", ") 176 } 177 if (length(res) == 0L) { 178 res <- DBI::SQL("NULL") 179 } 180 return(res) 181 } 182 183 # convert objects to characters 184 is_object <- is.object(res) 185 if (is_object) { 186 res <- as.character(res) 187 } 188 189 is_na <- is.na(res) 190 if (any(is_na)) { 191 res[is_na] <- rep(list(.na), sum(is_na)) 192 } 193 194 is_char <- vapply(res, function(x) !is.na(x) && is.character(x), logical(1)) 195 res[is_char] <- lapply(res[is_char], function(x) DBI::dbQuoteLiteral(conn = connection, x)) 196 res[!is_char] <- lapply(res[!is_char], function(x) DBI::SQL(conn = connection, x)) 197 } 198 if (should_collapse) { 199 res <- glue_collapse(res, ", ") 200 } 201 if (length(res) == 0L) { 202 res <- DBI::SQL("NULL") 203 } 204 res 205 } 206} 207