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
|
#' @importFrom batchtools makeRegistry saveRegistry
temp_registry <- local({
## All known batchtools registries
regs <- new.env()
make_registry <- function(cluster.functions = NULL, config = list(), ...) {
## Temporarily disable batchtools output?
## (i.e. messages and progress bars)
debug <- getOption("future.debug", FALSE)
batchtools_output <- getOption("future.batchtools.output", debug)
work.dir <- config$work.dir
if (is.null(work.dir)) work.dir <- getwd()
config$work.dir <- NULL
if (!batchtools_output) {
oopts <- options(batchtools.verbose = FALSE, batchtools.progress = FALSE)
on.exit(options(oopts))
}
reg <- makeRegistry(work.dir = work.dir, ...)
if (!is.null(cluster.functions)) { ### FIXME
reg$cluster.functions <- cluster.functions
}
## Post-tweak the batchtools registry?
## This avoids having to set up a custom batchtools 'conf.file' etc.
if (length(config) > 0L) {
names <- names(config)
for (name in names) reg[[name]] <- config[[name]]
saveRegistry(reg)
}
reg
} ## make_registry()
function(label = "batchtools", path = NULL, config = list(), ...) {
if (is.null(label)) label <- "batchtools"
## The job label (the name on the job queue) - may be duplicated
label <- as.character(label)
stop_if_not(length(label) == 1L, nchar(label) > 0L)
## This session's path holding all of its future batchtools directories
## e.g. .future/<datetimestamp>-<unique_id>/
if (is.null(path)) path <- future_cache_path()
if (length(config) > 0L) {
stop_if_not(is.list(config))
names <- names(config)
stop_if_not(!is.null(names), all(nzchar(names)))
}
## The batchtools subfolder for a specific future - must be unique
prefix <- sprintf("%s_", label)
## FIXME: We need to make sure 'prefix' consists of only valid
## filename characters. /HB 2016-10-19
prefix <- as_valid_directory_prefix(prefix)
unique <- FALSE
while (!unique) {
## The FutureRegistry key for this batchtools future - must be unique
key <- tempvar(prefix = prefix, value = NA, envir = regs)
## The directory for this batchtools future
## e.g. .future/<datetimestamp>-<unique_id>/<key>/
path_registry <- file.path(path, key)
## Should not happen, but just in case.
unique <- !file.exists(path_registry)
}
## FIXME: We need to make sure 'label' consists of only valid
## batchtools ID characters, i.e. it must match regular
## expression "^[a-zA-Z]+[0-9a-zA-Z_]*$".
## /HB 2016-10-19
reg_id <- as_valid_registry_id(label)
make_registry(file.dir = path_registry, config = config, ...)
}
})
drop_non_valid_characters <- function(name, pattern, default = "batchtools") {
as_string <- (length(name) == 1L)
name <- unlist(strsplit(name, split = "", fixed = TRUE), use.names = FALSE)
name[!grepl(pattern, name)] <- ""
if (length(name) == 0L) return(default)
if (as_string) name <- paste(name, collapse = "")
name
}
as_valid_directory_prefix <- function(name) {
pattern <- "^[-._a-zA-Z0-9]+$"
## Nothing to do?
if (grepl(pattern, name)) return(name)
name <- unlist(strsplit(name, split = "", fixed = TRUE), use.names = FALSE)
## All characters must be letters, digits, underscores, dash, or period.
name <- drop_non_valid_characters(name, pattern = pattern)
name <- paste(name, collapse = "")
stop_if_not(grepl(pattern, name))
name
}
as_valid_registry_id <- function(name) {
pattern <- "^[a-zA-Z]+[0-9a-zA-Z_]*$"
## Nothing to do?
if (grepl(pattern, name)) return(name)
name <- unlist(strsplit(name, split = "", fixed = TRUE), use.names = FALSE)
## All characters must be letters, digits, or underscores
name <- drop_non_valid_characters(name, pattern = "[0-9a-zA-Z_]")
name <- name[nzchar(name)]
## First character must be a letter :/
if (!grepl("^[a-zA-Z]+", name[1])) name[1] <- "z"
name <- paste(name, collapse = "")
stop_if_not(grepl(pattern, name))
name
}
|
