/
info.R
122 lines (109 loc) · 3.99 KB
/
info.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
.emodnet_get_layer_info <- function(wfs, layers) {
check_wfs(wfs)
layers <- namespace_layer_names(wfs, layers)
capabilities <- wfs$getCapabilities()
wfs_layers <- purrr::map(layers, capabilities$findFeatureTypeByName) %>%
unlist(recursive = FALSE)
tibble::tibble(
data_source = "emodnet_wfs",
service_name = wfs$getUrl(),
service_url = get_service_name(wfs$getUrl()),
layer_name = purrr::map_chr(wfs_layers, ~ .x$getName()),
title = purrr::map_chr(wfs_layers, ~ .x$getTitle()),
abstract = purrr::map_chr(wfs_layers, ~ get_abstract_null(.x)),
class = purrr::map_chr(wfs_layers, ~ .x$getClassName()),
format = purrr::map_chr(wfs_layers, guess_layer_format)
) %>%
dplyr::rowwise() %>%
dplyr::mutate(
layer_namespace = strsplit(layer_name, ":", fixed = TRUE)[[1]][1],
layer_name = strsplit(layer_name, ":", fixed = TRUE)[[1]][2]
) %>%
unique()
}
#' @describeIn emodnet_get_wfs_info Get metadata for specific layers. Requires a
#' `wfs` object as input.
#' @inheritParams emodnet_get_layers
#' @importFrom memoise memoise
#' @details To minimize the number of requests sent to webservices,
#' these functions use `memoise` to cache results inside the active R session.
#' To clear the cache, re-start R or
#' run `memoise::forget(emodnet_get_wfs_info)`/
#' `memoise::forget(emodnet_get_layer_info)`.
#' @export
emodnet_get_layer_info <- memoise::memoise(.emodnet_get_layer_info)
.emodnet_get_wfs_info <- function(wfs = NULL,
service = NULL,
service_version = NULL) {
deprecate_msg_service_version(service_version, "emodnet_get_wfs_info")
if (is.null(wfs) && is.null(service)) {
cli::cli_abort(
c(
"Please provide a valid {.field service} name or {.field wfs} object.",
x = "Both cannot be {.val NULL} at the same time."
)
)
}
wfs <- wfs %||% emodnet_init_wfs_client(service)
check_wfs(wfs)
capabilities <- wfs$getCapabilities()
tibble::tibble(
data_source = "emodnet_wfs",
service_name = get_service_name(capabilities$getUrl()),
service_url = capabilities$getUrl(),
layer_name = purrr::map_chr(capabilities$getFeatureTypes(), ~ .x$getName()),
title = purrr::map_chr(capabilities$getFeatureTypes(), ~ .x$getTitle()),
abstract = purrr::map_chr(
capabilities$getFeatureTypes(),
~ get_abstract_null(.x)
),
class = purrr::map_chr(capabilities$getFeatureTypes(), ~ .x$getClassName()),
format = purrr::map_chr(capabilities$getFeatureTypes(), guess_layer_format)
) %>%
dplyr::rowwise() %>%
dplyr::mutate(
layer_namespace = strsplit(layer_name, ":", fixed = TRUE)[[1]][1],
layer_name = strsplit(layer_name, ":", fixed = TRUE)[[1]][2]
)
}
#' Get WFS available layer information
#'
#' @param wfs A `WFSClient` R6 object with methods for interfacing an
#' OGC Web Feature Service.
#' @inheritParams emodnet_init_wfs_client
#' @return a tibble containing metadata on each layer available from the
#' service.
#' @export
#' @describeIn emodnet_get_wfs_info Get info on all layers from
#' an EMODnet WFS service.
#' @examples
#' \dontrun{
#' emodnet_get_wfs_info(service = "bathymetry")
#' # Query a wfs object
#' wfs_bio <- emodnet_init_wfs_client("biology")
#' emodnet_get_wfs_info(wfs_bio)
#' # Get info for specific layers from wfs object
#' layers <- c("mediseh_zostera_m_pnt", "mediseh_posidonia_nodata")
#' emodnet_get_layer_info(wfs = wfs_bio, layers = layers)
#' }
emodnet_get_wfs_info <- memoise::memoise(.emodnet_get_wfs_info)
#' @describeIn emodnet_get_wfs_info Get metadata on all layers and all available
#' services from server.
#' @export
emodnet_get_all_wfs_info <- function() {
purrr::map_df(
emodnet_wfs()$service_name,
~ suppressMessages(emodnet_get_wfs_info(service = .x))
)
}
get_abstract_null <- function(x) {
abstract <- x$getAbstract()
abstract %||% ""
}
guess_layer_format <- function(layer) {
if (!is.null(layer$getGeometryType())) {
"sf"
} else {
"data.frame"
}
}