#' Get data from the Distance project database
#'
#' This function is a wrapper around either calls to \code{\link{RODBC}} (on Windows) or \code{\link{mdb.get}} (on Unix-a-like systems). Given a database file name it will return either the contents of the table (as \code{data.frame}), if \code{table=NULL} then it will return all tables and if \code{table=TRUE} then it will return a character vector of table names.
#'
#' @note Currently not implemented on Windows systems.
#' @param file the path to the database file to access
#' @param table the table to extract (if \code{NULL} all tables are extracted, if \code{TRUE} a list of tables names are extracted)
#' @return a \code{data.frame} with the contents of a database table
#' @author David L Miller
#' @importFrom Hmisc mdb.get
#' @importFrom RODBC odbcDriverConnect sqlTables sqlQuery odbcClose
db_get <- function(file, table=NULL){
# on unix systems use mdb.get
if(.Platform$OS.type == "unix"){
# sometimes numeric labels go wrong (1.6==1.60), so need to ensure that
# "Label" is always character ("1.6"!="1.60")
# need to muffle a warning generated with this
dat <- withCallingHandlers(mdb.get(file, table,
colClasses=c("Label"="character")),
warning=function(w){
if(endsWith(conditionMessage(w), "not all columns named in 'colClasses' exist"))
invokeRestart("muffleWarning")
})
# on Windows
}else{
require(RODBC)
dsn <- paste0("Driver={Microsoft Access Driver (*.mdb)};Dbq=",
#"Driver={Microsoft Access Driver (*.mdb, *.accdb)};DBQ=",
file, ";Uid=;Pwd=;")
db <- odbcDriverConnect(dsn)
if(db == -1){
stop(paste0("RODBC is unable to open ", file,"\n",
" table= ", table))
}
if(is.null(table)){
# get a character vector of table names
table_names <- sqlTables(db)$TABLE_NAME
table_names <- table_names[!grepl("MSys", table_names)]
# make a list, one table per element
dat <- lapply(table_names, function(x){
xx <- sqlQuery(db,
paste0("SELECT * FROM \"", table, "\""),
stringsAsFactors=FALSE)
names(xx) <- gsub(" ", ".", names(xx))
})
}else if(table==TRUE){
# get a character vector of table names
dat <- sqlTables(db)$TABLE_NAME
dat <- gsub(" ", ".", dat)
}else{
# do the query and get the table
# go back to spaces not dots
table <- gsub("\\.", " ", table)
dat <- sqlQuery(db, paste0("SELECT * FROM \"", table, "\""),
stringsAsFactors=FALSE)
names(dat) <- gsub(" ", ".", names(dat))
}
odbcClose(db)
# remove \r line endings
dat <- lapply(dat, function(x){
if(typeof(x) == "character"){
gsub("\\r", "", x)
}else{
x
}
})
dat <- as.data.frame(dat, stringsAsFactors=FALSE)
## WHEN IMPLEMENTING THIS:
## for compatability with mdb.get:
# * mdb.get just pulls _whole tables_ and puts them in data.frames
# * setting table=NULL will import _all tables_
# * setting table=TRUE will give a list of tables
}
return(dat)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.