|
| 1 | +# @file HelperFunctions.R |
| 2 | +# |
| 3 | +# Copyright 2014 Observational Health Data Sciences and Informatics |
| 4 | +# |
| 5 | +# This file is part of SqlRender |
| 6 | +# |
| 7 | +# Licensed under the Apache License, Version 2.0 (the "License"); |
| 8 | +# you may not use this file except in compliance with the License. |
| 9 | +# You may obtain a copy of the License at |
| 10 | +# |
| 11 | +# http://www.apache.org/licenses/LICENSE-2.0 |
| 12 | +# |
| 13 | +# Unless required by applicable law or agreed to in writing, software |
| 14 | +# distributed under the License is distributed on an "AS IS" BASIS, |
| 15 | +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. |
| 16 | +# See the License for the specific language governing permissions and |
| 17 | +# limitations under the License. |
| 18 | +# |
| 19 | +# @author Observational Health Data Sciences and Informatics |
| 20 | +# @author Martijn Schuemie |
| 21 | +# @author Marc Suchard |
| 22 | + |
| 23 | + |
| 24 | +#' SqlRender |
| 25 | +#' |
| 26 | +#' @docType package |
| 27 | +#' @name SqlRender |
| 28 | +NULL |
| 29 | + |
| 30 | +#' Reads a SQL file |
| 31 | +#' |
| 32 | +#' @description |
| 33 | +#' \code{readSql} loads SQL from a file |
| 34 | +#' |
| 35 | +#' @details |
| 36 | +#' \code{readSql} loads SQL from a file |
| 37 | +#' |
| 38 | +#' @param sourceFile The source SQL file |
| 39 | +#' |
| 40 | +#' @return |
| 41 | +#' Returns a string containing the SQL. |
| 42 | +#' |
| 43 | +#' @examples \dontrun{ |
| 44 | +#' readSql("myParamStatement.sql") |
| 45 | +#' } |
| 46 | +#' @export |
| 47 | +readSql <- function(sourceFile) { |
| 48 | + readChar(sourceFile, file.info(sourceFile)$size) |
| 49 | +} |
| 50 | + |
| 51 | +#' Write SQL to a SQL (text) file |
| 52 | +#' |
| 53 | +#' @description |
| 54 | +#' \code{writeSql} writes SQL to a file |
| 55 | +#' |
| 56 | +#' @details |
| 57 | +#' \code{writeSql} writes SQL to a file |
| 58 | +#' |
| 59 | +#' @param sql A string containing the sql |
| 60 | +#' @param targetFile The target SQL file |
| 61 | +#' |
| 62 | +#' @examples \dontrun{ |
| 63 | +#' sql <- "SELECT * FROM @@table_name" |
| 64 | +#' writeSql(sql,"myParamStatement.sql") |
| 65 | +#' } |
| 66 | +#' @export |
| 67 | +writeSql <- function(sql, targetFile) { |
| 68 | + sink(targetFile) |
| 69 | + sql <- gsub("\r","",sql) #outputting to file duplicates carriage returns, so remove them beforehand (still got newline) |
| 70 | + cat(sql) |
| 71 | + sink() |
| 72 | +} |
| 73 | + |
| 74 | + |
| 75 | +#' Render a SQL file |
| 76 | +#' |
| 77 | +#' @description |
| 78 | +#' \code{renderSqlFile} Renders SQL code in a file based on parameterized SQL and parameter values, and writes it to another file. |
| 79 | +#' |
| 80 | +#' @details |
| 81 | +#' This function takes parameterized SQL and a list of parameter values and renders the SQL that can be |
| 82 | +#' send to the server. Parameterization syntax: |
| 83 | +#' \describe{ |
| 84 | +#' \item{@@parameterName}{Parameters are indicated using a @@ prefix, and are replaced with the actual |
| 85 | +#' values provided in the renderSql call.} |
| 86 | +#' \item{\{DEFAULT @@parameterName = parameterValue\}}{Default values for parameters can be defined using |
| 87 | +#' curly and the DEFAULT keyword.} |
| 88 | +#' \item{\{if\}?\{then\}:\{else\}}{The if-then-else pattern is used to turn on or off blocks of SQL code.} |
| 89 | +#' } |
| 90 | +#' |
| 91 | +#' |
| 92 | +#' @param sourceFile The source SQL file |
| 93 | +#' @param targetFile The target SQL file |
| 94 | +#' @param ... Parameter values |
| 95 | +#' |
| 96 | +#' @examples \dontrun{ |
| 97 | +#' renderSqlFile("myParamStatement.sql","myRenderedStatement.sql",a="myTable") |
| 98 | +#' } |
| 99 | +#' @export |
| 100 | +renderSqlFile <- function(sourceFile, targetFile, ...) { |
| 101 | + sql <- readSql(sourceFile) |
| 102 | + sql <- renderSql(sql,...)$sql |
| 103 | + writeSql(sql,targetFile) |
| 104 | +} |
| 105 | + |
| 106 | +#' Translate a SQL file |
| 107 | +#' |
| 108 | +#' @description |
| 109 | +#' This function takes SQL and translates it to a different dialect. |
| 110 | +#' |
| 111 | +#' @details |
| 112 | +#' This function takes SQL and translates it to a different dialect. |
| 113 | +#' |
| 114 | +#' @param sourceFile The source SQL file |
| 115 | +#' @param targetFile The target SQL file |
| 116 | +#' @param sourceDialect The source dialect. Currently, only "sql server" for Microsoft SQL Server is supported |
| 117 | +#' @param targetDialect The target dialect. Currently "oracle", "postgresql", and "redshift" are supported |
| 118 | +#' |
| 119 | +#' @examples \dontrun{ |
| 120 | +#' translateSqlFile("myRenderedStatement.sql","myTranslatedStatement.sql",targetDialect="postgresql") |
| 121 | +#' } |
| 122 | +#' @export |
| 123 | +translateSqlFile <- function(sourceFile, targetFile, sourceDialect = "sql server", targetDialect = "oracle") { |
| 124 | + sql <- readSql(sourceFile) |
| 125 | + sql <- translateSql(sql,sourceDialect,targetDialect)$sql |
| 126 | + writeSql(sql,targetFile) |
| 127 | +} |
| 128 | + |
| 129 | +#' Load, render, and translate a SQL file in a package |
| 130 | +#' |
| 131 | +#' @description |
| 132 | +#' \code{loadRenderTranslateSql} Loads a SQL file contained in a package, renders it and translates it to the specified dialect |
| 133 | +#' |
| 134 | +#' @details |
| 135 | +#' This function looks for a SQL file with the specified name in the inst/sql/<dbms> folder of the specified package. |
| 136 | +#' If it doesn't find it in that folder, it will try and load the file from the inst/sql/sql_server folder and use the |
| 137 | +#' \code{translateSql} function to translate it to the requested dialect. It will subsequently call the \code{renderSql} |
| 138 | +#' function with any of the additional specified parameters. |
| 139 | +#' |
| 140 | +#' |
| 141 | +#' @param sqlFilename The source SQL file |
| 142 | +#' @param packageName The name of the package that contains the SQL file |
| 143 | +#' @param dbms The target dialect. Currently "sql server", "oracle", "postgres", and "redshift" are supported |
| 144 | +#' @param ... Parameter values used for \code{renderSql} |
| 145 | +#' |
| 146 | +#' @return |
| 147 | +#' Returns a string containing the rendered SQL. |
| 148 | +#' @examples \dontrun{ |
| 149 | +#' renderedSql <- loadRenderTranslateSql("CohortMethod.sql",packageName = "CohortMethod",dbms = connectionDetails$dbms,CDM_schema = "cdmSchema") |
| 150 | +#' } |
| 151 | +#' @export |
| 152 | +loadRenderTranslateSql <- function(sqlFilename, packageName, dbms="sql server", ...){ |
| 153 | + pathToSql <- system.file(paste("sql/",gsub(" ","_",dbms),sep=""), sqlFilename, package=packageName) |
| 154 | + mustTranslate <- !file.exists(pathToSql) |
| 155 | + if (mustTranslate) # If DBMS-specific code does not exists, load SQL Server code and translate after rendering |
| 156 | + pathToSql <- system.file(paste("sql/","sql_server",sep=""), sqlFilename, package=packageName) |
| 157 | + parameterizedSql <- readChar(pathToSql,file.info(pathToSql)$size) |
| 158 | + |
| 159 | + renderedSql <- renderSql(parameterizedSql[1], ...)$sql |
| 160 | + |
| 161 | + if (mustTranslate) |
| 162 | + renderedSql <- translateSql(renderedSql, "sql server", dbms)$sql |
| 163 | + |
| 164 | + renderedSql |
| 165 | +} |
| 166 | + |
| 167 | +trim <- function(string){ |
| 168 | + gsub("(^ +)|( +$)", "", string) |
| 169 | +} |
| 170 | + |
| 171 | +snakeCaseToCamelCase <- function(string){ |
| 172 | + string <- tolower(string) |
| 173 | + for(letter in letters){ |
| 174 | + string = gsub(paste("_",letter,sep=""),toupper(letter),string) |
| 175 | + } |
| 176 | + string |
| 177 | +} |
| 178 | + |
| 179 | +#' export |
| 180 | +createRWrapperForSql <- function(sqlFilename, packageName, rFilename){ |
| 181 | + pathToSql <- system.file(paste("sql/","sql_server",sep=""), sqlFilename, package=packageName) |
| 182 | + parameterizedSql <- readChar(pathToSql,file.info(pathToSql)$size) |
| 183 | + |
| 184 | + hits <- gregexpr("\\{DEFAULT @[^}]*\\}",parameterizedSql) |
| 185 | + hits <- cbind(hits[[1]],attr(hits[[1]],"match.length")) |
| 186 | + f <- function(x) { |
| 187 | + x <- substr(parameterizedSql,x[1],x[1]+x[2]) |
| 188 | + start = regexpr("@",x) + 1 |
| 189 | + equalSign = regexpr("=",x) |
| 190 | + end = regexpr("\\}",x) - 1 |
| 191 | + parameter <- trim(substr(x, start,equalSign-1)) |
| 192 | + value <- trim(substr(x, equalSign+1,end)) |
| 193 | + if (grepl(",",value) & substr(value,1,1) != "'") |
| 194 | + value <- paste("c(",value,")",sep="") |
| 195 | + if (substr(value,1,1) == "'" & substr(value,nchar(value),nchar(value)) == "'") |
| 196 | + value <- paste("\"",substr(value,2,nchar(value)-1),"\"",sep="") |
| 197 | + ccParameter = snakeCaseToCamelCase(parameter) |
| 198 | + c(parameter,ccParameter,value) |
| 199 | + } |
| 200 | + definitions <- t(apply(hits,1,FUN = f)) |
| 201 | + |
| 202 | + lines <- c() |
| 203 | + lines <- c(lines,paste(gsub(".sql","",sqlFilename)," <- function(connectionDetails,",sep="")) |
| 204 | + for (i in 1:nrow(definitions)){ |
| 205 | + if (i == nrow(definitions)) |
| 206 | + end = ") {" |
| 207 | + else |
| 208 | + end = "," |
| 209 | + lines <- c(lines,paste(" ",definitions[i,2]," = ",definitions[i,3],end,sep="")) |
| 210 | + } |
| 211 | + lines <- c(lines,paste(" renderedSql <- loadRenderTranslateSql(\"",sqlFilename,"\",",sep="")) |
| 212 | + lines <- c(lines,paste(" packageName = \"",packageName,"\",",sep="")) |
| 213 | + lines <- c(lines," dbms = connectionDetails$dbms,") |
| 214 | + for (i in 1:nrow(definitions)){ |
| 215 | + if (i == nrow(definitions)) |
| 216 | + end = ")" |
| 217 | + else |
| 218 | + end = "," |
| 219 | + lines <- c(lines,paste(" ",definitions[i,1]," = ",definitions[i,2],end,sep="")) |
| 220 | + } |
| 221 | + lines <- c(lines," conn <- connect(connectionDetails)") |
| 222 | + lines <- c(lines,"") |
| 223 | + lines <- c(lines," writeLines(\"Executing multiple queries. This could take a while\")") |
| 224 | + lines <- c(lines," executeSql(conn,connectionDetails$dbms,renderedSql)") |
| 225 | + lines <- c(lines," writeLines(\"Done\")") |
| 226 | + lines <- c(lines,"") |
| 227 | + lines <- c(lines," dummy <- dbDisconnect(conn)") |
| 228 | + lines <- c(lines,"}") |
| 229 | + sink(rFilename) |
| 230 | + cat(paste(lines,collapse="\n")) |
| 231 | + sink() |
| 232 | + |
| 233 | +} |
0 commit comments