/
install.R
145 lines (141 loc) · 5.03 KB
/
install.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
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
#' Install external codes
#'
#' This function installs external codes that are used by [RMT3DMS].
#'
#' ## Supported software
#' [MT3DMS v5.3](https://hydro.geo.ua.edu/) and [MT3D-USGS](https://www.usgs.gov/software/mt3d-usgs-groundwater-solute-transport-simulator-modflow).
#' The zip files with windows binaries hosted at these website
#' are downloaded and extracted in the installation directory. The main
#' folder names are modified in order to have more consistency.
#'
#' ## Installation location
#' The default installation location is `file.path(system.file(package =
#' "RMT3DMS"), "code")`, but it can be altered by setting option
#' `RMT3DMS.path`.
#'
#' @param code Character vector with the codes to install, or `"all"` (default).
#' @param overwrite Logical. Overwrite when the code is already installed? If
#' `NULL` (default), the user is asked what to do in an interactive session.
#' An error message is issued otherwise.
#' @export
#' @examples
#' \dontrun{
#' rmt_install() # Install all codes.
#' rmt_install("MT3D-USGS", overwrite = TRUE) # Install MT3D-USGS.
#' rmt_install("MT3DMS", overwrite = TRUE) # Install MT3DMS.
#' }
#'
rmt_install <- function(code = "all", overwrite = NULL) {
if (code[1] == "all") {
rmti_install_code(rmtd_supported_codes, overwrite = overwrite)
return(invisible())
}
codes <- rmtd_supported_codes %>% c(stringr::str_remove(., "MT3D-"))
code <- stringr::str_remove(toupper(code), "MT3D-")
if (!all(code %in% codes)) {
rui::alert("Installing codes other than MT3D-USGS or MT3DMS",
"is currently not supported.")
rui::error("Issue with code name.")
}
rmti_install_code(code, overwrite = overwrite)
invisible()
}
#' @rdname rmt_install
#' @export
#' @details [rmt_installed_codes()] shows which codes are installed in the default installation location as
#' set by the `RMT3DMS.path` option.
#' @return [rmt_installed_codes()] returns an invisible character vector with installed code names.
#' @examples
#' \dontrun{
#' rmt_installed_codes()
#' }
rmt_installed_codes <- function() {
loc <- getOption('RMT3DMS.path')
codes <- vapply(list.dirs(loc, recursive = FALSE), basename, 'text')
if(length(codes) == 0) {
rui::disapprove('No codes have been installed in {.path {loc}}')
} else {
rui::approve('Following codes have been installed in {.path {loc}}:')
for(i in codes) rui::inform(i)
}
return(invisible(setNames(codes, NULL)))
}
#' Install codes
#'
#' @inheritParams rmt_install
rmti_install_code <- function(code, overwrite) {
os <- Sys.info()['sysname']
path <- getOption("RMT3DMS.path")
if (any(grepl("USGS", code)))
rmti_download_code("MT3D-USGS", path, os, overwrite)
if (any(grepl("MT3DMS", code, ignore.case = TRUE)))
rmti_download_code("MT3DMS", path, os, overwrite)
invisible()
}
#' Download a code
#'
#' @inheritParams rmt_install
#' @param dir Installation directory.
#' @param os Operating system.
rmti_download_code <- function(code, dir, os, overwrite) {
# set url
if(code == "MT3D-USGS") {
if(os == 'Windows') {
x <- "https://water.usgs.gov/water-resources/software/MT3D-USGS/mt3dusgs1.1.0.zip"
} else {
rui::error("{code} is not available for your operating system.")
}
folder <- gsub('\\.zip', '', basename(x))
} else if(code == 'MT3DMS') {
if(os == 'Windows') {
x <- "https://hydro.geo.ua.edu/mt3d/mt3dms_530.exe"
} else {
rui::error("{code} is not available for your operating system.")
}
folder <- gsub('\\.exe', '', basename(x))
}
mt_dir <- file.path(dir, code)
# install, if already installed ask what to do
if(dir.exists(mt_dir)) {
if(is.null(overwrite) & interactive()) {
rui::alert("You have already installed {code} in {mt_dir}")
install <- rui::ask("Do you want to reinstall?")
} else if (is.null(overwrite)) {
rui::error(c("{code} version already exists in {mt_dir}",
"Set overwrite to TRUE if you want replace it."))
} else if (overwrite) {
install <- TRUE
} else {
install <- FALSE
}
} else {
install <- TRUE
}
if(install) {
if(dir.exists(mt_dir)) unlink(mt_dir, recursive = TRUE, force = TRUE)
rui::begin("Downloading {code}")
if(code == 'MT3DMS') {
temp <- tempdir()
download.file(x, file.path(temp, basename(x)), quiet = TRUE, mode = 'wb')
} else {
temp <- tempfile()
download.file(x, temp, quiet = TRUE)
}
rui::proceed("Installing {code}")
if(code == 'MT3DMS') {
# MT3DMS has a self-extracting file that can be called from a terminal instead of a zip file
out <- processx::run(file.path(temp, basename(x)), c('/auto', mt_dir), wd = temp, stdout_line_callback = NULL)
unlink(temp, force = TRUE)
} else {
unzip(temp, exdir = dir)
unlink(temp, force = TRUE)
# fs::file_move(file.path(dir, folder), mt_dir)
file.rename(file.path(dir, folder), mt_dir)
}
rui::succeed()
rui::inform("You can find {code} at: {.path {mt_dir}}")
} else {
rui::disapprove("Aborting install of {code}")
}
invisible()
}