-
Notifications
You must be signed in to change notification settings - Fork 1
/
logical.R
130 lines (105 loc) · 3.17 KB
/
logical.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
# is64BitR ---------------------------------------------------------------------
is64BitR <- function()
{
.Machine$sizeof.pointer == 8
}
# isAccess2007File -------------------------------------------------------------
isAccess2007File <- function(filepath)
{
grepl("\\.accdb$", filepath)
}
# isAccess2003File -------------------------------------------------------------
isAccess2003File <- function(filepath)
{
grepl("\\.mdb$", filepath)
}
# isAccessFile -----------------------------------------------------------------
isAccessFile <- function(filepath)
{
isAccess2003File(filepath) || isAccess2007File(filepath)
}
# isExcel2007File --------------------------------------------------------------
#' Is this an XLSX file?
#'
#' @param filepath (vector of) path(s) to the file(s) to be checked for .xlsx
#' extension
#'
#' @return (vector of) logical.
#' @export
#'
isExcel2007File <- function(filepath)
{
grepl("\\.xlsx$", filepath, ignore.case = TRUE)
}
# isExcel2003File --------------------------------------------------------------
#' Is this an XLS file?
#'
#' @param filepath (vector of) path(s) to the file(s) to be checked for .xls
#' extension
#'
#' @return (vector of) logical.
#' @export
#'
isExcel2003File <- function(filepath)
{
grepl("\\.xls$", filepath, ignore.case = TRUE)
}
# isExcelFile ------------------------------------------------------------------
#' Is this an Excel file?
#'
#' @param filepath (vector of) path(s) to the file(s) to be checked for .xls
#' or .xlsx extension
#'
#' @return (vector of) logical.
#' @export
#'
isExcelFile <- function(filepath)
{
isExcel2003File(filepath) || isExcel2007File(filepath)
}
# isMySQL ----------------------------------------------------------------------
#' Is the Given Database of Type MySQL?
#'
#' @param db database file (*.mdb, *.accdb, *.xls, *.xlsx) or name of ODBC
#' database
#' @param \dots arguments passed to \code{\link{hsOpenDb}}, e.g.
#' \emph{use2007Driver}
#' @param con connection object as returned by \code{\link{hsOpenDb}}, if
#' already available. Default: \code{NULL}
#' @return TRUE if \emph{db} is a MySQL database, else FALSE
#' @export
#'
isMySQL <- function(db, ..., con = NULL)
{
# If a connection is given and if it has an attribute "isMySQL", return the
# value of that attribute
if (! is.null(con) && ! is.null(is_mysql <- attr(con, "isMySQL"))) {
return(is_mysql)
}
# Otherwise try to check by extension
if (isExcelFile(db) || isAccessFile(db)) {
return(FALSE)
}
sqlDialect <- getCurrentSqlDialect(warn = FALSE)
connection <- try(hsOpenDb(db, ...))
on.exit({
hsCloseDb(connection)
setCurrentSqlDialect(sqlDialect)
})
if (inherits(connection, "try-error")) clean_stop(sprintf(
"Cannot open '%s' to check if this is a MySQL database!", db
))
attr(connection, "isMySQL")
}
# isOdbcDataSource -------------------------------------------------------------
#' @importFrom RODBC odbcDataSources
#' @importFrom odbc32 odbcDataSources
#'
isOdbcDataSource <- function(db)
{
result <- try(RODBC::odbcDataSources())
if (inherits(result, "try-error")) {
result <- odbc32::odbcDataSources()
}
db %in% names(result)
}