Skip to content

Commit 5ee2e1a

Browse files
ldecicco-USGSldecicco-USGS
authored
Merge pull request DOI-USGS#751 from ldecicco-USGS/develop
Develop
2 parents e705083 + 07f6481 commit 5ee2e1a

File tree

6 files changed

+86
-45
lines changed

6 files changed

+86
-45
lines changed

‎R/findNLDI.R‎

Lines changed: 2 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -262,8 +262,6 @@ valid_ask <- function(all, type) {
262262
#' ## Find feature by NWIS ID
263263
#' findNLDI(nwis = "11120000")
264264
#'
265-
#' ## Find feature by WQP ID
266-
#' findNLDI(wqp = "USGS-04024315")
267265
#'
268266
#' ## Find feature by LOCATION
269267
#' findNLDI(location = c(-115, 40))
@@ -282,14 +280,14 @@ valid_ask <- function(all, type) {
282280
#' # Discover Features(flowlines will not be returned unless included in find)
283281
#'
284282
#' ## Find feature(s) on the upper tributary of USGS-11120000
285-
#' findNLDI(nwis = "11120000", nav = "UT", find = c("nwis", "wqp"))
283+
#' findNLDI(nwis = "11120000", nav = "UT", find = c("nwis"))
286284
#'
287285
#' ## Find upstream basin boundary and of USGS-11120000
288286
#' findNLDI(nwis = "11120000", find = "basin")
289287
#'
290288
#' # Control Distance
291289
#' ## Limit search to 50 km
292-
#' findNLDI(comid = 101, nav = "DM", find = c("nwis", "wqp", "flowlines"), distance_km = 50)
290+
#' findNLDI(comid = 101, nav = "DM", find = c("nwis", "flowlines"), distance_km = 50)
293291
#' }
294292

295293
findNLDI <- function(comid = NULL,

‎R/getWebServiceData.R‎

Lines changed: 9 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -25,14 +25,22 @@ getWebServiceData <- function(obs_url, ...) {
2525
return(invisible(NULL))
2626
}
2727

28+
if(is.character(obs_url)){
29+
obs_url <- httr2::request(obs_url)
30+
}
31+
2832
obs_url <- httr2::req_user_agent(obs_url, default_ua())
2933
obs_url <- httr2::req_throttle(obs_url, rate = 30 / 60)
3034
obs_url <- httr2::req_retry(obs_url,
3135
backoff = ~ 5, max_tries = 3)
3236
obs_url <- httr2::req_headers(obs_url,
3337
`Accept-Encoding` = c("compress", "gzip"))
3438

35-
message("GET:", obs_url$url)
39+
url_method <- "GET"
40+
if(!is.null(obs_url$body)){
41+
url_method <- "POST"
42+
}
43+
message(url_method, ": ", obs_url$url)
3644
returnedList <- httr2::req_perform(obs_url)
3745

3846
good <- check_non_200s(returnedList)

‎R/read_USGS_samples.R‎

Lines changed: 0 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -119,17 +119,13 @@ construct_USGS_sample_request <- function(monitoringLocationIdentifier = NA,
119119
dataType = "results",
120120
dataProfile = NA){
121121

122-
message("Function in development, use at your own risk.")
123-
124122
dataType <- match.arg(dataType, c("results",
125123
"locations",
126124
"activities",
127125
"projects",
128126
"organizations"),
129127
several.ok = FALSE)
130128

131-
# When RMLS comes out...spring 2025ish,
132-
# we can verify these values hopefully easier:
133129
baseURL <- httr2::request("https://api.waterdata.usgs.gov") |>
134130
httr2::req_url_path_append("samples-data") |>
135131
httr2::req_url_query(mimeType = "text/csv")

‎R/whatWQPdata.R‎

Lines changed: 55 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -35,22 +35,27 @@ whatWQPsamples <- function(...,
3535
} else {
3636
baseURL <- httr2::request(pkg.env[["ActivityWQX3"]])
3737
}
38-
38+
POST = FALSE
3939
if(!legacy){
4040
baseURL <- httr2::req_url_query(baseURL, !!!values,
4141
.multi = "explode")
4242
} else {
4343
if("siteid" %in% names(values)){
4444
if(length(values[["siteid"]]) > 1){
4545
sites <- values[["siteid"]]
46-
baseURL <- httr2::req_url_query(baseURL,
47-
siteid = sites,
48-
.multi = function(x) paste0(x, collapse = ";"))
46+
POST = nchar(paste0(sites, collapse = "")) > 2048
47+
48+
baseURL <- get_or_post(baseURL, POST = POST,
49+
siteid = sites,
50+
.multi = function(x) paste0(x, collapse = ";"))
51+
4952
values <- values[names(values) != "siteid"]
5053
}
5154
}
52-
baseURL <- httr2::req_url_query(baseURL, !!!values,
53-
.multi = "explode")
55+
baseURL <- get_or_post(baseURL,
56+
POST = POST,
57+
!!!values,
58+
.multi = "explode")
5459
}
5560

5661
retval <- importWQP(baseURL,
@@ -97,21 +102,27 @@ whatWQPmetrics <- function(...,
97102
if ("service" %in% names(values)) {
98103
values <- values[!(names(values) %in% "service")]
99104
}
100-
105+
POST = FALSE
101106
baseURL <- httr2::request(pkg.env[["ActivityMetric"]])
102107

103108
if("siteid" %in% names(values)){
104109
if(length(values[["siteid"]]) > 1){
105110
sites <- values[["siteid"]]
106-
baseURL <- httr2::req_url_query(baseURL,
107-
siteid = sites,
108-
.multi = function(x) paste0(x, collapse = ";"))
111+
POST = nchar(paste0(sites, collapse = "")) > 2048
112+
113+
baseURL <- get_or_post(baseURL, POST = POST,
114+
siteid = sites,
115+
.multi = function(x) paste0(x, collapse = ";"))
116+
109117
values <- values[names(values) != "siteid"]
110118
}
111119
}
112-
baseURL <- httr2::req_url_query(baseURL, !!!values,
113-
.multi = "explode")
114120

121+
baseURL <- get_or_post(baseURL,
122+
POST = POST,
123+
!!!values,
124+
.multi = "explode")
125+
115126
withCallingHandlers(
116127
{
117128
retval <- importWQP(baseURL,
@@ -124,6 +135,7 @@ whatWQPmetrics <- function(...,
124135
}
125136
}
126137
)
138+
127139
if(is.null(retval)){
128140
return(NULL)
129141
} else {
@@ -199,25 +211,32 @@ whatWQPdata <- function(...,
199211
if (any(c("tz", "service", "mimeType") %in% names(values))){
200212
values <- values[!(names(values) %in% c("tz", "service", "mimeType"))]
201213
}
202-
214+
POST = FALSE
215+
216+
baseURL <- httr2::request(pkg.env[["Station"]])
217+
203218
if("siteid" %in% names(values)){
204219
if(length(values[["siteid"]]) > 1){
205220
sites <- values[["siteid"]]
206-
baseURL <- httr2::req_url_query(baseURL,
207-
siteid = sites,
208-
.multi = function(x) paste0(x, collapse = ";"))
221+
222+
POST = nchar(paste0(sites, collapse = "")) > 2048
223+
224+
baseURL <- get_or_post(baseURL, POST = POST,
225+
siteid = sites,
226+
.multi = function(x) paste0(x, collapse = ";"))
227+
209228
values <- values[names(values) != "siteid"]
210229
}
211230
}
212-
213-
baseURL <- httr2::request(pkg.env[["Station"]])
214-
215-
baseURL <- httr2::req_url_query(baseURL,
216-
!!!values,
217-
.multi = "explode")
218231

219-
baseURL <- httr2::req_url_query(baseURL,
220-
mimeType = "geojson")
232+
baseURL <- get_or_post(req = baseURL,
233+
POST = POST,
234+
!!!values,
235+
.multi = "explode")
236+
237+
baseURL <- get_or_post(baseURL,
238+
POST = POST,
239+
mimeType = "geojson")
221240

222241
# Not sure if there's a geojson option with WQX3
223242
wqp_message()
@@ -297,3 +316,15 @@ whatWQPdata <- function(...,
297316
attr(y, "url") <- baseURL
298317
return(y)
299318
}
319+
320+
get_or_post <- function(req, POST = FALSE, ...){
321+
322+
if(POST){
323+
req <- httr2::req_body_form(req, ...)
324+
325+
} else {
326+
req <- httr2::req_url_query(req, ...)
327+
}
328+
return(req)
329+
}
330+

‎R/whatWQPsites.R‎

Lines changed: 18 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -53,25 +53,35 @@ whatWQPsites <- function(..., legacy = TRUE, convertType = TRUE) {
5353
if (any(c("tz", "service") %in% names(values))){
5454
values <- values[!(names(values) %in% c("tz", "service"))]
5555
}
56-
56+
POST = FALSE
57+
5758
if(legacy){
5859
baseURL <- httr2::request(pkg.env[["Station"]])
60+
5961
if("siteid" %in% names(values)){
6062
if(length(values[["siteid"]]) > 1){
6163
sites <- values[["siteid"]]
62-
baseURL <- httr2::req_url_query(baseURL,
63-
siteid = sites,
64-
.multi = function(x) paste0(x, collapse = ";"))
64+
POST = nchar(paste0(sites, collapse = "")) > 2048
65+
66+
baseURL <- get_or_post(baseURL,
67+
POST = POST,
68+
siteid = sites,
69+
.multi = function(x) paste0(x, collapse = ";"))
70+
6571
values <- values[names(values) != "siteid"]
6672
}
6773
}
74+
6875
} else {
6976
baseURL <- httr2::request(pkg.env[["StationWQX3"]])
7077
}
71-
baseURL <- httr2::req_url_query(baseURL,
72-
!!!values,
73-
.multi = "explode")
74-
78+
79+
baseURL <- get_or_post(baseURL,
80+
POST = POST,
81+
!!!values,
82+
.multi = "explode")
83+
84+
7585
retval <- importWQP(baseURL, convertType = convertType)
7686

7787
if(!is.null(retval)){

‎man/findNLDI.Rd‎

Lines changed: 2 additions & 4 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

0 commit comments

Comments
 (0)