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