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
|
deparse_all <- function(x) {
x <- purrr::map_if(x, is_formula, f_rhs)
purrr::map_chr(x, expr_text, width = 500L)
}
#' Provides comma-separated string out of the parameters
#' @export
#' @keywords internal
named_commas <- function(x) {
if (is.list(x)) {
x <- purrr::map_chr(x, as_label)
} else {
x <- as.character(x)
}
nms <- names2(x)
out <- ifelse(nms == "", x, paste0(nms, " = ", x))
paste0(out, collapse = ", ")
}
commas <- function(...) paste0(..., collapse = ", ")
unique_table_name <- function(prefix = "") {
vals <- c(letters, LETTERS, 0:9)
name <- paste0(sample(vals, 10, replace = TRUE), collapse = "")
paste0(prefix, "dbplyr_", name)
}
unique_subquery_name <- function() {
# Needs to use option so can reset at the start of each query
i <- getOption("dbplyr_subquery_name", 0) + 1
options(dbplyr_subquery_name = i)
sprintf("q%02i", i)
}
unique_column_name <- function() {
# Needs to use option so can reset at the start of each query
i <- getOption("dbplyr_column_name", 0) + 1
options(dbplyr_column_name = i)
sprintf("col%02i", i)
}
unique_subquery_name_reset <- function() {
options(dbplyr_subquery_name = 0)
}
unique_column_name_reset <- function() {
options(dbplyr_column_name = 0)
}
succeeds <- function(x, quiet = FALSE) {
tryCatch(
{
x
TRUE
},
error = function(e) {
if (!quiet)
message("Error: ", e$message) # nocov
FALSE
}
)
}
c_character <- function(...) {
x <- c(...)
if (length(x) == 0) {
return(character())
}
if (!is.character(x)) {
cli_abort("Character input expected")
}
x
}
cat_line <- function(...) cat(paste0(..., "\n"), sep = "")
# nocov start
res_warn_incomplete <- function(res, hint = "n = -1") {
if (dbHasCompleted(res)) return()
rows <- big_mark(dbGetRowCount(res))
cli::cli_warn("Only first {rows} results retrieved. Use {hint} to retrieve all.")
}
add_temporary_prefix <- function(con, table, temporary = TRUE) {
check_table_path(table)
if (!temporary) {
return(table)
}
pieces <- table_path_components(table, con)[[1]]
table_name <- pieces[length(pieces)]
if (substr(table_name, 1, 1) != "#") {
new_name <- paste0("#", table_name)
cli::cli_inform(
paste0("Created a temporary table named ", new_name),
class = c("dbplyr_message_temp_table", "dbplyr_message")
)
pieces[[length(pieces)]] <- new_name
table <- make_table_path(pieces, con)
}
table
}
# nocov end
# Helper for testing
local_methods <- function(..., .frame = caller_env()) {
local_bindings(..., .env = global_env(), .frame = .frame)
}
local_db_table <- function(con, value, name, ..., temporary = TRUE, envir = parent.frame()) {
if (inherits(con, "Microsoft SQL Server") && temporary) {
name <- paste0("#", name)
}
withr::defer(DBI::dbRemoveTable(con, name), envir = envir)
copy_to(con, value, name, temporary = temporary, ...)
tbl(con, name)
}
local_sqlite_connection <- function(envir = parent.frame()) {
withr::local_db_connection(
DBI::dbConnect(RSQLite::SQLite(), ":memory:"),
.local_envir = envir
)
}
|
