[Stacomir-commits] r572 - in pkg/stacomirtools: . R dev inst/config man tests tests/tests tests/tests/testthat tests/testthat

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Mon Oct 25 21:27:10 CEST 2021


Author: briand
Date: 2021-10-25 21:27:10 +0200 (Mon, 25 Oct 2021)
New Revision: 572

Added:
   pkg/stacomirtools/R/ConnectionDB.R
   pkg/stacomirtools/R/ConnectionODBC.R
   pkg/stacomirtools/R/RequeteDB.R
   pkg/stacomirtools/R/RequeteDBwhere.R
   pkg/stacomirtools/R/RequeteDBwheredate.R
   pkg/stacomirtools/R/RequeteODBC.R
   pkg/stacomirtools/R/RequeteODBCwhere.R
   pkg/stacomirtools/R/RequeteODBCwheredate.R
   pkg/stacomirtools/R/stacomirtools.R
   pkg/stacomirtools/R/utilities.R
   pkg/stacomirtools/README.Rmd
   pkg/stacomirtools/README.md
   pkg/stacomirtools/dev/
   pkg/stacomirtools/dev/01_start.R
   pkg/stacomirtools/dev/02_dev.R
   pkg/stacomirtools/dev/03_deploy.R
   pkg/stacomirtools/dev/run_dev.R
   pkg/stacomirtools/inst/config/benchmark.R
   pkg/stacomirtools/man/ConnectionDB-class.Rd
   pkg/stacomirtools/man/RequeteDB-class.Rd
   pkg/stacomirtools/man/RequeteDBwhere-class.Rd
   pkg/stacomirtools/man/RequeteDBwheredate-class.Rd
   pkg/stacomirtools/man/connect-ConnectionDB-method.Rd
   pkg/stacomirtools/man/connect-ConnectionODBC-method.Rd
   pkg/stacomirtools/man/connect-RequeteODBC-method.Rd
   pkg/stacomirtools/man/connect-RequeteODBCwhere-method.Rd
   pkg/stacomirtools/man/connect-RequeteODBCwheredate-method.Rd
   pkg/stacomirtools/man/connect.Rd
   pkg/stacomirtools/man/figures/
   pkg/stacomirtools/man/query-RequeteDB-method.Rd
   pkg/stacomirtools/man/query-RequeteDBwhere-method.Rd
   pkg/stacomirtools/man/query-RequeteDBwheredate-method.Rd
   pkg/stacomirtools/man/query.Rd
   pkg/stacomirtools/man/validity_DB.Rd
   pkg/stacomirtools/man/validity_ODBC.Rd
   pkg/stacomirtools/tests/tests/
   pkg/stacomirtools/tests/tests/testthat.R
   pkg/stacomirtools/tests/tests/testthat/
   pkg/stacomirtools/tests/tests/testthat/_snaps/
   pkg/stacomirtools/tests/tests/testthat/test-00-connectiondb.R
   pkg/stacomirtools/tests/tests/testthat/test-01-connectionODBC.R
   pkg/stacomirtools/tests/tests/testthat/test-02-requeteDB.R
   pkg/stacomirtools/tests/tests/testthat/test-03-requeteODBC.R
   pkg/stacomirtools/tests/tests/testthat/test-04-requeteODBCwhere.R
   pkg/stacomirtools/tests/tests/testthat/test-05-requeteODBCwheredate.R
   pkg/stacomirtools/tests/tests/testthat/test-06-requeteDBwhere.R
   pkg/stacomirtools/tests/tests/testthat/test-07-requeteDBwheredate.R
   pkg/stacomirtools/tests/testthat/_snaps/
   pkg/stacomirtools/tests/testthat/test-00-connectiondb.R
   pkg/stacomirtools/tests/testthat/test-01-connectionODBC.R
   pkg/stacomirtools/tests/testthat/test-02-requeteDB.R
   pkg/stacomirtools/tests/testthat/test-03-requeteODBC.R
   pkg/stacomirtools/tests/testthat/test-04-requeteODBCwhere.R
   pkg/stacomirtools/tests/testthat/test-05-requeteODBCwheredate.R
   pkg/stacomirtools/tests/testthat/test-06-requeteDBwhere.R
   pkg/stacomirtools/tests/testthat/test-07-requeteDBwheredate.R
Removed:
   pkg/stacomirtools/R/ConnectionODBC.r
   pkg/stacomirtools/R/RequeteODBC.r
   pkg/stacomirtools/R/RequeteODBCwhere.r
   pkg/stacomirtools/R/RequeteODBCwheredate.r
   pkg/stacomirtools/R/stacomirtools.r
   pkg/stacomirtools/R/utilities.r
Modified:
   pkg/stacomirtools/DESCRIPTION
   pkg/stacomirtools/NAMESPACE
   pkg/stacomirtools/R/stacomirtools-package.R
   pkg/stacomirtools/man/ConnectionODBC-class.Rd
   pkg/stacomirtools/man/RequeteODBC-class.Rd
   pkg/stacomirtools/man/RequeteODBCwhere-class.Rd
   pkg/stacomirtools/man/RequeteODBCwheredate-class.Rd
   pkg/stacomirtools/man/chnames.Rd
   pkg/stacomirtools/man/ex.Rd
   pkg/stacomirtools/man/funhtml.Rd
   pkg/stacomirtools/man/funout.Rd
   pkg/stacomirtools/man/induk.Rd
   pkg/stacomirtools/man/is.even.Rd
   pkg/stacomirtools/man/is.odd.Rd
   pkg/stacomirtools/man/killfactor.Rd
   pkg/stacomirtools/man/tab2df.Rd
Log:
upgrading to version 0.6

Modified: pkg/stacomirtools/DESCRIPTION
===================================================================
--- pkg/stacomirtools/DESCRIPTION	2021-10-11 08:08:59 UTC (rev 571)
+++ pkg/stacomirtools/DESCRIPTION	2021-10-25 19:27:10 UTC (rev 572)
@@ -1,23 +1,37 @@
-Package: stacomirtools
-Version: 0.5.4
-Date: 2020-04-03
-Title: 'ODBC' Connection Class for Package stacomiR
-Authors at R: c(person("Cedric", "Briand", role = c("aut", "cre"), email = "cedric.briand00 at gmail.com"))
-Author: Cedric Briand [aut, cre]
-Maintainer: Cedric Briand <cedric.briand00 at gmail.com>
-Description: S4 class wrappers for the 'ODBC' connection, also provides some 
-    utilities to paste small datasets to clipboard, rename columns. It is used by the package 'stacomiR' for
-    connections to the database. Development versions of 'stacomiR' are available in R-forge.
-License: GPL (>= 2)
-Collate:
-    'ConnectionODBC.r'
-    'RequeteODBC.r'
-    'RequeteODBCwhere.r'
-    'RequeteODBCwheredate.r'
-    'utilities.r'   
-    'stacomirtools.r'
-    'stacomirtools-package.R' 
-LazyLoad: yes
-Depends: RODBC
-Imports: methods,xtable,utils
-Suggests: testthat
+Package: stacomirtools
+Version: 0.6.0.9000
+Date: 2021-10-22
+Title: 'ODBC' Connection Class for Package stacomiR
+Authors at R: c(
+              person("Cedric", "Briand", role = c("aut", "cre"), email = "cedric.briand00 at gmail.com"),
+              person("Marion", "Legrand", role = "aut", email = "<tableau-salt-loire at logrami.fr>"),
+              person("Beaulaton", "Laurent", role = "aut", email = "<laurent.beaulaton at ofb.gouv.fr>"))
+Author: Cedric Briand [aut, cre]
+Maintainer: Cedric Briand <cedric.briand00 at gmail.com>
+Description: S4 class wrappers for the 'ODBC' and Pool dbi connection, also provides some 
+    utilities to paste small datasets to clipboard, rename columns. It is used by the package 'stacomiR' for
+    connections to the database. Development versions of 'stacomiR' are available in R-forge.
+License: GPL (>= 2)
+Collate: 'ConnectionODBC.R' 'RequeteODBC.R' 'RequeteODBCwhere.R'
+        'RequeteODBCwheredate.R' 'utilities.R' 'stacomirtools.R'
+        'stacomirtools-package.R''ConnectionDB.R' 'RequeteDB.R' 'RequeteDBwhere.R'
+        'RequeteDBwheredate.R'
+LazyLoad: yes
+Depends: RODBC, DBI, pool
+Imports: 
+    methods,
+    xtable,
+    utils,
+    RPostgres,
+    stacomirtools (>= 0.5.3)
+Suggests: testthat, stacomiR
+Repository: CRAN
+Repository/R-Forge/Project: stacomir
+Repository/R-Forge/Revision: 540
+Repository/R-Forge/DateTimeStamp: 2018-10-06 06:18:25
+Date/Publication: 2018-10-06 07:40:02 UTC
+NeedsCompilation: no
+Packaged: 2018-10-06 06:25:10 UTC; rforge
+RoxygenNote: 7.1.2
+Remotes:  
+    Remotes: gitlab::git at forgemia.inra.fr:stacomi/stacomirtools.git

Modified: pkg/stacomirtools/NAMESPACE
===================================================================
--- pkg/stacomirtools/NAMESPACE	2021-10-11 08:08:59 UTC (rev 571)
+++ pkg/stacomirtools/NAMESPACE	2021-10-25 19:27:10 UTC (rev 572)
@@ -1,17 +1,26 @@
-exportMethods(
-    "connect")
-exportClasses(
-	"ConnectionODBC",
-     "RequeteODBC",
-     "RequeteODBCwhere",
-     "RequeteODBCwheredate")
+# Generated by roxygen2: do not edit by hand
+
 export(chnames)
+export(connect)
+export(ex)
+export(funhtml)
+export(funout)
+export(induk)
 export(is.even)
 export(is.odd)
 export(killfactor)
 export(tab2df)
-export(induk)
-export(ex)
-export(funhtml)
-importFrom("methods", "as", "slot", "slot<-","new")
-import("RODBC")
\ No newline at end of file
+exportClasses(ConnectionDB)
+exportClasses(ConnectionODBC)
+exportClasses(RequeteDB)
+exportClasses(RequeteDBwhere)
+exportClasses(RequeteDBwheredate)
+exportClasses(RequeteODBC)
+exportClasses(RequeteODBCwhere)
+exportClasses(RequeteODBCwheredate)
+exportMethods(connect)
+exportMethods(query)
+import(RODBC)
+import(methods)
+import(pool)
+importFrom(DBI,dbGetQuery)

Added: pkg/stacomirtools/R/ConnectionDB.R
===================================================================
--- pkg/stacomirtools/R/ConnectionDB.R	                        (rev 0)
+++ pkg/stacomirtools/R/ConnectionDB.R	2021-10-25 19:27:10 UTC (rev 572)
@@ -0,0 +1,151 @@
+
+#' validity function for ConnectionDB class 
+#' @param object An object of class ConnectionDB
+validity_DB=function(object)
+{
+	rep1 <- length(object at dbname)==1
+	rep2 <- length(object at host)==1
+	rep3 <- length(object at port)==1
+	rep4 <- length(object at user)==1	
+	rep5 <- length(object at password)==1
+	
+	return(ifelse(rep1 & rep2 & rep3 & rep4 & rep5  ,TRUE,
+					c(gettext("dbname should be of length 1"),
+							gettext("host should be of length 1"),
+							gettext("port should be of length 1"),
+							gettext("user should be of length 1"),
+							gettext("password should be of length 1"))[
+							!c(rep1, rep2, rep3, rep4, rep5)]))
+}
+
+#' @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 dbname name of the database, length 1
+#' @slot host host default "localhost", length 1
+#' @slot port port of the database default "5432", length 1
+#' @slot user user of the database, length 1
+#' @slot password password for the datatbase, length 1
+#' @slot silent A "logical" stating if the program returns output to the user
+#' @slot status  Can be -1 or string
+#' @slot connection  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 at dbname <- c("bd_contmig_nat","test")
+#' object at host <- 		"localhost"
+#' object at port <-		"5432"
+#' object at user <-		"myuser"
+#' object at password <-		"mypassword"
+#' object at silent=FALSE
+#' object <- connect(object)
+#' pool::dbGetInfo(object at connection)
+#' pool::poolClose(object at connection)
+#' }
+#' @export
+setClass(Class="ConnectionDB",
+		representation= representation(
+				dbname="character", 
+				host ="character",
+				port="character",
+				user="character",
+				password="character",				
+				silent="logical", 
+				status="ANY", 
+				connection="ANY"),
+		prototype = list(silent=TRUE,dbname="bd_contmig_nat", user="postgres", 
+				port="5432"),
+		validity=validity_DB)
+
+#constructor
+
+#' connect method for ConnectionDB class
+#' @param object An object of class ConnectionDB
+#' @param base a string with values for dbname, host, port, user, password, in this order.
+#' @return a connection with slot filled
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+#' @examples 
+#' \dontrun{
+#' object <- new("ConnectionDB")
+#' object at dbname <- c("bd_contmig_nat","test")
+#' object at host <- 		"localhost"
+#' object at port <-		"5432"
+#' object at user <-		"myuser"
+#' object at password <-		"mypassword"
+#' object at silent=FALSE
+#' object <- connect(object)
+#' pool::dbGetInfo(object at connection)
+#' pool::poolClose(object at connection)
+#' }
+setMethod("connect", signature=signature("ConnectionDB"), 
+		definition=function(object, base=NULL) {     
+			if (!is.null(base)) {
+				object at dbname <- base[1]
+				object at host=base[2]
+				object at port=base[3]
+				object at user=base[4]
+				object at password=base[5]
+			}
+			test <- validObject(object, test=TRUE)
+			if (is.character(test)) {
+				funout(test, arret=TRUE)
+			}
+			
+			
+			currentConnection <- pool::dbPool(drv = RPostgres::Postgres(), 
+					dbname = object at dbname,
+					host = object at host,
+					port = object at port,
+					user = object at user,
+					password = object at password,
+					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 at silent) {
+				if (exists("envir_stacomi")){
+					print(paste("Connection trial, warning this class should only be used for test: ", object at dbname))
+				} else {
+					print(paste("Connection trial, warning this class should only be used for test: ", object at dbname))
+				}
+			}	
+			# 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 at dbname))
+				} else {
+					error= c
+				}
+				return(error)
+			}
+			
+			tryCatch(pool::dbGetInfo(currentConnection), error = connection_error)
+			
+			object at connection=currentConnection # an DBI object
+			
+			if(pool::dbGetInfo(currentConnection)$valid)
+				object at status = "Connection OK"
+			else
+				object at status = "Something went wrong"
+			
+			if (!object at silent){
+				if(exists("envir_stacomi")){
+					print(object at status)
+				} else {
+					print(object at status)
+				}
+			} 
+			
+			return(object)
+		}
+)
\ No newline at end of file

Added: pkg/stacomirtools/R/ConnectionODBC.R
===================================================================
--- pkg/stacomirtools/R/ConnectionODBC.R	                        (rev 0)
+++ pkg/stacomirtools/R/ConnectionODBC.R	2021-10-25 19:27:10 UTC (rev 572)
@@ -0,0 +1,115 @@
+
+#' Validity method for ODBC class
+#' @param object an object of class ConnectionODBC
+validity_ODBC=function(object)
+{
+	rep1= class(object at baseODBC[1])=="Character"
+	rep2=class(object at baseODBC[2])=="Character"
+	rep3=class(object at baseODBC[3])=="ANY"
+	rep4=length(object at baseODBC)==3
+	return(ifelse(rep1 & rep2 & rep3 & rep4,TRUE,c(1:4)[!c(rep1, rep2, rep3, rep4)]))
+}
+
+#' @title ConnectionODBC 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 baseODBC "vector" (of length 3, character)
+#' @slot silent "logical" 
+#' @slot etat "ANY" # can be -1 or string
+#' @slot connection "ANY" # could be both string or S3
+#' @return connectionODBC an S4 object of class connectionODBC
+#' @examples 
+#' ##this wont be run as the user need to manually configure the connection before using it
+#' \dontrun{
+#' object=new("ConnectionODBC")
+#' object at baseODBC=c("myODBCconnection","myusername","mypassword")
+#' object at silent=FALSE
+#' object<-connect(object)
+#' odbcClose(object at connection)
+#' }
+#' @export
+setClass(Class="ConnectionODBC",
+		representation= representation(baseODBC="vector",silent="logical",etat="ANY",connection="ANY"),
+		prototype = list(silent=TRUE),
+		validity=validity_ODBC)
+
+#' generic connect function for baseODBC
+#' @param object an object
+#' @param ... additional arguments passed on to the connect method 
+#' @export   
+setGeneric("connect",def=function(object,...) standardGeneric("connect"))
+
+#' connect method for ConnectionODBC class
+#' @param object an object of class ConnectionODBC
+#' @return a connection with slot filled
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+#' @examples 
+#' ##this wont be run as the user need to manually configure the connection before using it
+#' \dontrun{
+#' object=new("ConnectionODBC")
+#' object at baseODBC=c("myODBCconnection","myusername","mypassword")
+#' object at silent=FALSE
+#' object<-connect(object)
+#' odbcClose(object at connection)
+#' }
+setMethod("connect",signature=signature("ConnectionODBC"),definition=function(object) {
+			.Deprecated(new= "ConnectionDB", old="ConnectionODBC")			
+			if (length(object at baseODBC)!=3)  {
+				if (exists("baseODBC",envir=envir_stacomi)){ 
+					object at baseODBC<-get("baseODBC",envir=envir_stacomi) 
+				} else {
+					if (exists("envir_stacomi")){# the program is called within stacomiR
+						funout(gettext("You need to define a baseODBC vector with the 'ODBC' link, the user and the password\n"),arret=TRUE)
+					} else	  {
+						stop("you need to define a vector baseODBC with the 'ODBC' link, user and password")
+					}
+				}
+			}
+			e=expression(channel <-odbcConnect(object at baseODBC[1],
+							uid = object at baseODBC[2],
+							pwd = object at baseODBC[3],
+							case = "tolower",
+							believeNRows = FALSE))
+			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 at silent) {
+				if (exists("envir_stacomi")){
+					print(paste("connection trial, warning this class should only be used for test: ",object at baseODBC[1]))
+				} else {
+					print(paste("connection trial, warning this class should only be used for test: ",object at baseODBC[1]))
+				}
+			}	
+			# sends the result of a trycatch connection in the
+			#l'object (current connection), e.g. a character vector
+			connection_error<-if (exists("envir_stacomi")){
+						error=paste(gettext("Connection failed :\n",object at baseODBC[1]))
+					} else {
+						error="impossible connection"
+					}
+			currentConnection<-tryCatch(eval(e), error=connection_error) 
+			if (class(currentConnection)=="RODBC") {
+				if (!object at silent){
+					if(exists("envir_stacomi")){
+						print(gettext("Connection successful"))
+					} else {
+						print("connection successful")
+					}
+				} 
+				object at connection=currentConnection  # an object S3 RODBC
+				if(exists("envir_stacomi")){
+					state<-"Connection in progress"
+				} else {
+					state<-"Connection in progress"
+				}
+				object at etat=state
+			} else {
+				funout(currentConnection)
+				object at etat=currentConnection # reporting error
+			}
+			return(object)
+		})
\ No newline at end of file

Deleted: pkg/stacomirtools/R/ConnectionODBC.r
===================================================================
--- pkg/stacomirtools/R/ConnectionODBC.r	2021-10-11 08:08:59 UTC (rev 571)
+++ pkg/stacomirtools/R/ConnectionODBC.r	2021-10-25 19:27:10 UTC (rev 572)
@@ -1,106 +0,0 @@
-
-validity_ODBC=function(object)
-{
-	rep1= class(object at baseODBC[1])=="Character"
-	rep2=class(object at baseODBC[2])=="Character"
-	rep3=class(object at baseODBC[3])=="ANY"
-	rep4=length(object at baseODBC)==3
-	return(ifelse(rep1 & rep2 & rep3 & rep4,TRUE,c(1:4)[!c(rep1, rep2, rep3, rep4)]))
-}
-
-#' @title ConnectionODBC 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 baseODBC="vector" (of length 3, character)
-#' @slot silent="logical"
-#' @slot etat="ANY" # can be -1 or string
-#' @slot connection="ANY" # could be both string or S3
-#' @slot sql="character"
-#' @slot query="data.frame"
-#' @return connectionODBC an S4 object of class connectionODBC
-#' @examples 
-#' ##this wont be run as the user need to manually configure the connection before using it
-#' \dontrun{
-#' object=new("ConnectionODBC")
-#' object at baseODBC=c("myODBCconnection","myusername","mypassword")
-#' object at silent=FALSE
-#' object<-connect(object)
-#' odbcClose(object at connection)
-#' }
-setClass(Class="ConnectionODBC",
-		representation= representation(baseODBC="vector",silent="logical",etat="ANY",connection="ANY"),
-		prototype = list(silent=TRUE),
-		validity=validity_ODBC)
-    
-#' generic connect function for baseODBC
-#' @export   
-setGeneric("connect",def=function(object,...) standardGeneric("connect"))
-
-#' connect method for ConnectionODBC class
-#' @return a connection with slot filled
-#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
-#' @examples 
-#' object=new("ConnectionODBC")
-#' 
-#' object at baseODBC=baseODBC
-#' connect(object)
-setMethod("connect",signature=signature("ConnectionODBC"),definition=function(object) {     
-			if (length(object at baseODBC)!=3)  {
-				if (exists("baseODBC",envir=envir_stacomi)){ 
-					object at baseODBC<-get("baseODBC",envir=envir_stacomi) 
-				} else {
-					if (exists("envir_stacomi")){# the program is called within stacomiR
-						funout(gettext("You need to define a baseODBC vector with the 'ODBC' link, the user and the password\n"),arret=TRUE)
-					} else	  {
-						stop("you need to define a vector baseODBC with the 'ODBC' link, user and password")
-					}
-				}
-			}
-			e=expression(channel <-odbcConnect(object at baseODBC[1],
-							uid = object at baseODBC[2],
-							pwd = object at baseODBC[3],
-							case = "tolower",
-							believeNRows = FALSE))
-			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 at silent) {
-				if (exists("envir_stacomi")){
-					print(paste("connection trial, warning this class should only be used for test: ",object at baseODBC[1]))
-				} else {
-					print(paste("connection trial, warning this class should only be used for test: ",object at baseODBC[1]))
-				}
-			}	
-			# sends the result of a trycatch connection in the
-			#l'object (current connection), e.g. a character vector
-			connection_error<-if (exists("envir_stacomi")){
-						error=paste(gettext("Connection failed :\n",object at baseODBC[1]))
-					} else {
-						error="impossible connection"
-					}
-			currentConnection<-tryCatch(eval(e), error=connection_error) 
-			if (class(currentConnection)=="RODBC") {
-				if (!object at silent){
-					if(exists("envir_stacomi")){
-						print(gettext("Connection successful"))
-					} else {
-						print("connection successful")
-					}
-				} 
-				object at connection=currentConnection  # an object S3 RODBC
-				if(exists("envir_stacomi")){
-					state<-"Connection in progress"
-				} else {
-					state<-"Connection in progress"
-				}
-				object at etat=state
-			} else {
-				funout(currentConnection)
-				object at etat=currentConnection # reporting error
-			}
-			return(object)
-		})

Added: pkg/stacomirtools/R/RequeteDB.R
===================================================================
--- pkg/stacomirtools/R/RequeteDB.R	                        (rev 0)
+++ pkg/stacomirtools/R/RequeteDB.R	2021-10-25 19:27:10 UTC (rev 572)
@@ -0,0 +1,112 @@
+# Nom fichier :        RequeteDB.R 
+#' @title RequeteDB class 
+#' @note Inherits from ConnectionDB
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+#' @slot sql "character"
+#' @slot query "data.frame"
+#' @slot open logical is the connection left open after the request ?
+#' @examples
+#'  object=new("RequeteDB")
+#' @export
+setClass(Class="RequeteDB",
+		representation= representation(sql="character",query="data.frame",open="logical"),
+		prototype = list(silent=TRUE,open=FALSE),
+		contains="ConnectionDB")
+
+#' generic query function for  
+#' @param object an object
+#' @param ... additional parameters passed to query
+setGeneric("query", def=function(object, ...) standardGeneric("query"))
+
+#' query method loads a quert to the data and returns either an error or a data.frame
+#' @param object an object of class RequeteDB
+#' @param ... further arguments passed to the query method, base will be passed to ConnectionDB to set the connection parameters,
+#' it should be a vector with dbname host port user and password (in this order) 
+#' @note assign("showmerequest",1,envir=envir_stacomi) allows to print all queries passing on the class RequeteDB
+#' @return An object of class RequeteDB
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+#' @importFrom DBI dbGetQuery
+#' @examples 
+#' showClass("RequeteDB")
+#' \dontrun{
+#' # this connection require user and password and a working data
+#'  object=new("RequeteDB",dbname ="bd_contmig_nat",
+#' 			host ="localhost", port="5432", user ="postgres", password="secret")
+#' )
+#' object at 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 at sql= "select * from t_lot_lot limit 100"
+#' object<-query(object)
+#'   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 at sql= "select * from mytable limit 100"
+#'   object<-connect(object)
+#'  ## the connection is already closed, the query is printed
+#'}
+setMethod("query",signature=signature("RequeteDB"),
+		definition=function(object, ...) {
+			msg1 <- gettext("'DB' error you have to define a vector  with the 'DB' link name, host, port, user and password")
+			msg2 <- gettext("connection trial :")
+			msg3 <- gettext("Connection failure")
+			msg4 <- gettext("connection successfull")
+			msg5 <- gettext("request trial")
+			msg6 <- gettext("success")
+			if (requireNamespace("stacomiR", quietly = TRUE)){
+				if (exists("envir_stacomi", where =asNamespace("stacomiR"), mode="environment")){
+					verbose <- exists("showmerequest",envir=envir_stacomi)
+				} else {
+					verbose <- FALSE
+				}
+			} else {
+				verbose <- FALSE
+				
+			}
+			# The connection might already be opened, we will avoid to go through there !
+			if (is.null(object at connection)){ 						
+				# opening of connection
+				e=expression(channel <- connect(object, ...))
+				if (!object at silent) funout(paste(msg2, object at dbname, "\n"))
+				# send the result of a try catch expression in
+				#the Currentconnection object ie a character vector
+				object<-tryCatch(eval(e), error=paste(msg3 ,object at dbname)) 
+				# un object S3 RODBC
+				if (any(class(object at connection)=="Pool")) {
+					if (!object at silent) funout(msg4)
+					object at status <- msg4# success
+				} else {
+					object at status <- object at connection # report of the error
+					object at connection <- NULL
+					funout(msg3, arret=TRUE)
+				}
+				# sending the query
+			} 
+			if (!object at silent) funout(msg5) # query trial
+			if (verbose) print(object at sql)
+			query <- data.frame() # otherwise, query called in the later expression is evaluated as a global variable by RCheck
+			e=expression(query<- dbGetQuery(object at connection,object at sql,errors=TRUE))
+			if (object at 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=pool::poolClose(object at connection))
+			}
+			if (any(class(resultatRequete)=="data.frame")) {
+				if (!object at silent) funout(msg6)
+				object at query <- killfactor(query)    
+				object at status <- msg6
+			} else {
+				if (!object at silent) print(resultatRequete)
+				object at status <- as.character(resultatRequete)
+				print(object at status)
+			}
+			return(object)
+			
+		}
+)
\ No newline at end of file

Added: pkg/stacomirtools/R/RequeteDBwhere.R
===================================================================
--- pkg/stacomirtools/R/RequeteDBwhere.R	                        (rev 0)
+++ pkg/stacomirtools/R/RequeteDBwhere.R	2021-10-25 19:27:10 UTC (rev 572)
@@ -0,0 +1,50 @@
+#' @title RequeteDBwhere class 
+#' @note Inherits from RequeteDB
+#' the syntax is where="WHERE ..."
+#' and =vector("AND...","AND...")
+#' order_by="ORDER BY.."
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+#' @slot select "character"
+#' @slot where "character"
+#' @slot and "vector"
+#' @slot order_by "character"
+#' @examples
+#'  object=new("RequeteDBwhere")
+#' @export
+setClass(Class="RequeteDBwhere",
+		representation= representation(select="character",where="character",and="vector",order_by="character"),
+		prototype = list(silent=TRUE,open=FALSE),contains="RequeteDB")
+
+
+
+setAs("RequeteDBwhere","RequeteDB",function(from,to){
+			requeteDB=new("RequeteDB")
+			requeteDB at sql=paste(from at select,from at where,paste(from at and,collapse=" "),from at order_by,";",sep=" ")
+			requeteDB at silent=from at silent
+			# other slots will be filled in by connect	
+			return(requeteDB)
+		})
+#' query method loads a request to the database and returns either an error or a data.frame
+#' @param object an object of class RequeteDBwhere
+#' @param ... further arguments passed to the query method, base will be passed to ConnectionDB to set the connection parameters,
+#' @return An object of class RequeteODBCwhere
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+#' @examples 
+#' \dontrun{
+#' object<-new("RequeteODBCwhere")
+#' base=c("bd_contmig_nat","localhost","5432","user", "password")
+#' object at sql<- "select * from t_lot_lot"
+#' object at where<-"WHERE lot_tax_code='2038'"
+#' object at and<-c("AND lot_std_code='CIV'","AND lot_ope_identifiant<1000")
+#' object at order_by<-"ORDER BY lot_identifiant"
+#' object <- connect(object, base)
+#'}
+setMethod("query",signature=signature("RequeteDBwhere"),definition=function(object, ...) {
+			requeteDB <- as(object,"RequeteDB")
+			requeteDB <- query(requeteDB, ...) # uses mother class method
+			object at sql <- requeteDB at sql
+			object at connection <- requeteDB at connection
+			object at query <- requeteDB at query
+			object at status <- requeteDB at status
+			return(object)
+		})

Added: pkg/stacomirtools/R/RequeteDBwheredate.R
===================================================================
--- pkg/stacomirtools/R/RequeteDBwheredate.R	                        (rev 0)
+++ pkg/stacomirtools/R/RequeteDBwheredate.R	2021-10-25 19:27:10 UTC (rev 572)
@@ -0,0 +1,59 @@
+#' @title RequeteDBwhere class 
+#' @note Inherits from RequeteDBwhere and uses its connect method with a new SetAs
+#' @slot datedebut "POSIXlt"
+#' @slot datefin "POSIXlt"
+#' @slot colonnedebut "character" # name of the column containing datedebut
+#' @slot colonnefin "character"  # name of the column containing datefin
+#' @examples object=new("RequeteDBwhere")
+#' @export
+setClass(Class="RequeteDBwheredate",
+		representation= representation(datedebut="POSIXlt",datefin="POSIXlt",colonnedebut="character",colonnefin="character"),
+		prototype = list(silent=TRUE,open=FALSE),contains="RequeteDBwhere")
+
+
+setAs("RequeteDBwheredate","RequeteDBwhere",function(from,to){
+			requeteDBwhere=new("RequeteDBwhere")
+			requeteDBwhere at where=paste("WHERE (",from at colonnedebut,
+					", ",from at colonnefin,
+					") overlaps ('",
+					from at datedebut,"'::timestamp without time zone, '",
+					from at datefin,"'::timestamp without time zone) ",sep="")
+			requeteDBwhere at and=paste(from at and,sep=" ") # concatenation du vecteur
+			requeteDBwhere at select=from at select
+			requeteDBwhere at order_by=from at order_by
+			requeteDBwhere at silent=from at silent
+			# other slots will be filled in by connect	
+			return(requeteDBwhere)
+		})
+#' query method loads a request to the database and returns either an error or a data.frame
+#' @param object an object of class RequeteDBwheredate
+#' @param ... further arguments passed to the query method, base will be passed to ConnectionDB to set the connection parameters,
+#' @return An object of class RequeteDBwheredate
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+#' @examples 
+#' \dontrun{
+#' object<-new("RequeteDBwheredate")
+#' base=c("bd_contmig_nat","localhost","5432","user", "password")
+#' object at select<- "select * from t_operation_ope"
+#' object at datedebut=strptime("1996-01-01 00:00:00",format="%Y-%m-%d %H:%M:%S")
+#' object at datefin=strptime("2000-01-01 00:00:00",format="%Y-%m-%d %H:%M:%S")
+#' object at colonnedebut="ope_date_debut"
+#' object at colonnefin="ope_date_fin"
+#' object at and<-c("AND ope_dic_identifiant=1","AND ope_dic_identifiant=2")
+#' object at order_by<-"ORDER BY ope_identifiant"
+#' object at silent=FALSE
+#' object<-connect(object, base)
+#' }
+setMethod("query",signature=signature("RequeteDBwheredate"),
+		definition=function(object, ...) {
+			requeteDBwhere=as(object,"RequeteDBwhere")
+			requeteDBwhere=query(requeteDBwhere, ...) # use the connect method of DBwhere
+			# collects in the object the elements of the query
+			object at where <- requeteDBwhere at where
+			object at connection <- requeteDBwhere at connection
+			object at query <- requeteDBwhere at query
+			object at status <- requeteDBwhere at status
+			object at sql <- requeteDBwhere at sql
+			return(object)
+		})
+

Added: pkg/stacomirtools/R/RequeteODBC.R
===================================================================
--- pkg/stacomirtools/R/RequeteODBC.R	                        (rev 0)
+++ pkg/stacomirtools/R/RequeteODBC.R	2021-10-25 19:27:10 UTC (rev 572)
@@ -0,0 +1,122 @@
+#' @title RequeteODBC class 
+#' @note Inherits from ConnectionODBC
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+#' @slot sql "character"
+#' @slot query "data.frame"
+#' @slot open logical is the connection left open after the request ?
+#' @examples
+#'  object=new("RequeteODBC")
+#' @export
+setClass(Class="RequeteODBC",
+		representation= representation(sql="character",query="data.frame",open="logical"),
+		prototype = list(silent=TRUE,open=FALSE),
+		contains="ConnectionODBC")
+
+#' 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 RequeteDB
+#' @param object an object of class RequeteODBC
+#' @return An object of class RequeteODBC
+#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
+#' @examples 
+#' showClass("RequeteODBC")
+#' \dontrun{
+#' object=new("RequeteODBC")
+#' object at open=TRUE
+#' object at baseODBC=baseODBC
+#' object at sql= "select * from t_lot_lot limit 100"
+#' object<-connect(object)
+#' odbcClose(object at connection)
+#' odbcCloseAll()
+#'   object=new("RequeteODBC")
+#'   object at 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 at baseODBC=c("myODBCconnection","myusername","mypassword")
+#'   object at sql= "select * from mytable limit 100"
+#'   object<-connect(object)
+#'   odbcClose(object at 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("RequeteODBC")
+#'   object at baseODBC=c("myODBCconnection","myusername","mypassword")
+#'   object at sql= "select * from mytable limit 100"
+#'   object<-connect(object)
+#'  ## the connection is already closed, the query is printed
+#'}
+setMethod("connect",signature=signature("RequeteODBC"),definition=function(object) {  
+			.Deprecated(new= "RequeteDB",old="RequeteODBC")
+			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 (requireNamespace("stacomiR", quietly = TRUE)){
+				if (exists("envir_stacomi", where =asNamespace("stacomiR"), mode="environment")){
+					verbose<-exists("showmerequest",envir=envir_stacomi)
+				} else {
+					verbose <- FALSE
+				}
+			} else {
+				verbose <- FALSE
+				
+			}
+			
+			# The connection might already be opened, we will avoid to go through there !
+			if (is.null(object at connection)){ 				
+				if (length(object at baseODBC)!=3)  {
+					if (exists("baseODBC",envir=envir_stacomi)) {
+						object at baseODBC<-get("baseODBC",envir=envir_stacomi)  
+					} else {
+						funout(msg1,arret=TRUE)
+					}
+				}
+				# opening of 'ODBC' connection
+				e=expression(channel <-odbcConnect(object at baseODBC[1],
+								uid = object at baseODBC[2],
+								pwd = object at baseODBC[3],
+								case = "tolower",
+								believeNRows = FALSE))
+				if (!object at silent) funout(paste(msg2,object at baseODBC[1],"\n"))
+				# send the result of a try catch expression in
+				#the Currentconnection object ie a character vector
+				object at connection<-tryCatch(eval(e), error=paste(msg3 ,object at baseODBC)) 
+				# un object S3 RODBC
+				if (class(object at connection)=="RODBC") {
+					if (!object at silent)funout(msg4)
+					object at etat=msg4# success
+				} else {
+					object at etat<-object at connection # report of the error
+					object at connection<-NULL
+					funout(msg3,arret=TRUE)
+				}
+				# sending the query
+			} 
+			if (!object at silent) funout(msg5) # query trial
+			if (verbose) print(object at sql)
+			query<-data.frame() # otherwise, query called in the later expression is evaluated as a global variable by RCheck
+			e=expression(query<-sqlQuery(object at connection,object at sql,errors=TRUE))
+			if (object at 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 at connection))
+			}
+			if ((class(resultatRequete)=="data.frame")[1]) {
+				if (!object at silent) funout(msg6)
+				object at query=killfactor(query)    
+				object at etat=msg6
+			} else {
+				if (!object at silent) print(resultatRequete)
+				object at etat=as.character(resultatRequete)
+				print(object at etat)
+			}
+			return(object)
+			
+		})
[TRUNCATED]

To get the complete diff run:
    svnlook diff /svnroot/stacomir -r 572


More information about the Stacomir-commits mailing list