diff --git a/DESCRIPTION b/DESCRIPTION
index 9afd5b4a839541e74791f057c81ca4490b3e6c2e..a927252864d975cddcb4afd075aed43b32142208 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,5 +1,5 @@
Package: stacomirtools
-Version: 0.5.3
+Version: 0.5.4
Date: 2018-10-05
Title: 'ODBC' Connection Class for Package stacomiR
Authors@R: c(person("Cedric", "Briand", role = c("aut", "cre"), email = "cedric.briand00@gmail.com"))
diff --git a/R/ConnectionDB.r b/R/ConnectionDB.r
new file mode 100644
index 0000000000000000000000000000000000000000..de9867e91d0e3dd324e73641f367376e6c81a7a2
--- /dev/null
+++ b/R/ConnectionDB.r
@@ -0,0 +1,115 @@
+
+#' @title validity function for ConnectionDB class
+validity_DB=function(object)
+{
+ rep1=class(object@base[1])=="Character"
+ rep2=class(object@base[2])=="Character"
+ rep3=class(object@base[3])=="Character"
+ rep4=class(object@base[4])=="Character"
+ rep6=class(object@base[5])=="Character"
+ rep4=length(object@base)==5
+ return(ifelse(rep1 & rep2 & rep3 & rep4 & rep5 & rep6 ,TRUE,c(1:4)[!c(rep1, rep2, rep3, rep4, rep5, rep6)]))
+}
+
+#' @title ConnectionDB class
+#' @note Mother class for connection, opens the connection but does not shut it
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+#' @slot base="vector" (of length 3, character)
+#' @slot silent="logical"
+#' @slot status="ANY" # can be -1 or string
+#' @slot connection="ANY" # could be both string or S3
+#' @return connection an S4 object of class connectionDB
+#' @examples
+#' ##this wont be run as the user need to manually configure the connection before using it
+#' \dontrun{
+#' object=new("ConnectionDB")
+#' object@base=c("yourDB", "localhost", "5432", "you", "yourPassword")
+#' object@silent=FALSE
+#' object<-connect(object)
+#' pool::dbGetInfo(object@connection)
+#' pool::poolClose(object@connection)
+#' }
+setClass(Class="ConnectionDB",
+ representation= representation(base="vector", silent="logical", status="ANY", connection="ANY"),
+ prototype = list(silent=TRUE),
+ validity=validity_DB)
+
+#' generic connect function for base
+#' @export
+setGeneric("connect", def=function(object,...) standardGeneric("connect"))
+
+#' connect method for ConnectionDB class
+#' @return a connection with slot filled
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+#' @examples
+#' object=new("ConnectionDB")
+#'
+#' object@baseDB=baseDB
+#' connect(object)
+setMethod("connect", signature=signature("ConnectionDB"), definition=function(object) {
+ if (length(object@base)!=5) {
+ if (exists("baseODBC",envir=envir_stacomi)){
+ object@base<-get("baseODBC",envir=envir_stacomi)
+ } else {
+ if (exists("envir_stacomi")){# the program is called within stacomiR
+ funout(gettext("You need to define a base vector with the dbname, host, port, user and password\n"), arret=TRUE)
+ } else {
+ stop("You need to define a base vector with the dbname, host, port, user and password")
+ }
+ }
+ }
+
+ currentConnection <- pool::dbPool(drv = RPostgres::Postgres(),
+ dbname = object@base[1],
+ host = object@base[2],
+ port = object@base[3],
+ user = object@base[4],
+ password = object@base[5],
+ minSize = 0,
+ maxSize = 2)
+
+# if (!exists("odbcConnect")) {
+# if (exists("envir_stacomi")){
+# funout("The RODBC library is necessary, please load the package",arret=TRUE)
+# } else {
+# stop("the RODBC library is necessary, please load the package")
+# }
+# }
+ if (!object@silent) {
+ if (exists("envir_stacomi")){
+ print(paste("Connection trial, warning this class should only be used for test: ", object@base[1]))
+ } else {
+ print(paste("Connection trial, warning this class should only be used for test: ", object@base[1]))
+ }
+ }
+ # sends the result of a trycatch connection in the
+ #object (current connection), e.g. a character vector
+ connection_error<-function(c)
+ {
+ if (exists("envir_stacomi")){
+ error=paste(gettext("Connection failed :\n", object@base[1]))
+ } else {
+ error= c
+ }
+ return(error)
+ }
+
+ tryCatch(pool::dbGetInfo(currentConnection), error = connection_error)
+
+ object@connection=currentConnection # an DBI object
+
+ if(pool::dbGetInfo(currentConnection)$valid)
+ object@status = "Connection OK"
+ else
+ object@status = "Something went wrong"
+
+ if (!object@silent){
+ if(exists("envir_stacomi")){
+ print(object@status)
+ } else {
+ print(object@status)
+ }
+ }
+
+ return(object)
+ })
diff --git a/R/RequeteDB.r b/R/RequeteDB.r
new file mode 100644
index 0000000000000000000000000000000000000000..83db4bcf2ef04a3774d219bbb46102a528738f2f
--- /dev/null
+++ b/R/RequeteDB.r
@@ -0,0 +1,129 @@
+# Nom fichier : RequeteDB.R
+#' @title RequeteDB class
+#' @note Inherits from ConnectionDB
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+#' @slot baseODBC="vector" (inherited from ConnectionDB)
+#' @slot silent="logical" (inherited from ConnectionDB)
+#' @slot etat="character" (inherited from ConnectionDB)
+#' @slot connection="ANY" (inherited from ConnectionDB)
+#' @slot sql="character"
+#' @slot query="data.frame"
+#' @slot open=logical is the connection left open after the request ?
+#' @examples object=new("RequeteDB")
+setClass(Class="RequeteDB",
+ representation= representation(base="character",sql="character",query="data.frame",open="logical"),
+ prototype = list(silent=TRUE,open=FALSE),
+ contains="ConnectionDB")
+
+#' connect method loads a request to the database and returns either an error or a data.frame
+#' @note assign("showmerequest",1,envir=envir_stacomi) allows to print all queries passing on the class connect
+#' @return An object of class RequeteDB
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+#' @expamples
+#' showClass("RequeteDB")
+#' \dontrun{
+#' object=new("RequeteDB")
+#' object@open=TRUE
+#' object@base=base
+#' object@sql= "select * from t_lot_lot limit 100"
+#' object<-connect(object)
+#' odbcClose(object@connection)
+#' odbcCloseAll()
+#' object=new("RequeteDB")
+#' object@open=TRUE
+#' ## this will leave the connection open,
+#' ## by default it closes after the query is sent
+#' ## the following will work only if you have configured and ODBC link
+#' object@baseODBC=c("myODBCconnection","myusername","mypassword")
+#' object@sql= "select * from mytable limit 100"
+#' object<-connect(object)
+#' odbcClose(object@connection)
+#' envir_stacomi=new.env()
+#' ## While testing if you want to see the output of sometimes complex queries generated by the program
+#' assign("showmerequest",1,envir_stacomi)
+#' ## You can assign any values (here 1)
+#' ## just tests the existence of "showmerequest" in envir_stacomi
+#' object=new("RequeteDB")
+#' object@baseODBC=c("myODBCconnection","myusername","mypassword")
+#' object@sql= "select * from mytable limit 100"
+#' object<-connect(object)
+#' ## the connection is already closed, the query is printed
+#'}
+setMethod("connect",signature=signature("RequeteDB"),definition=function(object) {
+ msg1<-gettext("'ODBC' error =>you have to define a vector baseODBC with the 'ODBC' link name, user and password")
+ msg2<-gettext("connection trial :")
+ msg3<-gettext("connection impossible")
+ msg4<-gettext("connection successfull")
+ msg5<-gettext("request trial")
+ msg6<-gettext("success")
+ if (exists("envir_stacomi")){
+ verbose<-exists("showmerequest",envir=envir_stacomi)
+ } else {
+ verbose <- FALSE
+ }
+ funout<-function(text,arret=FALSE){
+ if(arret) stop(text) else print(text)
+ return(NULL)
+ }
+
+ killfactor=function(df){
+ for (i in 1:ncol(df))
+ {
+ if(is.factor(df[,i])) df[,i]=as.character(df[,i])
+ }
+ return(df)
+ }
+
+ # The connection might already be opened, we will avoid to go through there !
+ if (is.null(object@connection)){
+ if (length(object@baseODBC)!=3) {
+ if (exists("baseODBC",envir=envir_stacomi)) {
+ object@baseODBC<-get("baseODBC",envir=envir_stacomi)
+ } else {
+ funout(msg1,arret=TRUE)
+ }
+ }
+ # opening of 'ODBC' connection
+ e=expression(channel <-odbcConnect(object@baseODBC[1],
+ uid = object@baseODBC[2],
+ pwd = object@baseODBC[3],
+ case = "tolower",
+ believeNRows = FALSE))
+ if (!object@silent) funout(paste(msg2,object@baseODBC[1],"\n"))
+ # send the result of a try catch expression in
+ #the Currentconnection object ie a character vector
+ object@connection<-tryCatch(eval(e), error=paste(msg3 ,object@baseODBC))
+ # un object S3 RODBC
+ if (class(object@connection)=="RODBC") {
+ if (!object@silent)funout(msg4)
+ object@etat=msg4# success
+ } else {
+ object@etat<-object@connection # report of the error
+ object@connection<-NULL
+ funout(msg3,arret=TRUE)
+ }
+ # sending the query
+ }
+ if (!object@silent) funout(msg5) # query trial
+ if (verbose) print(object@sql)
+ query<-data.frame() # otherwise, query called in the later expression is evaluated as a global variable by RCheck
+ e=expression(query<-sqlQuery(object@connection,object@sql,errors=TRUE))
+ if (object@open) {
+ # If we want to leave the connection open no finally clause
+ resultatRequete<-tryCatch(eval(e),error = function(e) e)
+ } else {
+ # otherwise the connection is closed while ending the request
+ resultatRequete<-tryCatch(eval(e),error = function(e) e,finally=RODBC::odbcClose(object@connection))
+ }
+ if ((class(resultatRequete)=="data.frame")[1]) {
+ if (!object@silent) funout(msg6)
+ object@query=killfactor(query)
+ object@etat=msg6
+ } else {
+ if (!object@silent) print(resultatRequete)
+ object@etat=as.character(resultatRequete)
+ print(object@etat)
+ }
+ return(object)
+
+ })
diff --git a/inst/config/test.R b/inst/config/test.R
index 3d4a3d510954fd525adfaa28daaf559ef18998f4..1b1339717b0b4584fb433e2a94cfb2028b2c1087 100644
--- a/inst/config/test.R
+++ b/inst/config/test.R
@@ -1,5 +1,7 @@
# Name : test.R
-setwd("c:/workspace/stacomir/pkg/stacomirtools")
+#setwd("C:/workspace/stacomirtools2")
+devtools::load_all()
devtools::test()
+
diff --git a/tests/testthat/test-00-connectiondb.R b/tests/testthat/test-00-connectiondb.R
new file mode 100644
index 0000000000000000000000000000000000000000..35a7f23fa31ee78379882a51c9041fd99f9d3f63
--- /dev/null
+++ b/tests/testthat/test-00-connectiondb.R
@@ -0,0 +1,17 @@
+# Name : test-00.R
+context("ConnectionDB")
+
+test_that("Test that ConnectionDB returns a pool object and closes ", {
+ skip_on_cran()
+ req<-new("ConnectionDB")
+ #' object=new("ConnectionDB")
+ req@base=c("bd_contmig_nat", "localhost", "5432", userlocal, passwordlocal)
+ req@silent=FALSE
+ req<-connect(req)
+ expect_true(pool::dbGetInfo(req@connection)$valid)
+ pool::poolClose(req@connection)
+ expect_error(pool::dbGetInfo(req@connection)$valid)
+
+ })
+
+
diff --git a/tests/testthat/test-00.R b/tests/testthat/test-01-connectionODBC.R
similarity index 100%
rename from tests/testthat/test-00.R
rename to tests/testthat/test-01-connectionODBC.R