Nothing
#' Get or set configuration options that control ALA4R behaviour
#'
#' @references \url{https://api.ala.org.au/}
#' @references \url{https://spatial.ala.org.au/layers-service/} this will
#' eventually move to the api link
#'
#' Invoking \code{ala_config()} with no arguments returns a list with the
#' current values of the options.
#'
#' \code{ala_reasons()} returns a data frame with information describing the
#' valid options for \code{download_reason_id}
#'
#' @param \dots Options can be defined using name = value. Valid options are:
#' \itemize{
#' \item reset: \code{ala_config("reset")} will reset the options to their
#' default values
#' \item caching string: caching can be
#' "on" (results will be cached, and any cached results will be re-used),
#' "refresh" (cached results will be refreshed and the new results stored
#' in the cache), or
#' "off" (no caching, default).
#' \item cache_directory string: the directory to use for the cache.
#' By default this is a temporary directory, which means that results will
#' only be cached
#' within an R session and cleared automatically when the user exits R.
#' The user may wish to set this to a non-temporary directory for
#' caching across sessions. The directory must exist on the file system.
#' \item verbose logical: should ALA4R give verbose output to assist
#' debugging? (default = FALSE)
#' \item warn_on_empty logical: should a warning be issued if a request
#' returns an empty result set? (default = FALSE)
#' \item user_agent string: the user-agent string used with all web requests
#' to the ALA servers.
#' Default = "ALA4R" with version number
#' \item text_encoding string: text encoding assumed when reading cached
#' files from local disk (default = "UTF-8")
#' \item download_reason_id numeric or string: the "download reason" required
#' by some ALA services, either as a numeric ID (currently 0--11)
#' or a string (see \code{ala_reasons()} for a list of valid ID codes and
#' names). By default this is NA. Some ALA services require a valid
#' download_reason_id code, either specified here or directly to the
#' associated R function.
#' }
#'
#' @return For ala_config(), a list of all options. When ala_config(...) is
#' called with arguments, nothing is returned but the configuration is set.
#'
#' @examples
#' \dontrun{
#' ala_config()
#' ala_config(caching = "off")
#' ala_reasons()
#' ala_config(download_reason_id = 0,verbose = TRUE)
#' ala_config("reset")
#' }
#' @export ala_config
ala_config <- function(...) {
## get or set options that control ALA4R behaviour
## options are stored as a global option with the name defined
## in ala_option_name
ala_option_name <- "ALA4R_config"
user_options <- list(...) ## the options passed by the user
## default user-agent string
version_string <- "version unknown"
suppressWarnings(
try(version_string <- utils::packageDescription("ALA4R")[["Version"]],
silent = TRUE)) ## get the ALA4R version, if we can
user_agent_string <- paste0("ALA4R ", version_string)
## set default options
default_options <- list(
caching = "on",
cache_directory = tempdir(),
user_agent = user_agent_string,
download_reason_id = 4,
verbose = FALSE,
warn_on_empty = FALSE,
text_encoding = "UTF-8"
)
## define allowed options, for those that have restricted values
allowed_options <- list(caching = c("on", "off", "refresh"),
download_reason_id = c(0:8, 10:12))
## ideally, the valid download_reason_id values should be populated
## dynamically from the ala_reasons() function. However if that is
## called (from here) before the ALA4R_config option has been set,
## then we get infinite recursion. To be addressed later ...
## has the user asked to reset options to defaults?
if (identical(tolower(user_options), "reset")) {
temp <- list(default_options)
names(temp) <- ala_option_name
options(temp)
} else {
names(user_options) <- tolower(names(user_options))
## has the user specified something we don't recognize?
known_options <- names(default_options)
unknown <- setdiff(names(user_options), known_options)
if (length(unknown) > 0) {
stop("unknown ", getOption("ALA4R_server_config")$brand,
" options: ", str_c(unknown, collapse = ", "))
}
current_options <- getOption(ala_option_name)
if (is.null(current_options)) {
## ALA4R options have not been set yet, so set them to the defaults
current_options <- default_options
## set the global option
temp <- list(current_options)
names(temp) <- ala_option_name
options(temp)
}
## convert reason from char to numeric if needed
if (!is.null(user_options$download_reason_id)) {
user_options$download_reason_id <-
convert_reason(user_options$download_reason_id)
}
## override any defaults with user-specified options
if (length(user_options) == 0) {
return(current_options)
}
for (i in seq_len(length(user_options))) {
this_option_name <- names(user_options)[i]
if (! is.null(allowed_options[[this_option_name]])) {
## there are restrictions on the allowed values for
## this option
## could use match.arg here but the output is a bit obscure
if (! (user_options[[i]] %in%
allowed_options[[this_option_name]])) {
stop("value \"", user_options[[i]],
"\" is not a valid choice for ", this_option_name,
" (should be one of ",
str_c(allowed_options[[this_option_name]],
collapse = ", "), ")")
}
}
## any other specific checks ...
if (identical(this_option_name, "cache_directory")) {
if (!see_if(is.notempty.string(user_options[[i]]))) {
stop("cache_directory should be a string")
}
## strip trailing file separator, if there is one
user_options[[i]] <- sub("[/\\]+$", "", user_options[[i]])
if (! (file.exists(user_options[[i]]) &&
file.info(user_options[[i]])$isdir)) {
## cache directory does not exist. We could create
## it, but this is probably better left to the user
## to manage
stop("cache directory ", user_options[[i]],
" does not exist")
}
}
if (identical(this_option_name, "user_agent")) {
if (!see_if(is.string(user_options[[i]]))) {
stop("user_agent should be a string")
}
}
if (identical(this_option_name, "verbose")) {
if (!see_if(is.flag(user_options[[i]]))) {
stop("verbose should be TRUE or FALSE")
}
}
if (identical(this_option_name, "warn_on_empty")) {
if (!see_if(is.flag(user_options[[i]]))) {
stop("warn_on_empty should be TRUE or FALSE")
}
}
current_options[this_option_name] <- user_options[[i]]
}
## set the global option
temp <- list(current_options)
names(temp) <- ala_option_name
options(temp)
}
}
#' @rdname ala_config
#' @export
ala_reasons <- function() {
## return list of valid "reasons for use" codes
out <- cached_get(
build_url_from_parts(getOption("ALA4R_server_config")$base_url_logger,
path = "reasons"), type = "json")
if (any(names(out) == "deprecated")) out <- out[!out$deprecated, ]
out[, !names(out) == "deprecated"]
}
## internal function, used to define the ALA4R sourceTypeId parameter value,
## passed by occurrences download and possibly other functions
ala_sourcetypeid <- function() {
this_url <- build_url_from_parts(
getOption("ALA4R_server_config")$base_url_logger, path = "sources")
sids <- cached_get(this_url, type = "json")
if ("ALA4R" %in% sids$name) {
sids$id[sids$name == "ALA4R"]
} else {
warning("could not retrieve ", getOption("ALA4R_server_config")$brand,
" source type from ", this_url, ". ",
getOption("ALA4R_server_config")$notify)
2001 ## default value
}
}
convert_reason <- function(reason) {
## unexported function to convert string reason to numeric id
if (is.character(reason)) {
valid_reasons <- ala_reasons()
tryCatch({
reason <- match.arg(tolower(reason), valid_reasons$name)
reason <- valid_reasons$id[valid_reasons$name == reason]
},
error = function(e) {
stop("could not match download_reason_id string \"",
reason, "\" to valid reason string: see ",
getOption("ALA4R_server_config")$reasons_function,
"()")
}
)
}
reason
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.