R/RequeteDB.R

In stacomirtools: Connection Class for Package stacomiR

# Nom fichier :        RequeteDB.R 
#' @title RequeteDB class 
#' @note Inherits from ConnectionDB
#' @author Cedric Briand \email{cedric.briand@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 
#' @aliases query.RequeteDB
#' @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@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@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@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@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")
			printqueries <- options("stacomiR.printqueries")[[1]]
			if (is.null(printqueries)) printqueries <- FALSE
				
			 
			
			# The connection might already be opened, we will avoid to go through there !
			if (is.null(object@connection)){ 						
				# opening of connection
				e=expression(channel <- connect(object, ...))
				if (!object@silent) cat(paste(msg2, object@dbname, "\n"))
				# send the result of a try catch expression in
				#the Currentconnection object ie a character vector
				object <- tryCatch(eval(e)) 
				# un object S3 RODBC
				if (any(class(object@connection)=="Pool")) {
					if (!object@silent) cat(msg4)
					object@status <- msg4# success
				} else {
					object@status <- object@connection # report of the error
					object@connection <- NULL
					stop(msg3)
				}
				# sending the query
			} 
			if (!object@silent) cat(msg5) # query trial
			if (printqueries) print(object@sql)
			if (length(object@sql)==0) warnings("No sql query")
			query <- data.frame() # otherwise, query called in the later expression is evaluated as a global variable by RCheck
			e=expression(query<- dbGetQuery(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=pool::poolClose(object@connection))
			}
			if (any(class(resultatRequete)=="data.frame")) {
				if (!object@silent) cat(msg6)
				object@query <- killfactor(query)    
				object@status <- msg6
			} else {
				if (!object@silent) print(resultatRequete)
				object@status <- as.character(resultatRequete)
				print(object@status)
			}
			return(object)
			
		}
)

#' generic query function for  
#' @param object an object
#' @param ... additional parameters passed to query
setGeneric("getquery", def=function(object, ...) standardGeneric("getquery"))


#' getquery retreives the result of the query from the object
#' @param object an object of class RequeteDB
#' @return A data frame
#' @export
setMethod("getquery",signature=signature("RequeteDB"),
		definition=function(object) {
			return(object@query)})