From c8668afbc89e352d9dbeb802a9109d5b94567b0b Mon Sep 17 00:00:00 2001 From: Anne-Wil Date: Tue, 17 May 2022 14:50:03 +0200 Subject: [PATCH 1/5] Update engine.R add initial attempt at SQL chunk option immediate --- R/engine.R | 58 ++++++++++++++++++++++++++++-------------------------- 1 file changed, 30 insertions(+), 28 deletions(-) diff --git a/R/engine.R b/R/engine.R index 3a92b0d2e7..1daa94390a 100644 --- a/R/engine.R +++ b/R/engine.R @@ -560,13 +560,14 @@ is_sql_update_query = function(query) { grepl('^\\s*(INSERT|UPDATE|DELETE|CREATE|DROP).*', query, ignore.case = TRUE) } + # sql engine eng_sql = function(options) { # return chunk before interpolation eagerly to avoid connection option check if (isFALSE(options$eval) && !isTRUE(options$sql.show_interpolated)) { return(engine_output(options, options$code, '')) } - + # Return char vector of sql interpolation param names varnames_from_sql = function(conn, sql) { varPos = DBI::sqlParseVariables(conn, sql) @@ -575,12 +576,12 @@ eng_sql = function(options) { sub('^\\?', '', varNames) } } - + # Vectorized version of exists mexists = function(x, env = knit_global(), inherits = TRUE) { vapply(x, exists, logical(1), where = env, inherits = inherits) } - + # Interpolate a sql query based on the variables in an environment interpolate_from_env = function(conn, sql, env = knit_global(), inherits = TRUE) { names = unique(varnames_from_sql(conn, sql)) @@ -588,14 +589,14 @@ eng_sql = function(options) { if (length(names_missing) > 0) { stop("Object(s) not found: ", paste('"', names_missing, '"', collapse = ", ")) } - + args = if (length(names) > 0) setNames( mget(names, envir = env, inherits = inherits), names ) - + do.call(DBI::sqlInterpolate, c(list(conn, sql), args)) } - + # extract options conn = options$connection if (is.character(conn)) conn = get(conn, envir = knit_global()) @@ -608,13 +609,14 @@ eng_sql = function(options) { max.print = -1 sql = one_string(options$code) params = options$params - + imm = options$immediate + query = interpolate_from_env(conn, sql) if (isFALSE(options$eval)) return(engine_output(options, query, '')) - + data = tryCatch({ if (is_sql_update_query(query)) { - DBI::dbExecute(conn, query) + DBI::dbExecute(conn, query, immediate = imm) NULL } else if (is.null(varname) && max.print > 0) { # execute query -- when we are printing with an enforced max.print we @@ -623,50 +625,50 @@ eng_sql = function(options) { data = DBI::dbFetch(res, n = max.print) DBI::dbClearResult(res) data - + } else { if (length(params) == 0) { - DBI::dbGetQuery(conn, query) + DBI::dbGetQuery(conn, query, immediate = imm) } else { # If params option is provided, parameters are not interplolated - DBI::dbGetQuery(conn, sql, params = params) + DBI::dbGetQuery(conn, sql, immediate = imm, params = params) } } }, error = function(e) { if (!options$error) stop(e) e }) - + if (inherits(data, "error")) return(engine_output(options, query, one_string(data))) - + # create output if needed (we have data and we aren't assigning it to a variable) output = if (length(dim(data)) == 2 && ncol(data) > 0 && is.null(varname)) capture.output({ - + # apply max.print to data display_data = if (max.print == -1) data else head(data, n = max.print) - + # get custom sql print function sql.print = opts_knit$get('sql.print') - + # use kable for markdown if (!is.null(sql.print)) { options$results = 'asis' cat(sql.print(data)) } else if (out_format('markdown')) { - + # we are going to output raw markdown so set results = 'asis' options$results = 'asis' - + # force left alignment if the first column is an incremental id column first_column = display_data[[1]] if (is.numeric(first_column) && length(first_column) > 1 && all(diff(first_column) == 1)) display_data[[1]] = as.character(first_column) - + # wrap html output in a div so special styling can be applied add_div = is_html_output() && getOption('knitr.sql.html_div', TRUE) if (add_div) cat('
\n') - + # determine records caption caption = options$tab.cap if (is.null(caption)) { @@ -680,27 +682,27 @@ eng_sql = function(options) { } # disable caption if (identical(caption, NA)) caption = NULL - + # print using kable print(kable(display_data, caption = caption)) - + # terminate div if (add_div) cat("\n
\n") - + # otherwise use tibble if it's available } else if (loadable('tibble')) { print(tibble::as_tibble(display_data), n = max.print) - + } else print(display_data) # fallback to standard print }) if (options$results == 'hide') output = NULL - + # assign varname if requested if (!is.null(varname)) assign(varname, data, envir = knit_global()) - + # reset query to pre-interpolated if not expanding if (!isTRUE(options$sql.show_interpolated)) query <- options$code - + # return output engine_output(options, query, output) } From c0e6a6319ffff5f7f496158cdc621206798d99a7 Mon Sep 17 00:00:00 2001 From: Anne-Wil Date: Wed, 18 May 2022 11:00:31 +0200 Subject: [PATCH 2/5] Update engine.R Improved handling of options$immediate and additional options$replace - these edits work in a knitr::knit_engines$set( ) style test. Immediate = T passes param immediate = T to dbExecute() / dbGetQuery(). Immedate is not implemented for query's with options$max.print set. I can't be sure if options$immediate also works icw options$params - I can't get params to run at all on my server. Passing values from local environment using ?value works however, also icw the immediate option. Replace = T adds code to drop an existing temporary table before running the into # statement. I thought this might be handy but leave it to others to decide on whether this is truly needed (I also don't really know if this implementation works on other servers than the one I use). I've also included an error message to catch attempted replacement of non-temporary tables but error handling doesn't work yet as expected - when attempting to replace a table with a name not starting with #, the generic server error message appears: ([SQL Server]CREATE TABLE permission denied in database 'DWH'. ) - perhaps someone else will now how to fix, though perhaps we'll not want to implement the replace option at all. Example code: ```{r qvalue} StadiumCode <- '0A' ``` ```{sql, immediate = T, replace = T} SELECT * into #tum FROM statistiek.vw_dimStadium where StadiumCode = ?StadiumCode ``` ```{sql fetch} SELECT * FROM #tum ``` --- R/engine.R | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) diff --git a/R/engine.R b/R/engine.R index 1daa94390a..20b6f3938b 100644 --- a/R/engine.R +++ b/R/engine.R @@ -609,14 +609,26 @@ eng_sql = function(options) { max.print = -1 sql = one_string(options$code) params = options$params - imm = options$immediate + immediate= F + if(isTRUE(options$immediate)) { + immediate= T + replace= F + if(isTRUE(options$replace)) { + replace= T + reptable = gsub('(^.*into [[:space:]]+)(.+)([[:space:]]+from.*$)', '\\2', tolower(code)) + if(sub('(.).*.$', '\\1', reptable) != '#') stop2( + "To replace a table, the table has to be a temporary table (tablename staring with # or ##)." + ) + sql <- paste0("if object_id('tempdb.dbo.", reptable, "') is not null drop table ", reptable, " ;", sql) + } + } query = interpolate_from_env(conn, sql) if (isFALSE(options$eval)) return(engine_output(options, query, '')) data = tryCatch({ if (is_sql_update_query(query)) { - DBI::dbExecute(conn, query, immediate = imm) + DBI::dbExecute(conn, query, immediate = immediate) NULL } else if (is.null(varname) && max.print > 0) { # execute query -- when we are printing with an enforced max.print we @@ -628,10 +640,10 @@ eng_sql = function(options) { } else { if (length(params) == 0) { - DBI::dbGetQuery(conn, query, immediate = imm) + DBI::dbGetQuery(conn, query, immediate = immediate) } else { # If params option is provided, parameters are not interplolated - DBI::dbGetQuery(conn, sql, immediate = imm, params = params) + DBI::dbGetQuery(conn, sql, immediate = immediate, params = params) } } }, error = function(e) { From 19366f8d10b5c257ba3e271329f5c49efa4006e5 Mon Sep 17 00:00:00 2001 From: Anne-Wil Date: Wed, 18 May 2022 11:36:24 +0200 Subject: [PATCH 3/5] Update engine.R Fixed error handling on temporary table check. What a difference a space makes... --- R/engine.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/engine.R b/R/engine.R index 20b6f3938b..22481482ee 100644 --- a/R/engine.R +++ b/R/engine.R @@ -615,7 +615,7 @@ eng_sql = function(options) { replace= F if(isTRUE(options$replace)) { replace= T - reptable = gsub('(^.*into [[:space:]]+)(.+)([[:space:]]+from.*$)', '\\2', tolower(code)) + reptable = gsub('(^.*into[[:space:]]+)(#.+)([[:space:]]+from.*$)', '\\2', sql, ignore.case = T) if(sub('(.).*.$', '\\1', reptable) != '#') stop2( "To replace a table, the table has to be a temporary table (tablename staring with # or ##)." ) From 358d55248dc07c6147b4276fea793bf6312cea65 Mon Sep 17 00:00:00 2001 From: Anne-Wil Date: Tue, 14 Jun 2022 12:34:03 +0200 Subject: [PATCH 4/5] Update engine.R - added prefixes sql. to immediate and replace options - set NULL as default for sql.immediate - handling of user input FALSE as well as TRUE for sql.immediate - added stop when attempting to replace (sql.replace == T) when not executing immediately (sql.immedate == F) - removed all-whitespaced lines as well as I could To be discussed: implement non-passing of parameter immediate when options$sql.immediate is not set. --- R/engine.R | 72 ++++++++++++++++++++++++++---------------------------- 1 file changed, 35 insertions(+), 37 deletions(-) diff --git a/R/engine.R b/R/engine.R index 22481482ee..6550ae48d0 100644 --- a/R/engine.R +++ b/R/engine.R @@ -560,14 +560,13 @@ is_sql_update_query = function(query) { grepl('^\\s*(INSERT|UPDATE|DELETE|CREATE|DROP).*', query, ignore.case = TRUE) } - # sql engine eng_sql = function(options) { # return chunk before interpolation eagerly to avoid connection option check if (isFALSE(options$eval) && !isTRUE(options$sql.show_interpolated)) { return(engine_output(options, options$code, '')) } - + # Return char vector of sql interpolation param names varnames_from_sql = function(conn, sql) { varPos = DBI::sqlParseVariables(conn, sql) @@ -576,12 +575,12 @@ eng_sql = function(options) { sub('^\\?', '', varNames) } } - + # Vectorized version of exists mexists = function(x, env = knit_global(), inherits = TRUE) { vapply(x, exists, logical(1), where = env, inherits = inherits) } - + # Interpolate a sql query based on the variables in an environment interpolate_from_env = function(conn, sql, env = knit_global(), inherits = TRUE) { names = unique(varnames_from_sql(conn, sql)) @@ -589,14 +588,14 @@ eng_sql = function(options) { if (length(names_missing) > 0) { stop("Object(s) not found: ", paste('"', names_missing, '"', collapse = ", ")) } - + args = if (length(names) > 0) setNames( mget(names, envir = env, inherits = inherits), names ) - + do.call(DBI::sqlInterpolate, c(list(conn, sql), args)) } - + # extract options conn = options$connection if (is.character(conn)) conn = get(conn, envir = knit_global()) @@ -609,23 +608,23 @@ eng_sql = function(options) { max.print = -1 sql = one_string(options$code) params = options$params - immediate= F - if(isTRUE(options$immediate)) { - immediate= T - replace= F - if(isTRUE(options$replace)) { - replace= T - reptable = gsub('(^.*into[[:space:]]+)(#.+)([[:space:]]+from.*$)', '\\2', sql, ignore.case = T) - if(sub('(.).*.$', '\\1', reptable) != '#') stop2( - "To replace a table, the table has to be a temporary table (tablename staring with # or ##)." - ) - sql <- paste0("if object_id('tempdb.dbo.", reptable, "') is not null drop table ", reptable, " ;", sql) + immediate = NULL + if(exists("sql.immediate", where = options) ) { immediate = options$sql.immediate } + if(exists('sql.replace', where = options) ) { + if(!isTRUE(immediate)) knitr:::stop2("To replace a temprary table, option sql.immediate has to be set to TRUE).") + replace = options$sql.replace + if (isTRUE(immediate) && isTRUE(replace)) { + reptable = gsub('(^.*into[[:space:]]+)(#.+)([[:space:]]+from.*$)', '\\2', sql, ignore.case = T) + if(!sub('(.).*.$', '\\1', reptable) == '#') knitr:::stop2( + "To replace a table, the table has to be a temporary table (tablename staring with # or ##)." + ) + sql <- paste0("if object_id('tempdb.dbo.", reptable, "') is not null drop table ", reptable, " ;", sql) } } - + query = interpolate_from_env(conn, sql) if (isFALSE(options$eval)) return(engine_output(options, query, '')) - + data = tryCatch({ if (is_sql_update_query(query)) { DBI::dbExecute(conn, query, immediate = immediate) @@ -637,7 +636,6 @@ eng_sql = function(options) { data = DBI::dbFetch(res, n = max.print) DBI::dbClearResult(res) data - } else { if (length(params) == 0) { DBI::dbGetQuery(conn, query, immediate = immediate) @@ -650,37 +648,37 @@ eng_sql = function(options) { if (!options$error) stop(e) e }) - + if (inherits(data, "error")) return(engine_output(options, query, one_string(data))) - + # create output if needed (we have data and we aren't assigning it to a variable) output = if (length(dim(data)) == 2 && ncol(data) > 0 && is.null(varname)) capture.output({ - + # apply max.print to data display_data = if (max.print == -1) data else head(data, n = max.print) - + # get custom sql print function sql.print = opts_knit$get('sql.print') - + # use kable for markdown if (!is.null(sql.print)) { options$results = 'asis' cat(sql.print(data)) } else if (out_format('markdown')) { - + # we are going to output raw markdown so set results = 'asis' options$results = 'asis' - + # force left alignment if the first column is an incremental id column first_column = display_data[[1]] if (is.numeric(first_column) && length(first_column) > 1 && all(diff(first_column) == 1)) display_data[[1]] = as.character(first_column) - + # wrap html output in a div so special styling can be applied add_div = is_html_output() && getOption('knitr.sql.html_div', TRUE) if (add_div) cat('
\n') - + # determine records caption caption = options$tab.cap if (is.null(caption)) { @@ -694,27 +692,27 @@ eng_sql = function(options) { } # disable caption if (identical(caption, NA)) caption = NULL - + # print using kable print(kable(display_data, caption = caption)) - + # terminate div if (add_div) cat("\n
\n") - + # otherwise use tibble if it's available } else if (loadable('tibble')) { print(tibble::as_tibble(display_data), n = max.print) - + } else print(display_data) # fallback to standard print }) if (options$results == 'hide') output = NULL - + # assign varname if requested if (!is.null(varname)) assign(varname, data, envir = knit_global()) - + # reset query to pre-interpolated if not expanding if (!isTRUE(options$sql.show_interpolated)) query <- options$code - + # return output engine_output(options, query, output) } From a47b771f0e53c189c23344343eb3d04f2fc98990 Mon Sep 17 00:00:00 2001 From: Anne-Wil Date: Fri, 24 Jun 2022 11:48:37 +0200 Subject: [PATCH 5/5] Update engine.R Fix regex for lifting temporary table name to replace when sql.replace =T + a correction to the getQuery call with params where `sql` was used instead of `query`. --- R/engine.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/engine.R b/R/engine.R index 6550ae48d0..43ada8d54b 100644 --- a/R/engine.R +++ b/R/engine.R @@ -614,7 +614,7 @@ eng_sql = function(options) { if(!isTRUE(immediate)) knitr:::stop2("To replace a temprary table, option sql.immediate has to be set to TRUE).") replace = options$sql.replace if (isTRUE(immediate) && isTRUE(replace)) { - reptable = gsub('(^.*into[[:space:]]+)(#.+)([[:space:]]+from.*$)', '\\2', sql, ignore.case = T) + reptable = gsub('(^.*into[[:space:]]+)(#[0-9A-Za-z]+)(.+from.*$)', '\\2', sql, ignore.case = T) if(!sub('(.).*.$', '\\1', reptable) == '#') knitr:::stop2( "To replace a table, the table has to be a temporary table (tablename staring with # or ##)." ) @@ -641,7 +641,7 @@ eng_sql = function(options) { DBI::dbGetQuery(conn, query, immediate = immediate) } else { # If params option is provided, parameters are not interplolated - DBI::dbGetQuery(conn, sql, immediate = immediate, params = params) + DBI::dbGetQuery(conn, query, immediate = immediate, params = params) } } }, error = function(e) {