diff --git a/.Rbuildignore b/.Rbuildignore new file mode 100644 index 0000000..91114bf --- /dev/null +++ b/.Rbuildignore @@ -0,0 +1,2 @@ +^.*\.Rproj$ +^\.Rproj\.user$ diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..3c8b100 --- /dev/null +++ b/.gitignore @@ -0,0 +1,5 @@ +.Rproj.user +.Rhistory +.RData +.Ruserdata +inst/java diff --git a/R/class.R b/R/class.R index cafdd41..e44ddcb 100644 --- a/R/class.R +++ b/R/class.R @@ -11,6 +11,9 @@ setClass("JDBCResult", representation("DBIResult", jr="jobjRef", md="jobjRef", s setClass("JDBCConnection", representation("DBIConnection", jc="jobjRef", identifier.quote="character")) +is_generic_definition_needed <- function(x) { + return(is.null(getGeneric(x)) || attr(getGeneric(x), "package") == "RJDBC") +} JDBC <- function(driverClass='', classPath='', identifier.quote=NA) { ## we allow the user to supply the class itself in case they got @@ -178,7 +181,7 @@ if (!is.null(asNamespace("DBI")$dbIsValid)) { setMethod("dbSendQuery", signature(conn="JDBCConnection", statement="character"), def=function(conn, statement, ..., list=NULL) { statement <- as.character(statement)[1L] - ## if the statement starts with {call or {?= call then we use CallableStatement + ## if the statement starts with {call or {?= call then we use CallableStatement if (isTRUE(as.logical(grepl("^\\{(call|\\?= *call)", statement)))) { s <- .jcall(conn@jc, "Ljava/sql/CallableStatement;", "prepareCall", statement, check=FALSE) .verify.JDBC.result(s, "Unable to execute JDBC callable statement", statement=statement) @@ -196,17 +199,17 @@ setMethod("dbSendQuery", signature(conn="JDBCConnection", statement="character") .verify.JDBC.result(s, "Unable to create simple JDBC statement", statement=statement) r <- .jcall(s, "Ljava/sql/ResultSet;", "executeQuery", as.character(statement)[1], check=FALSE) .verify.JDBC.result(r, "Unable to retrieve JDBC result set", statement=statement) - } + } md <- .jcall(r, "Ljava/sql/ResultSetMetaData;", "getMetaData", check=FALSE) .verify.JDBC.result(md, "Unable to retrieve JDBC result set meta data in dbSendQuery", statement=statement) new("JDBCResult", jr=r, md=md, stat=s, env=new.env(parent=emptyenv())) }) -if (is.null(getGeneric("dbSendUpdate"))) setGeneric("dbSendUpdate", function(conn, statement, ...) standardGeneric("dbSendUpdate")) +if (is_generic_definition_needed("dbSendUpdate")) setGeneric("dbSendUpdate", function(conn, statement, ...) standardGeneric("dbSendUpdate")) setMethod("dbSendUpdate", signature(conn="JDBCConnection", statement="character"), def=function(conn, statement, ..., list=NULL, max.batch=10000L) { statement <- as.character(statement)[1L] - ## if the statement starts with {call or {?= call then we use CallableStatement + ## if the statement starts with {call or {?= call then we use CallableStatement if (isTRUE(as.logical(grepl("^\\{(call|\\?= *call)", statement)))) { s <- .jcall(conn@jc, "Ljava/sql/CallableStatement;", "prepareCall", statement, check=FALSE) .verify.JDBC.result(s, "Unable to execute JDBC callable statement", statement=statement) @@ -275,12 +278,15 @@ setMethod("dbListResults", "JDBCConnection", fetch(res, -1) } -setMethod("dbListTables", "JDBCConnection", def=function(conn, pattern="%", schema=NULL, ...) { +setMethod("dbListTables", "JDBCConnection", def=function(conn, pattern="%", schema=NULL, catalog = NULL, ...) { md <- .jcall(conn@jc, "Ljava/sql/DatabaseMetaData;", "getMetaData", check=FALSE) .verify.JDBC.result(md, "Unable to retrieve JDBC database metadata") - schema <- if (is.null(schema)) .jnull("java/lang/String") else as.character(schema)[1L] - r <- .jcall(md, "Ljava/sql/ResultSet;", "getTables", .jnull("java/lang/String"), - schema, pattern, .jnull("[Ljava/lang/String;"), check=FALSE) + catalog <- if (is.null(catalog)) .jnull("java/lang/String") else as.character(catalog)[1L] + schema_pattern <- if (is.null(schema)) .jnull("java/lang/String") else as.character(schema)[1L] + table_pattern <- pattern + types <- .jnull("[Ljava/lang/String;") + r <- .jcall(md, "Ljava/sql/ResultSet;", "getTables", catalog, + schema_pattern, table_pattern, types, check=FALSE) .verify.JDBC.result(r, "Unable to retrieve JDBC tables list") on.exit(.jcall(r, "V", "close")) ts <- character() @@ -289,25 +295,37 @@ setMethod("dbListTables", "JDBCConnection", def=function(conn, pattern="%", sche ts }) -if (is.null(getGeneric("dbGetTables"))) setGeneric("dbGetTables", function(conn, ...) standardGeneric("dbGetTables")) +if (is_generic_definition_needed("dbGetTables")) setGeneric("dbGetTables", function(conn, ...) standardGeneric("dbGetTables")) -setMethod("dbGetTables", "JDBCConnection", def=function(conn, pattern="%", schema=NULL, ...) { +setMethod("dbGetTables", "JDBCConnection", def=function(conn, pattern="%", schema=NULL, catalog = NULL, ...) { md <- .jcall(conn@jc, "Ljava/sql/DatabaseMetaData;", "getMetaData", check=FALSE) .verify.JDBC.result(md, "Unable to retrieve JDBC database metadata") - schema <- if (is.null(schema)) .jnull("java/lang/String") else as.character(schema)[1L] - r <- .jcall(md, "Ljava/sql/ResultSet;", "getTables", .jnull("java/lang/String"), - schema, pattern, .jnull("[Ljava/lang/String;"), check=FALSE) + catalog <- if (is.null(catalog)) .jnull("java/lang/String") else as.character(catalog)[1L] + schema_pattern <- if (is.null(schema)) .jnull("java/lang/String") else as.character(schema)[1L] + table_pattern <- pattern + types <- .jnull("[Ljava/lang/String;") + r <- .jcall(md, "Ljava/sql/ResultSet;", "getTables", catalog, + schema_pattern, table_pattern, types, check=FALSE) .verify.JDBC.result(r, "Unable to retrieve JDBC tables list") on.exit(.jcall(r, "V", "close")) .fetch.result(r) }) -setMethod("dbExistsTable", "JDBCConnection", def=function(conn, name, schema=NULL, ...) length(dbListTables(conn, name, schema)) > 0) +setMethod("dbExistsTable", signature(conn="JDBCConnection", name="Id"), def=function(conn, name, schema=NULL, ...) { + dbExistsTable(conn, name = extract_table(name), schema = extract_schema(name), catalog = extract_catalog(name), ...) +}) +setMethod("dbExistsTable", signature(conn="JDBCConnection", name="character"), def=function(conn, name, schema=NULL, catalog = NULL, ...) length(dbListTables(conn = conn, pattern = name, schema = schema, catalog = catalog)) > 0) + +setMethod("dbRemoveTable", signature(conn="JDBCConnection", name="Id"), def=function(conn, name, silent=FALSE, ...) + if (silent) tryCatch(dbRemoveTable(conn, name, silent=FALSE), error=function(e) FALSE) else dbSendUpdate(conn, paste("DROP TABLE", quote_identifier(conn = conn, x = name)))) -setMethod("dbRemoveTable", "JDBCConnection", def=function(conn, name, silent=FALSE, ...) - if (silent) tryCatch(dbRemoveTable(conn, name, silent=FALSE), error=function(e) FALSE) else dbSendUpdate(conn, paste("DROP TABLE", name))) +setMethod("dbRemoveTable", signature(conn="JDBCConnection", name="character"), def=function(conn, name, silent=FALSE, ...) + if (silent) tryCatch(dbRemoveTable(conn, name, silent=FALSE), error=function(e) FALSE) else dbSendUpdate(conn, paste("DROP TABLE", quote_identifier(conn = conn, x = name)))) -setMethod("dbListFields", "JDBCConnection", def=function(conn, name, pattern="%", full=FALSE, ...) { +setMethod("dbListFields", signature(conn="JDBCConnection", name="Id"), def=function(conn, name, pattern="%", full=FALSE, ...) { + dbListFields(conn, name = extract_table(name), pattern = pattern, full = full, schema = extract_schema(name), catalog = extract_catalog(name), ...) +}) +setMethod("dbListFields", signature(conn="JDBCConnection", name="character"), def=function(conn, name, pattern="%", full=FALSE, ...) { md <- .jcall(conn@jc, "Ljava/sql/DatabaseMetaData;", "getMetaData", check=FALSE) .verify.JDBC.result(md, "Unable to retrieve JDBC database metadata") r <- .jcall(md, "Ljava/sql/ResultSet;", "getColumns", .jnull("java/lang/String"), @@ -321,7 +339,7 @@ setMethod("dbListFields", "JDBCConnection", def=function(conn, name, pattern="%" ts }) -if (is.null(getGeneric("dbGetFields"))) setGeneric("dbGetFields", function(conn, ...) standardGeneric("dbGetFields")) +if (is_generic_definition_needed("dbGetFields")) setGeneric("dbGetFields", function(conn, ...) standardGeneric("dbGetFields")) setMethod("dbGetFields", "JDBCConnection", def=function(conn, name, pattern="%", ...) { md <- .jcall(conn@jc, "Ljava/sql/DatabaseMetaData;", "getMetaData", check=FALSE) @@ -337,11 +355,14 @@ setMethod("dbGetFields", "JDBCConnection", def=function(conn, name, pattern="%", ## name=character. So we have to make sure it doesn't get picked by making sure ## we also set a character method even if we don't actually require it. setMethod("dbReadTable", signature(conn="JDBCConnection", name="character"), def=function(conn, name, ...) - dbGetQuery(conn, paste("SELECT * FROM",.sql.qescape(name,TRUE,conn@identifier.quote)), ...)) + dbGetQuery(conn, paste("SELECT * FROM", quote_identifier(conn, name)), ...)) + +setMethod("dbReadTable", signature(conn="JDBCConnection", name="Id"), def=function(conn, name, ...) + dbGetQuery(conn, paste("SELECT * FROM", quote_identifier(conn, name)), ...)) ## cover all the other cases where the user likely intended a coersion setMethod("dbReadTable", signature(conn="JDBCConnection", name="ANY"), def=function(conn, name, ...) - dbGetQuery(conn, paste("SELECT * FROM",.sql.qescape(as.character(name),TRUE,conn@identifier.quote)), ...)) + dbGetQuery(conn, paste("SELECT * FROM", quote_identifier(conn, name)), ...)) setMethod("dbDataType", signature(dbObj="JDBCConnection", obj = "ANY"), @@ -367,10 +388,15 @@ setMethod("dbDataType", signature(dbObj="JDBCConnection", obj = "ANY"), paste(quote,s,quote,sep='') } -setMethod("dbWriteTable", "JDBCConnection", def=function(conn, name, value, overwrite=FALSE, append=FALSE, force=FALSE, field.types=NULL, ..., max.batch=10000L) { +setMethod("dbWriteTable", signature(conn="JDBCConnection", name="Id"), def=function(conn, name, value, overwrite=FALSE, append=FALSE, force=FALSE, field.types=NULL, ..., max.batch=10000L) { + dbWriteTable(conn, name = extract_table(name), schema = extract_schema(name), catalog = extract_catalog(name), value = value, overwrite=overwrite, append=append, force=force, field.types=field.types, ..., max.batch=max.batch) +}) + +setMethod("dbWriteTable", signature(conn="JDBCConnection", name="character"), def=function(conn, name, value, overwrite=FALSE, append=FALSE, force=FALSE, field.types=NULL, ..., max.batch=10000L, schema = NULL, catalog = NULL) { ac <- .jcall(conn@jc, "Z", "getAutoCommit") overwrite <- isTRUE(as.logical(overwrite)) append <- isTRUE(as.logical(append)) + table_id <- create_id(catalog = catalog, schema = schema, table = name) if (overwrite && append) stop("overwrite=TRUE and append=TRUE are mutually exclusive") if (is.vector(value) && !is.list(value)) value <- data.frame(x=value) if (length(value)<1) stop("value must have at least one column") @@ -381,12 +407,12 @@ setMethod("dbWriteTable", "JDBCConnection", def=function(conn, name, value, over if (!is.data.frame(value)) value <- as.data.frame(value) } if (isTRUE(as.logical(force))) { - if (overwrite) dbRemoveTable(conn, name, silent=TRUE) - } else if (dbExistsTable(conn, name)) { - if (overwrite) dbRemoveTable(conn, name) + if (overwrite) dbRemoveTable(conn, name = table_id, silent=TRUE) + } else if (dbExistsTable(conn, name = name, schema = schema)) { + if (overwrite) dbRemoveTable(conn, name = table_id) else if (!append) stop("Table `",name,"' already exists") } else append <- FALSE ## if the table doesn't exist, append has no meaning - qname <- .sql.qescape(name, TRUE, conn@identifier.quote) + qname <- quote_identifier(conn, table_id) if (ac) { .jcall(conn@jc, "V", "setAutoCommit", FALSE) on.exit(.jcall(conn@jc, "V", "setAutoCommit", ac)) @@ -399,7 +425,9 @@ setMethod("dbWriteTable", "JDBCConnection", def=function(conn, name, value, over dbSendUpdate(conn, ct) } if (length(value[[1]])) { - inss <- paste("INSERT INTO ",qname," VALUES(", paste(rep("?",length(value)),collapse=','),")",sep='') + #Ensure the inserts go into the same slots as the values, otherwise with col name list, it inserts values randomly into table structure + insert_cols <- paste(.sql.qescape(names(value), TRUE, conn@identifier.quote), collapse=',') + inss <- paste("INSERT INTO ",qname," (", insert_cols, ") VALUES(", paste(rep("?",length(value)),collapse=','),")",sep='') ## make sure everything is a character other than real/int list <- lapply(value, function(o) if (!is.numeric(o)) as.character(o) else o) dbSendUpdate(conn, inss, list=list) diff --git a/R/utils.R b/R/utils.R new file mode 100644 index 0000000..3e70812 --- /dev/null +++ b/R/utils.R @@ -0,0 +1,88 @@ +#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +# Helper to extract values from slots +# x <- DBI::Id(schema = "test", table = "my_cars") +# schema <- id_field(x, "schema") +# table <- id_field(x, "table") +#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +id_field <- function(id, field, default = NULL) { + if (field %in% names(id@name)) { + id@name[[field]] + } else { + default + } +} + +#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +# Helper to extract values from slots +# x <- DBI::Id(catalog = "foo", schema = "test", table = "my_cars") +# catalog <- extract_catalog(x) # "foo" +# catalog <- extract_catalog("my_cars") # NULL +#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +extract_catalog <- function(x, default = NULL) { + if (is.null(x)) { + return(default) + } else if (inherits(x, "Id")) { + return(id_field(id = x, field = "catalog", default = default)) + } else { + return(default) + } +} + +#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +# Helper to extract values from slots +# x <- DBI::Id(schema = "test", table = "my_cars") +# schema <- extract_schema(x) # "test" +# schema <- extract_schema("my_cars") # NULL +#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +extract_schema <- function(x, default = NULL) { + if (is.null(x)) { + return(default) + } else if (inherits(x, "Id")) { + return(id_field(id = x, field = "schema", default = default)) + } else { + return(default) + } +} + +#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +# Helper to extract values from slots +# x <- DBI::Id(schema = "test", table = "my_cars") +# table <- extract_table(x) # "my_cars" +# table <- extract_table("my_cars") # "my_cars +#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +extract_table <- function(x, default = x) { + if (is.null(x)) { + return(default) + } else if (inherits(x, "Id")) { + return(id_field(id = x, field = "table", default = default)) + } else if (is.character(x)) { + return(x) + } else { + return(default) + } +} + +quote_identifier <- function(conn, x) { + if (is.null(x)) { + return(x) + } else if (inherits(x, "Id")) { + id <- DBI::dbQuoteIdentifier(conn, x) + } else { + id <- .sql.qescape(as.character(x),TRUE,conn@identifier.quote) + } + return(id) +} + +create_id <- function(catalog = NULL, schema = NULL, table = NULL) { + if (!is.null(catalog) && !is.null(schema) && !is.null(table)) { + return(DBI::Id(catalog = catalog, schema = schema, table = table)) + } else if (is.null(catalog) && !is.null(schema) && !is.null(table)) { + return(DBI::Id(schema = schema, table = table)) + } else if (!is.null(catalog) && is.null(schema) && !is.null(table)) { + return(DBI::Id(catalog = catalog, table = table)) + } else if (is.null(catalog) && is.null(schema) && !is.null(table)) { + return(table) + } else { + stop("Invalid ID Specification") + } +} diff --git a/RJDBC.Rproj b/RJDBC.Rproj new file mode 100644 index 0000000..66479e5 --- /dev/null +++ b/RJDBC.Rproj @@ -0,0 +1,20 @@ +Version: 1.0 + +RestoreWorkspace: Default +SaveWorkspace: Default +AlwaysSaveHistory: Default + +EnableCodeIndexing: Yes +UseSpacesForTab: Yes +NumSpacesForTab: 5 +Encoding: UTF-8 + +RnwWeave: Sweave +LaTeX: pdfLaTeX + +AutoAppendNewline: Yes +StripTrailingWhitespace: Yes + +BuildType: Package +PackageUseDevtools: Yes +PackageInstallArgs: --no-multiarch --with-keep.source diff --git a/compile.sh b/compile.sh new file mode 100755 index 0000000..9604ac6 --- /dev/null +++ b/compile.sh @@ -0,0 +1,16 @@ +#!/bin/sh + +mkdir -p inst/java + +for jtarget in 1.4 1.6 1.8; do + echo " - Attempting to compile for Java $jtarget ..." + if javac -d inst/java -source $jtarget -target $jtarget java/*.java; then + (cd inst/java; jar fvc RJDBC.jar info; rm -rf info) + break + fi +done + +if test ! -e inst/java/RJDBC.jar; then + echo "*** ERROR: could not compile Java sources! We need working JDK!" + exit 1 +fi diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..dc4accb --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,13 @@ +###+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +### +### To Run Unit Tests: +### +### setwd("./tests"); devtools::load_all("."); source("testthat.R") +### +### +###+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + +library(testthat) +library(RJDBC) + +test_check("RJDBC") diff --git a/tests/testthat/helper_h2_in_memory_db.R b/tests/testthat/helper_h2_in_memory_db.R new file mode 100644 index 0000000..16a6db4 --- /dev/null +++ b/tests/testthat/helper_h2_in_memory_db.R @@ -0,0 +1,15 @@ +create_h2_in_memory_db_connection <- function() { + + h2_jar_path <- system.file("tests/testthat/java/h2-2.1.214.jar", package = "RJDBC") + drv <- RJDBC::JDBC(driverClass = 'org.h2.Driver', identifier.quote="`", classPath = h2_jar_path) + conn <- DBI::dbConnect(drv, "jdbc:h2:mem:test;DB_CLOSE_DELAY=-1;MODE=PostgreSQL;DATABASE_TO_LOWER=TRUE;DEFAULT_NULL_ORDERING=HIGH") + + return(conn) +} + +create_empty_schema <- function(conn, schema_name) { + RJDBC::dbSendUpdate(conn = conn, statement = "CREATE USER IF NOT EXISTS sa PASSWORD 'sa'") + RJDBC::dbSendUpdate(conn = conn, statement = sprintf("DROP SCHEMA IF EXISTS %s CASCADE", schema_name)) + RJDBC::dbSendUpdate(conn = conn, statement = sprintf("CREATE SCHEMA %s AUTHORIZATION sa", schema_name)) +} + diff --git a/tests/testthat/java/h2-2.1.214.jar b/tests/testthat/java/h2-2.1.214.jar new file mode 100644 index 0000000..e8e3efc Binary files /dev/null and b/tests/testthat/java/h2-2.1.214.jar differ diff --git a/tests/testthat/test_db_id_names.R b/tests/testthat/test_db_id_names.R new file mode 100644 index 0000000..3f11b37 --- /dev/null +++ b/tests/testthat/test_db_id_names.R @@ -0,0 +1,71 @@ +library(testthat) + +create_cars_table <- function(conn, name) { + # Create Car Table in Schema + RJDBC::dbSendUpdate(conn = conn, statement = sprintf("DROP TABLE IF EXISTS %s CASCADE", name)) + RJDBC::dbSendUpdate(conn = conn, statement = sprintf("CREATE TABLE %s (mpg DOUBLE PRECISION,cyl DOUBLE PRECISION,disp DOUBLE PRECISION,hp DOUBLE PRECISION,drat DOUBLE PRECISION,wt DOUBLE PRECISION,qsec DOUBLE PRECISION,vs DOUBLE PRECISION,am DOUBLE PRECISION,gear DOUBLE PRECISION,carb DOUBLE PRECISION,car_name VARCHAR(255))", name)) +} + +test_cars_table <- function(conn, name) { + # Create cars in default schema + schema <- extract_schema(name) + table <- extract_table(name) + + ddl_table_name <- table + if (!is.null(schema)) { + ddl_table_name <- sprintf("%s.%s", schema, table) + } + + create_cars_table(conn = conn, name = ddl_table_name) + + # Verify schema and table exist + res <- RJDBC::dbGetQuery(conn = conn, statement = sprintf("SELECT table_catalog, table_schema, table_name, table_type, row_count_estimate FROM information_schema.tables where table_name = '%s'", table)) + testthat::expect_equal(object = nrow(res), expected = 1) + + if (is.null(schema)) { + testthat::expect_equal(object = res$table_schema, expected = "public") + } else { + testthat::expect_equal(object = res$table_schema, expected = schema) + } + testthat::expect_equal(object = res$table_name, expected = table) + + testthat::expect_true(table %in% RJDBC::dbListTables(conn)) + testthat::expect_equal( + object = sort(RJDBC::dbListFields(conn, name)), + expected = sort(c("am", "car_name", "carb", "cyl", "disp", "drat", "gear", "hp", "mpg", "qsec", "vs","wt")) + ) + testthat::expect_true(RJDBC::dbExistsTable(conn, name)) + + # Load table via dbWriteTable + my_cars <- mtcars + my_cars$car_name <- row.names(mtcars) + rownames(my_cars) <- NULL + RJDBC::dbWriteTable(conn = conn, name = name, value = my_cars, overwrite = FALSE, append = TRUE) + + # Verify table was loaded into the schema + res <- RJDBC::dbGetQuery(conn = conn, statement = sprintf("select * from %s", ddl_table_name)) + testthat::expect_equal(object = nrow(res), expected = nrow(my_cars)) + + res <- RJDBC::dbReadTable(conn, name) + testthat::expect_equal(object = nrow(res), expected = nrow(my_cars)) + + # Cleanup and delete table + RJDBC::dbRemoveTable(conn = conn, name = name) + testthat::expect_false(RJDBC::dbExistsTable(conn, name)) + +} + +test_that("R01.00.00: JDBC Connection With Default Schema", { + + + conn <- create_h2_in_memory_db_connection() + + # Test without schema + test_cars_table(conn = conn, name = "default_schema_cars") + + + # Test with schema using DBI::Id + create_empty_schema(conn = conn, schema_name = "my_schema") + test_cars_table(conn = conn, name = DBI::Id(schema = "my_schema", table = "my_cars")) +}) +