Merge pull request #43 from OHDSI/fix_pool_linux_issue

Fix pool linux issue

Author: azimov

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: ResultModelManager
 Title: Result Model Manager (RMM) for OHDSI packages
-Version: 0.5.1
+Version: 0.5.2
 Authors@R:
     person("Jamie", "Gilbert", , "[email protected]", role = c("aut", "cre"))
 Description: Database data model management utilities for OHDSI packages.
@@ -29,8 +29,14 @@ Imports:
 Suggests:
   testthat (>= 3.0.0),
   RSQLite,
+  duckdb,
+  RPostgreSQL,
   withr,
   knitr,
   rmarkdown,
-  keyring
+  keyring,
+  devtools,
+  pkgdown,
+  remotes,
+  styler
 Config/testthat/edition: 3

NEWS.md

@@ -1,3 +1,15 @@
+# ResultModelManager 0.5.2
+
+Changes:
+
+1. Allow `PooledConnectionHandler` classes to use DBI connections to bypass use of JDBC on systems where it may not be
+supported.
+
+Bug Fixes:
+
+1. Fixed issue in platform specific migrations where SqlRender sometimes fails to add attribute when calling 
+`loadRenderTranslateSql`
+
 # ResultModelManager 0.5.1
 
 Bug fixes:

R/ConnectionHandler.R

@@ -32,6 +32,9 @@
 #' @export ConnectionHandler
 ConnectionHandler <- R6::R6Class(
   classname = "ConnectionHandler",
+  private = list(
+    .dbms = ""
+  ),
   public = list(
     connectionDetails = NULL,
     con = NULL,
@@ -48,12 +51,13 @@ ConnectionHandler <- R6::R6Class(
       if (loadConnection) {
         self$initConnection()
       }
+      private$.dbms <- connectionDetails$dbms
     },
 
     #' get dbms
     #' @description Get the dbms type of the connection
     dbms = function() {
-      DatabaseConnector::dbms(self$getConnection())
+      private$.dbms
     },
 
     #' get table
@@ -76,14 +80,14 @@ ConnectionHandler <- R6::R6Class(
     #' @param ...                     Elipsis
     renderTranslateSql = function(sql, ...) {
       mustTranslate <- TRUE
-      if (isTRUE(attr(sql, "sqlDialect", TRUE) == gsub(" ", "_", self$connectionDetails$dbms))) {
+      if (isTRUE(attr(sql, "sqlDialect", TRUE) == gsub(" ", "_", self$dbms()))) {
         mustTranslate <- FALSE
       }
 
       sql <- SqlRender::render(sql = sql, ...)
       # Only translate if translate is needed.
       if (mustTranslate) {
-        sql <- SqlRender::translate(sql, targetDialect = self$connectionDetails$dbms)
+        sql <- SqlRender::translate(sql, targetDialect = self$dbms())
       }
       return(sql)
     },
@@ -179,7 +183,7 @@ ConnectionHandler <- R6::R6Class(
           data <- self$queryFunction(sql, snakeCaseToCamelCase = snakeCaseToCamelCase)
         },
         error = function(error) {
-          if (self$connectionDetails$dbms %in% c("postgresql", "redshift")) {
+          if (self$dbms() %in% c("postgresql", "redshift")) {
             DatabaseConnector::dbExecute(self$getConnection(), "ABORT;")
           }
           print(sql)
@@ -202,7 +206,7 @@ ConnectionHandler <- R6::R6Class(
           data <- self$executeFunction(sql)
         },
         error = function(error) {
-          if (self$connectionDetails$dbms %in% c("postgresql", "redshift")) {
+          if (self$dbms() %in% c("postgresql", "redshift")) {
             self$executeFunction("ABORT;")
           }
           print(sql)

R/DataMigrationManager.R

@@ -266,6 +266,14 @@ DataMigrationManager <- R6::R6Class(
           table_prefix = self$tablePrefix,
           packageName = self$packageName
         )
+
+        dialect <- attr(sql, "sqlDialect", TRUE)
+
+        if (is.null(dialect)) {
+          # Unknown as to why SqlRender doesn't always set this
+          attr(sql, "sqlDialect") <- private$connectionDetails$dbms
+        }
+
         private$connectionHandler$executeSql(sql)
       } else {
         # Check to see if a file for database platform exists

R/PooledConnectionHandler.R

@@ -15,6 +15,59 @@
 # limitations under the License.
 
 
+requiredPackage <- function(packageName) {
+  packages <- utils::installed.packages()
+  packages <- as.data.frame(packages)
+  if (!packageName %in% packages$Package) {
+    utils::install.packages(packageName)
+  }
+}
+
+# map a ConnectionDetails objects and translates them to DBI pool args
+.DBCToDBIArgs <- list(
+  "sqlite" = function(cd) {
+    requiredPackage("RSQLite")
+    list(
+      drv = RSQLite::SQLite(),
+      dbname = cd$server()
+    )
+  },
+  "postgresql" = function(cd) {
+    requiredPackage("RPostgreSQL")
+    host <- strsplit(cd$server(), "/")[[1]][1]
+    dbname <- strsplit(cd$server(), "/")[[1]][2]
+    list(
+      drv = RPostgreSQL::PostgreSQL(),
+      dbname = dbname,
+      host = host,
+      user = cd$user(),
+      port = cd$port(),
+      password = cd$password(),
+      options = "sslmode=require"
+    )
+  },
+  "duckdb" = function(cd) {
+    requiredPackage("duckdb")
+    list(
+      drv = duckdb::duckdb(),
+      dbdir = cd$server()
+    )
+  },
+  "jdbc" = function(cd) {
+    ParallelLogger::logInfo("Reverting to use of DatabaseConnector jdbc driver. May fail on some systems")
+    list(
+      drv = DatabaseConnector::DatabaseConnectorDriver(),
+      dbms = cd$connectionDetails$dbms,
+      server = cd$connectionDetails$server(),
+      port = cd$connectionDetails$port(),
+      user = cd$connectionDetails$user(),
+      password = cd$connectionDetails$password(),
+      connectionString = cd$connectionDetails$connectionString()
+    )
+  }
+)
+
+
 #' Pooled Connection Handler
 #'
 #' @description
@@ -28,11 +81,42 @@
 PooledConnectionHandler <- R6::R6Class(
   classname = "PooledConnectionHandler",
   inherit = ConnectionHandler,
+  private = list(
+    dbConnectArgs = NULL
+  ),
   public = list(
-    #' @param ...                           Elisis @seealso[ConnectionHandler]
-    initialize = function(...) {
-      ## Note this function is just a dummy because of roxygen
-      super$initialize(...)
+    #' @param connectionDetails             DatabaseConnector::connectionDetails class
+    #' @param loadConnection                Boolean option to load connection right away
+    #' @param snakeCaseToCamelCase          (Optional) Boolean. return the results columns in camel case (default)
+    #' @param dbConnectArgs                 Optional arguments to call pool::dbPool overrides default usage of connectionDetails
+    #' @param forceJdbcConnection           Force JDBC connection (requires using DatabaseConnector ConnectionDetails)
+    initialize = function(connectionDetails = NULL,
+                          snakeCaseToCamelCase = TRUE,
+                          loadConnection = TRUE,
+                          dbConnectArgs = NULL,
+                          forceJdbcConnection = FALSE) {
+      checkmate::assertList(dbConnectArgs, null.ok = TRUE)
+      checkmate::assertClass(connectionDetails, "ConnectionDetails", null.ok = TRUE)
+
+      if (is.null(connectionDetails) && is.null(dbConnectArgs)) {
+        stop("Must either specify usage of poolArgs or DatabaseConnector connection details object")
+      }
+
+      if (is.null(dbConnectArgs)) {
+        if (!forceJdbcConnection && connectionDetails$dbms %in% names(.DBCToDBIArgs)) {
+          fun <- .DBCToDBIArgs[[connectionDetails$dbms]]
+        } else {
+          fun <- .DBCToDBIArgs$jdbc
+        }
+        dbConnectArgs <- fun(connectionDetails)
+      }
+
+      private$dbConnectArgs <- dbConnectArgs
+      self$connectionDetails <- connectionDetails
+      self$snakeCaseToCamelCase <- snakeCaseToCamelCase
+      if (loadConnection) {
+        self$initConnection()
+      }
     },
     #' initialize pooled db connection
     #' @description
@@ -42,15 +126,9 @@ PooledConnectionHandler <- R6::R6Class(
         warning("Closing existing connection")
         self$closeConnection()
       }
+      ParallelLogger::logInfo("Initalizing pooled connection")
+      self$con <- do.call(pool::dbPool, private$dbConnectArgs)
 
-      self$con <- pool::dbPool(
-        drv = DatabaseConnector::DatabaseConnectorDriver(),
-        dbms = self$connectionDetails$dbms,
-        server = self$connectionDetails$server(),
-        port = self$connectionDetails$port(),
-        user = self$connectionDetails$user(),
-        password = self$connectionDetails$password()
-      )
       self$isActive <- TRUE
     },