Nothing
# 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)})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.