[Stacomir-commits] r464 - pkg/stacomirtools/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Oct 26 13:33:18 CEST 2017
Author: briand
Date: 2017-10-26 13:33:18 +0200 (Thu, 26 Oct 2017)
New Revision: 464
Modified:
pkg/stacomirtools/R/RequeteODBC.r
Log:
Problem with using stacomirtools and stacomir not loaded
Modified: pkg/stacomirtools/R/RequeteODBC.r
===================================================================
--- pkg/stacomirtools/R/RequeteODBC.r 2017-10-15 07:32:07 UTC (rev 463)
+++ pkg/stacomirtools/R/RequeteODBC.r 2017-10-26 11:33:18 UTC (rev 464)
@@ -11,9 +11,9 @@
#' @slot open=logical is the connection left open after the request ?
#' @examples object=new("RequeteODBC")
setClass(Class="RequeteODBC",
- representation= representation(sql="character",query="data.frame",open="logical"),
- prototype = list(silent=TRUE,open=FALSE),
- contains="ConnectionODBC")
+ 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 connect
@@ -49,122 +49,81 @@
#' object<-connect(object)
#' ## the connection is already closed, the query is printed
#'}
-
setMethod("connect",signature=signature("RequeteODBC"),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")
- verbose<-exists("showmerequest",envir=envir_stacomi)
-
-
-
-
-
-#' Function loaded in this package to avoid errors, if the package is called
-#' without 'stacomiR'
-#'
-#' This function will be replaced by a longer function using gWidgets if the
-#' package 'stacomiR' is loaded. It is provided there to avoid to pointing to
-#' an undefined global function. Normally the program tests for the existence
-#' of and environment envir_stacomi which indicates that the messages are to be
-#' displayed in the gWidget interface, so this code is to avoid notes in
-#' R.check.
-#'
-#'
-#' @param text The text to display
-#' @param arret If true calls the program to stop and the message to be
-#' displayed
-#' @param wash Only used when called from within 'stacomiR', and there is a
-#' widget interface, kept there for consistency
-#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
- funout<-function(text,arret=FALSE){
- if(arret) stop(text) else print(text)
- return(NULL)
- }
-
-
-
-
-#' very usefull function remove factor that appear, noticeably after loading
-#' with 'ODBC'
-#'
-#' function used to remove factors that appear, noticeably after loading with
-#' 'ODBC'
-#'
-#'
-#' @param df a data.frame
-#' @return df
-#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
-#' @examples
-#'
-#' df <- data.frame("var1" = c("blue","red"),"var2"=c("nice","ugly"))
-#' df[,"var1"] <- as.factor(df[,"var1"])
-#' df[,"var2"] <- as.factor(df[,"var2"])
-#' df <- killfactor(df)
-#' apply(df,1,function(x) is.factor(x)) # FALSE FALSE
-#'
-#' @export killfactor
- 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 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)
-
- })
+ 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 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)
+
+ })
More information about the Stacomir-commits
mailing list