#' Tools to explore the tables or columns in a database
#'
#' Functions assist with exploring db objects at the abstraction layer, and general
#' exploration of the Morpheus data
#'
#' @param db A character value naming the database (e.g. "Morpheus")
#' @param closeConn A boolean indicating whether this function to close the connection to "db". Default is TRUE.
#' @param print A boolean indicating whether to print information on the R console
#' @param tbl_Pattern A regex pattern to filter on desired tables
#'
#' @examples
#' \dontrun{
#' # Let's explore what data is available in Morpheus
#'
#' # Available tables?
#' TableInfo(db = "Morpheus")
#' TableInfo(db = "RemoteFE", print = T)
#'
#' # What are the keys for each table?
#' PrimaryKey("Morpheus")
#'
#' # Get key for a specific table
#' PrimaryKey("Morpheus", "MainLog")
#'
#' # Let's explore MainLog columns
#' ColumnInfo(tables = "MainLog")
#'
#' # Shortcuts/quick view
#' Columns()
#' Columns(table = "ProcedureSummaries")
#' }
#' @describeIn TableInfo Given a database, get all databases on same server
#' @export
#' @importFrom data.table data.table set setnames setkeyv rbindlist
TableInfo <- function(db=NULL, print=FALSE) {
dropCols <- c("TABLE_SCHEM", "TABLE_TYPE", "REMARKS")
keepCols <- c("TABLE_CAT", "TABLE_NAME")
friendlyName <- c("Database", "Table")
if(is.null(db)){
# db <- sapply(istools::Databases(),"[[","database")
db <- ValidDB() # this should return same as above
}
fn_fetch <- function(i){
print(paste0("Fetching db: ", i))
OpenDB(i) # OpenDB will check valid db name
dt <- getTables(i)
if(nrow(dt)==0)
return(NULL)
set(dt, j = dropCols, value = NULL)
setnames(dt, friendlyName)
setkeyv(dt, c("Database", "Table"))
return(PrimaryKey(i, dt$Table))
}
res <- rbindlist(lapply(db, fn_fetch), fill=TRUE)
if(print){
print(res[,.(NumberOfTables = .N), by=Database], row.names = FALSE)
cat("\n\n")
print(res[1:min(15,nrow(res)),], row.names = FALSE)
}
return(res)
}
#' @describeIn TableInfo Will present a relation between tables in a given db
#' @export
#' @importFrom stringr str_detect
Relate <- function(db=NULL, tbls=NULL, tbl_Pattern=NULL){
resdt <- TableInfo(db)
if(is.null(tbls) & is.null(tbl_Pattern))
return(resdt)
dat <- resdt[Table %in% tbls | stringr::str_detect(Table, tbl_Pattern)]
wresdt <- dcast(dat,
Database + Table ~ PrimaryKey,
value.var = "PK_Position")
setnames(wresdt, "NA", "NO_KEY")
return(wresdt)
}
# Relate("RemoteFE")
#' @describeIn TableInfo A function to retrieve information about one or more table's primary key column
#' @param tbls A character vector of table names belonging to the database specified by "db"
#' @export
#' @importFrom data.table data.table set setnames setkeyv rbindlist
# tbls <- dt$Table
PrimaryKey <- function(db=NULL, tbls=NULL){
dropCols <- c("TABLE_SCHEM", "PK_NAME")
keepCols <- c("TABLE_CAT", "TABLE_NAME", "COLUMN_NAME","KEY_SEQ")
friendlyName <- c("Database", "Table", "PrimaryKey", "PK_Position")
OpenDB(db)
on.exit(CloseDB(db))
if(is.null(tbls)) stop("No tables supplied to PrimaryKey", call. = FALSE) #tbls <- TableInfo(db)[, unique(Table)]
# Helper fn to run through each table iteratively
f <- function(i){
tmp <- getPrimaryKey(db, i)
if(nrow(tmp)){
# tmp2 <- tmp[, !dropCols, with=FALSE]
set(tmp, j = dropCols, value = NULL) # Drop cols by ref
setnames(tmp, keepCols, friendlyName) # Change to friendly names
}else{
tmp <- data.table(Database=db, Table=i)
}
return(tmp)
}
emsg <- "Error in PrimaryKey()"
dt <- RunCatch(rbindlist(lapply(tbls, f), fill=TRUE), emsg, emsg)
emsg <- "Error setting keys in PrimaryKey"
RunCatch(setkeyv(dt, c("Database", "Table")), emsg, emsg)
# release easydata on cran then uncomment this
# return(easydata::CleanCols(dt))
return(dt)
}
#' @describeIn TableInfo A function to detailed information about a given table's columns.
#' If argument "tbls" not provided, retrive information about all tbls in the specified database
#' @export
#' @importFrom data.table data.table set setnames setkeyv rbindlist
ColumnInfo <- function(db=NULL, tbls=NULL, closeConn=FALSE, print=FALSE) {
dropCols <- c("TABLE_SCHEM", "DATA_TYPE", "BUFFER_LENGTH",
"NUM_PREC_RADIX", "NULLABLE", "REMARKS",
"COLUMN_DEF", "SQL_DATA_TYPE","SQL_DATETIME_SUB",
"CHAR_OCTET_LENGTH", "SS_DATA_TYPE")
keepCols <- c("TABLE_CAT", "TABLE_NAME", "COLUMN_NAME",
"TYPE_NAME", "COLUMN_SIZE", "DECIMAL_DIGITS",
"ORDINAL_POSITION", "IS_NULLABLE")
friendlyName <- c("Database", "Table", "Column", "Type", "ColumnSize",
"DecimalDigits", "Position","IsNullable")
# If not provided, run for all dbo tbls
if(is.null(tbls)) tbls <- "%"
if(is.null(db)) stop("Please provide db name")
OpenDB(db)
dt <- getColumns(db, tbls) # run query for col names
set(dt, j = dropCols, value = NULL)
setnames(dt, keepCols, friendlyName)
setkeyv(dt, c("Database", "Table"))
# Add Column for IsKey
set(dt, j="IsKey", value = "NO")
pk <- PrimaryKey(db, unique(dt$Table))
dt[Column %in% pk[, PrimaryKey], IsKey:="YES"]
if(print){
cat("\n")
print(dt[,.(NumberOfCols = .N), by="Database,Table"], row.names = FALSE)
cat("\n\n")
n <- min(10,nrow(dt))
print(dt[1:n, .(Table, Column, Type, Position, IsKey)], row.names = FALSE)
if(n < nrow(dt))
cat("--------------------- TRUNCATED ---------------------\n")
}
return(dt)
}
#' @describeIn TableInfo A function that serves as a quick lookup of columns in a table. Defaults to table
#' "MainLog" in database "Morpheus".
#' @param return A boolean indicating whether to return objects in memory. Defaults to FALSE which means
#' information is simply printed on the R console and not captured. Ideal default for quick lookups.
#' @export
#' @importFrom data.table data.table set setnames setkeyv rbindlist
Columns <- function(db=NULL, tbls=NULL, return=FALSE, closeConn=TRUE){
cat("\nDatabase:", db)
cat("\nDB Table:", tbls)
cat("\n\n")
dt <- ColumnInfo(db, tbls, closeConn, print = FALSE)
set(dt, j=c("Database",
"Table",
"ColumnSize",
"DecimalDigits",
"IsNullable"), value=NULL)
if(return)
return(dt)
print(dt, row.names = TRUE)
}
#' @describeIn TableInfo An internal wrapper around sqlTables
#' @importFrom RODBC sqlTables
#' @importFrom data.table data.table set setnames setkeyv rbindlist
getTables <- function(db=NULL) {
OpenDB(db)
cnObj <- GetConn(db)
dt <- RunCatch(sqlTables(channel = cnObj, tableType = "TABLE"),
"Error in getTables")
dt <- data.table(dt)
return(dt)
}
#' @describeIn TableInfo An internal wrapper around sqlColumns
#' @importFrom RODBC sqlColumns
#' @importFrom data.table data.table set setnames setkeyv rbindlist
getColumns <- function(db=NULL, tbls) {
cnObj <- GetConn(db)
dt <- RunCatch(sqlColumns(channel = cnObj,
sqtable = tbls), "Error in getColumns")
dt <- data.table(dt)
return(dt)
}
#' @describeIn TableInfo An internal wrapper around sqlPrimaryKeys
#' @importFrom RODBC sqlPrimaryKeys
#' @importFrom data.table data.table set setnames setkeyv rbindlist
getPrimaryKey <- function(db=NULL, tbls) {
# OpenDB(db)
cnObj <- GetConn(db)
# tbls = "SAPTBL.ZCOPA_XRATE_DATA_04092016"
dt <- tryCatch({
sqlPrimaryKeys(channel = cnObj, sqtable = tbls)
}, error = function(c){
if(stringr::str_detect(c$message, "table not found")){
a <- as.data.table(list(Database=NULL, Table=NULL))
return(a)
}else{
stop(c$message, call. = FALSE)
}
})
dt <- as.data.table(dt)
return(dt)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.