Skip to content

Commit

Permalink
Merge pull request #216 from hannesmuehleisen/master
Browse files Browse the repository at this point in the history 
- `sqlInterpolate()` now supports both named and positional variables (#216, @hannesmuehleisen).
  • Loading branch information
@krlmlr
krlmlr authored Jan 25, 2018
2 parents d4fe97d + 30b72dd commit 6c60f51
Show file tree
Hide file tree
Showing 2 changed files with 78 additions and 46 deletions.
91 changes: 52 additions & 39 deletions R/interpolate.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -35,11 +35,26 @@ setMethod("sqlInterpolate", "DBIConnection", function(conn, sql, ..., .dots = li
return(SQL(sql))

vars <- substring(sql, pos$start + 1, pos$end)
positional_vars <- pos$start == pos$end
if (all(positional_vars) != any(positional_vars)) {
stop("Can't mix positional (?) and named (?asdf) variables", call. = FALSE)
}

values <- c(list(...), .dots)
if (!setequal(vars, names(values))) {
stop("Supplied vars don't match vars to interpolate", call. = FALSE)
if (all(positional_vars)) {
if (length(vars) != length(values)) {
stop("Supplied values don't match positional vars to interpolate", call. = FALSE)
}
if (any(names(values) != "")) {
stop("Positional variables don't take named arguments")
}
}
else {
if (!setequal(vars, names(values))) {
stop("Supplied values don't match named vars to interpolate", call. = FALSE)
}
values <- values[vars]
}
values <- values[vars]

safe_values <- vapply(values, function(x) {
if (is.character(x)) {
Expand Down Expand Up @@ -110,13 +125,13 @@ setMethod("sqlParseVariables", "DBIConnection", function(conn, sql, ...) {
#' @export
#' @rdname sqlParseVariables
sqlCommentSpec <- function(start, end, endRequired) {
list(start, end, endRequired)
list(start=start, end=end, endRequired=endRequired)
}

#' @export
#' @rdname sqlParseVariables
sqlQuoteSpec <- function(start, end, escape = "", doubleEscape = TRUE) {
list(start, end, escape, doubleEscape)
list(start=start, end=end, escape=escape, doubleEscape=doubleEscape)
}

#' @export
Expand All @@ -127,7 +142,9 @@ sqlQuoteSpec <- function(start, end, escape = "", doubleEscape = TRUE) {
#' @param comments A list of `CommentSpec` calls defining the commenting
#' specification.
sqlParseVariablesImpl <- function(sql, quotes, comments) {
sql_arr <- c(strsplit(as.character(sql), "", fixed = TRUE)[[1]], " ")
str_to_vec <- function(s) strsplit(s, "", fixed = TRUE)[[1L]]

sql_arr <- c(str_to_vec(as.character(sql)), " ")

# characters valid in variable names
var_chars <- c(LETTERS, letters, 0:9, "_")
Expand All @@ -143,82 +160,78 @@ sqlParseVariablesImpl <- function(sql, quotes, comments) {

# prepare comments & quotes for quicker comparisions
for(c in seq_along(comments)) {
comments[[c]][[1]] <- strsplit(comments[[c]][[1]], "", fixed = TRUE)[[1]]
comments[[c]][[2]] <- strsplit(comments[[c]][[2]], "", fixed = TRUE)[[1]]
comments[[c]][["start"]] <- str_to_vec(comments[[c]][["start"]])
comments[[c]][["end"]] <- str_to_vec(comments[[c]][["end"]])
}
for(q in seq_along(quotes)) {
quotes[[q]][[5]] <- nchar(quotes[[q]][[3]]) > 0L
quotes[[q]][["hasEscape"]] <- nchar(quotes[[q]][["escape"]]) > 0L
}

state <- 'default'
i <- 0
state <- "default"
i <- 0L
while(i < length(sql_arr)) {
i <- i + 1
i <- i + 1L
switch(state,

default = {
# variable?
# variable
if (sql_arr[[i]] == "?") {
sql_variable_start <- i
state <- 'variable'
state <- "variable"
next
}
# starting quoted area?
# starting quoted area
for(q in seq_along(quotes)) {
if (identical(sql_arr[[i]], quotes[[q]][[1]])) {
if (identical(sql_arr[[i]], quotes[[q]][["start"]])) {
quote_spec_offset <- q
state <- 'quote'
state <- "quote"
break
}
}
# we can abort here if the state has changed
if (state != 'default') next
# starting comment?
if (state != "default") next
# starting comment
for(c in seq_along(comments)) {
comment_start_arr <- comments[[c]][[1]]
comment_start_arr <- comments[[c]][["start"]]
comment_start_length <- length(comment_start_arr)
if (identical(sql_arr[i:(i + comment_start_length - 1)], comment_start_arr)) {
if (identical(sql_arr[i:(i + comment_start_length - 1L)], comment_start_arr)) {
comment_spec_offset <- c
i <- i + comment_start_length
state <- 'comment'
state <- "comment"
break
}
}
},

variable = {
if (!(sql_arr[[i]] %in% var_chars)) {
# make sure variable has at least one character after the '?'
if (i - sql_variable_start < 2) {
stop("Length 0 variable")
}
# append current variable offsets to return vectors
var_pos_start <- c(var_pos_start, sql_variable_start)
var_pos_end <- c(var_pos_end, i - 1)
# we have already read too much, go back
i <- i - 1
state <- 'default'
i <- i - 1L
var_pos_end <- c(var_pos_end, i)
state <- "default"
}
},

quote = {
# if we see backslash-like escapes, ignore next character
if (quotes[[quote_spec_offset]][[5]] && identical(sql_arr[[i]], quotes[[quote_spec_offset]][[3]])) {
i <- i + 1
if (quotes[[quote_spec_offset]][["hasEscape"]] && identical(sql_arr[[i]], quotes[[quote_spec_offset]][[3]])) {
i <- i + 1L
next
}
# end quoted area?
if (identical(sql_arr[[i]], quotes[[quote_spec_offset]][[2]])) {
# end quoted area
if (identical(sql_arr[[i]], quotes[[quote_spec_offset]][["end"]])) {
quote_spec_offset <- 0L
state <- 'default'
state <- "default"
}
},

comment = {
# end commented area?
comment_end_arr <- comments[[comment_spec_offset]][[2]]
# end commented area
comment_end_arr <- comments[[comment_spec_offset]][["end"]]
comment_end_length <- length(comment_end_arr)
if (identical(sql_arr[i:(i + comment_end_length - 1)], comment_end_arr)) {
if (identical(sql_arr[i:(i + comment_end_length - 1L)], comment_end_arr)) {
i <- i + comment_end_length
comment_spec_offset <- 0L
state <- 'default'
Expand All @@ -230,8 +243,8 @@ sqlParseVariablesImpl <- function(sql, quotes, comments) {
if (quote_spec_offset > 0L) {
stop("Unterminated literal")
}
if (comment_spec_offset > 0L && comments[[comment_spec_offset]][[3]]) {
if (comment_spec_offset > 0L && comments[[comment_spec_offset]][["endRequired"]]) {
stop("Unterminated comment")
}
list(start = as.integer(var_pos_start), end = as.integer(var_pos_end))
list(start = var_pos_start, end = var_pos_end)
}
33 changes: 26 additions & 7 deletions tests/testthat/test-interpolate.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -24,15 +24,34 @@ test_that("parameter names matched", {

test_that("parameters in strings are ignored", {
expect_equal(
sqlInterpolate(ANSI(), "'?a'"),
SQL("'?a'")
sqlInterpolate(ANSI(), "'? ?fuu'"),
SQL("'? ?fuu'")
)
})

test_that("named parameters check matches", {
expect_error(
sqlInterpolate(ANSI(), "?a ?b", a=1, d=2)
, "Supplied values don't match named vars to interpolate")
})

test_that("positional parameters work", {
expect_equal(
sqlInterpolate(ANSI(), "a ? c ? d ", 1, 2),
SQL("a 1 c 2 d ")
)
})

test_that("positional parameters can't have names", {
expect_error(
sqlInterpolate(ANSI(), "? ?", a=1, 2)
, "Positional variables don't take named arguments")
})

test_that("parameters in comments are ignored", {
expect_equal(
sqlInterpolate(ANSI(), "-- ?a"),
SQL("-- ?a")
sqlInterpolate(ANSI(), "-- ? ?fuu"),
SQL("-- ? ?fuu")
)
})

Expand All @@ -45,8 +64,8 @@ test_that("strings are quoted", {

test_that("some more complex case works as well", {
expect_equal(
sqlInterpolate(ANSI(), "asdf ?faa /*fdsa'zsc' */ qwer 'wer' \"bnmvbn\" -- Zc \n '234' ?fuu -- ?bar", faa = "abc", fuu=42L),
SQL("asdf 'abc' /*fdsa'zsc' */ qwer 'wer' \"bnmvbn\" -- Zc \n '234' 42 -- ?bar")
sqlInterpolate(ANSI(), "asdf ?faa /*fdsa'zsc' */ qwer 'wer' \"bnmvbn\" -- Zc \n '234' ?fuu -- ? ?bar", faa = "abc", fuu=42L),
SQL("asdf 'abc' /*fdsa'zsc' */ qwer 'wer' \"bnmvbn\" -- Zc \n '234' 42 -- ? ?bar")
)
})

Expand All @@ -64,7 +83,7 @@ test_that("corner cases work", {
)
expect_error(
sqlInterpolate(ANSI(), "?"),
"Length 0 variable"
"Supplied values don't match positional vars to interpolate"
)
expect_equal(
sqlInterpolate(ANSI(), "?a", a = 1),
Expand Down

0 comments on commit 6c60f51

Please sign in to comment.