Skip to content

Commit 6f00ece

Browse files
ldecicco-USGSldecicco-USGS
authored
Merge pull request #767 from ldecicco-USGS/develop
Develop
2 parents 5fcfc00 + 2262de8 commit 6f00ece

19 files changed

+300
-162
lines changed

‎DESCRIPTION‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
Package: dataRetrieval
22
Type: Package
33
Title: Retrieval Functions for USGS and EPA Hydrology and Water Quality Data
4-
Version: 2.7.18
4+
Version: 2.7.18.9002
55
Authors@R: c(
66
person("Laura", "DeCicco", role = c("aut","cre"),
77
email = "ldecicco@usgs.gov",

‎R/AAA.R‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -46,8 +46,8 @@ is_legacy <- function(service){
4646
}
4747

4848
nwis_message <- function(){
49-
return("WARNING: NWIS does not deliver
50-
discrete water quality data newer than March 11, 2024
51-
or updates to existing data. For additional details, see:
49+
return("WARNING: whatNWISdata does not include
50+
discrete water quality data newer than March 11, 2024.
51+
For additional details, see:
5252
https://doi-usgs.github.io/dataRetrieval/articles/Status.html")
5353
}

‎R/constructNWISURL.R‎

Lines changed: 125 additions & 64 deletions
Original file line numberDiff line numberDiff line change
@@ -79,8 +79,14 @@ constructNWISURL <- function(siteNumbers,
7979
service[service == "meas"] <- "measurements"
8080
service[service == "uv"] <- "iv"
8181

82+
POST = nchar(paste0(siteNumbers, parameterCd, collapse = "")) > 2048
83+
8284
baseURL <- httr2::request(pkg.env[[service]])
8385

86+
if(!is.null(pkg.env$access)){
87+
baseURL <- httr2::req_url_query(baseURL, Access = pkg.env$access)
88+
}
89+
8490
if (any(!is.na(parameterCd) & parameterCd != "all")) {
8591
pcodeCheck <- all(nchar(parameterCd) == 5) & all(!is.na(suppressWarnings(as.numeric(parameterCd))))
8692

@@ -97,43 +103,60 @@ constructNWISURL <- function(siteNumbers,
97103
switch(service,
98104
rating = {
99105
ratingType <- match.arg(ratingType, c("base", "corr", "exsa"))
100-
url <- httr2::req_url_query(baseURL,
101-
site_no = siteNumbers,
102-
file_type = ratingType)
106+
url <- get_or_post(baseURL,
107+
POST = POST,
108+
site_no = siteNumbers,
109+
file_type = ratingType)
103110
},
104111
peak = {
105-
url <- httr2::req_url_query(baseURL,
112+
url <- get_or_post(baseURL,
113+
POST = POST,
106114
range_selection = "date_range",
107115
format = "rdb")
108-
url <- httr2::req_url_query(url,
109-
site_no = siteNumbers,
110-
.multi = "comma")
116+
url <- get_or_post(url,
117+
POST = POST,
118+
site_no = siteNumbers,
119+
.multi = "comma")
120+
111121
if (nzchar(startDate)) {
112-
url <- httr2::req_url_query(url, begin_date = startDate)
122+
url <- get_or_post(url,
123+
POST = POST,
124+
begin_date = startDate)
113125
}
114126
if (nzchar(endDate)) {
115-
url <- httr2::req_url_query(url, end_date = endDate)
127+
url <- get_or_post(url,
128+
POST = POST,
129+
end_date = endDate)
116130
}
117131
},
118132
measurements = {
119-
url <- httr2::req_url_query(baseURL,
133+
url <- get_or_post(baseURL,
134+
POST = POST,
120135
site_no = siteNumbers,
121136
.multi = "comma")
122-
url <- httr2::req_url_query(url,
123-
range_selection = "date_range"
137+
url <- get_or_post(url,
138+
POST = POST,
139+
range_selection = "date_range"
124140
)
125141
if (nzchar(startDate)) {
126-
url <- httr2::req_url_query(url,
142+
url <- get_or_post(url,
143+
POST = POST,
127144
begin_date = startDate
128145
)
129146
}
130147
if (nzchar(endDate)) {
131-
url <- httr2::req_url_query(url, end_date = endDate)
148+
url <- get_or_post(url,
149+
POST = POST,
150+
end_date = endDate)
132151
}
133152
if (expanded) {
134-
url <- httr2::req_url_query(url, format = "rdb_expanded")
153+
url <- get_or_post(url,
154+
POST = POST,
155+
format = "rdb_expanded")
135156
} else {
136-
url <- httr2::req_url_query(url, format = "rdb")
157+
url <- get_or_post(url,
158+
POST = POST,
159+
format = "rdb")
137160
}
138161
},
139162
stat = { # for statistics service
@@ -158,42 +181,62 @@ constructNWISURL <- function(siteNumbers,
158181
stop("Start and end dates for annual statReportType can only include years")
159182
}
160183

161-
url <- httr2::req_url_query(baseURL,
184+
url <- get_or_post(baseURL,
185+
POST = POST,
162186
sites = siteNumbers,
163187
.multi = "comma")
164-
url <- httr2::req_url_query(url,
165-
statReportType = statReportType,
166-
.multi = "comma")
167-
url <- httr2::req_url_query(url, statType = statType,
168-
.multi = "comma")
169-
url <- httr2::req_url_query(url, parameterCd = parameterCd,
170-
.multi = "comma")
188+
url <- get_or_post(url,
189+
POST = POST,
190+
statReportType = statReportType,
191+
.multi = "comma")
192+
url <- get_or_post(url,
193+
POST = POST,
194+
statType = statType,
195+
.multi = "comma")
196+
url <- get_or_post(url,
197+
POST = POST,
198+
parameterCd = parameterCd,
199+
.multi = "comma")
171200

172201
if (nzchar(startDate)) {
173-
url <- httr2::req_url_query(url, startDT = startDate)
202+
url <- get_or_post(url,
203+
POST = POST,
204+
startDT = startDate)
174205
}
175206
if (nzchar(endDate)) {
176-
url <- httr2::req_url_query(url, endDT = endDate)
207+
url <- get_or_post(url,
208+
POST = POST,
209+
endDT = endDate)
177210
}
178211
if (!grepl("(?i)daily", statReportType)) {
179-
url <- httr2::req_url_query(url, missingData = "off")
212+
url <- get_or_post(url,
213+
POST = POST,
214+
missingData = "off")
180215
}
181216
},
182217
gwlevels = {
183-
184-
url <- httr2::req_url_query(baseURL,
185-
site_no = siteNumbers, .multi = "comma")
186-
url <- httr2::req_url_query(url,format = "rdb")
218+
url <- get_or_post(baseURL,
219+
POST = POST,
220+
site_no = siteNumbers,
221+
.multi = "comma")
222+
url <- get_or_post(url,
223+
POST = POST,
224+
format = "rdb")
187225
if (nzchar(startDate)) {
188-
url <- httr2::req_url_query(url, begin_date = startDate)
226+
url <- get_or_post(url,
227+
POST = POST,
228+
begin_date = startDate)
189229
}
190230
if (nzchar(endDate)) {
191-
url <- httr2::req_url_query(url, end_date = endDate)
231+
url <- get_or_post(url,
232+
POST = POST,
233+
end_date = endDate)
192234
}
193-
url <- httr2::req_url_query(url,
194-
group_key = "NONE",
195-
date_format = "YYYY-MM-DD",
196-
rdb_compression = "value")
235+
url <- get_or_post(url,
236+
POST = POST,
237+
group_key = "NONE",
238+
date_format = "YYYY-MM-DD",
239+
rdb_compression = "value")
197240
},
198241
{ # this will be either dv, uv, groundwater
199242

@@ -207,34 +250,44 @@ constructNWISURL <- function(siteNumbers,
207250
wml1 = "waterml,1.1"
208251
)
209252

210-
url <- httr2::req_url_query(baseURL,
211-
site = siteNumbers,
212-
.multi = "comma")
213-
url <- httr2::req_url_query(url,
214-
format = formatURL)
253+
url <- get_or_post(baseURL,
254+
POST = POST,
255+
site = siteNumbers,
256+
.multi = "comma")
257+
url <- get_or_post(url,
258+
POST = POST,
259+
format = formatURL)
215260

216261
if (!all(is.na(parameterCd))) {
217-
url <- httr2::req_url_query(url,
218-
ParameterCd = parameterCd,
219-
.multi = "comma")
262+
url <- get_or_post(url,
263+
POST = POST,
264+
ParameterCd = parameterCd,
265+
.multi = "comma")
220266
}
221267

222268
if ("dv" == service) {
223-
url <- httr2::req_url_query(url,
224-
StatCd = statCd,
225-
.multi = "comma")
269+
url <- get_or_post(url,
270+
POST = POST,
271+
StatCd = statCd,
272+
.multi = "comma")
226273
}
227274

228275
if (nzchar(startDate)) {
229-
url <- httr2::req_url_query(url, startDT = startDate)
276+
url <- get_or_post(url,
277+
POST = POST,
278+
startDT = startDate)
230279
} else {
231280
startorgin <- "1851-01-01"
232281
if ("iv" == service) startorgin <- "1900-01-01"
233-
url <- httr2::req_url_query(url, startDT = startorgin)
282+
url <- get_or_post(url,
283+
POST = POST,
284+
startDT = startorgin)
234285
}
235286

236287
if (nzchar(endDate)) {
237-
url <- httr2::req_url_query(url, endDT = endDate)
288+
url <- get_or_post(url,
289+
POST = POST,
290+
endDT = endDate)
238291
}
239292
}
240293
)
@@ -300,6 +353,8 @@ constructWQPURL <- function(siteNumbers,
300353

301354
pCodeLogic <- TRUE
302355

356+
POST = nchar(paste0(siteNumbers, collapse = "")) > 2048
357+
303358
if(!allPCode){
304359
multiplePcodes <- length(parameterCd) > 1
305360
if (all(nchar(parameterCd) == 5)) {
@@ -311,11 +366,13 @@ constructWQPURL <- function(siteNumbers,
311366

312367
if(legacy){
313368
baseURL <- httr2::request(pkg.env[["Result"]])
314-
baseURL <- httr2::req_url_query(baseURL,
315-
siteid = siteNumbers,
316-
.multi = function(x) paste0(x, collapse = ";"))
317-
baseURL <- httr2::req_url_query(baseURL,
318-
count = "no")
369+
baseURL <- get_or_post(baseURL,
370+
POST = POST,
371+
siteid = siteNumbers,
372+
.multi = function(x) paste0(x, collapse = ";"))
373+
baseURL <- get_or_post(baseURL,
374+
POST = POST,
375+
count = "no")
319376
} else {
320377
baseURL <- httr2::request(pkg.env[["ResultWQX3"]])
321378
baseURL <- httr2::req_url_query(baseURL,
@@ -325,9 +382,10 @@ constructWQPURL <- function(siteNumbers,
325382

326383
if(legacy & !allPCode){
327384
if(pCodeLogic){
328-
baseURL <- httr2::req_url_query(baseURL,
329-
pCode = parameterCd,
330-
.multi = function(x) paste0(x, collapse = ";"))
385+
baseURL <- get_or_post(baseURL,
386+
POST = POST,
387+
pCode = parameterCd,
388+
.multi = function(x) paste0(x, collapse = ";"))
331389
} else {
332390
baseURL <- httr2::req_url_query(baseURL,
333391
characteristicName = parameterCd,
@@ -348,17 +406,20 @@ constructWQPURL <- function(siteNumbers,
348406

349407
if (nzchar(startDate)) {
350408
startDate <- format(as.Date(startDate), format = "%m-%d-%Y")
351-
baseURL <- httr2::req_url_query(baseURL,
352-
startDateLo = startDate)
409+
baseURL <- get_or_post(baseURL,
410+
POST = POST,
411+
startDateLo = startDate)
353412
}
354413

355414
if (nzchar(endDate)) {
356415
endDate <- format(as.Date(endDate), format = "%m-%d-%Y")
357-
baseURL <- httr2::req_url_query(baseURL,
358-
startDateHi = endDate)
416+
baseURL <- get_or_post(baseURL,
417+
POST = POST,
418+
startDateHi = endDate)
359419
}
360420

361-
baseURL <- httr2::req_url_query(baseURL, mimeType = "csv")
421+
baseURL <- httr2::req_url_query(baseURL,
422+
mimeType = "csv")
362423
if(!legacy){
363424
baseURL <- httr2::req_url_query(baseURL,
364425
dataProfile = "basicPhysChem")

‎R/dataRetrievals-package.R‎

Lines changed: 4 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -89,9 +89,8 @@ NULL
8989

9090
#' US State Code Lookup Table
9191
#'
92-
#' Data originally pulled from \url{https://www2.census.gov/geo/docs/reference/state.txt}
93-
#' on April 1, 2015. On Feb. 11, 2022, the fields were updated with the
94-
#' file found in inst/extdata, which is used internally with NWIS retrievals.
92+
#' Classic lookup table for states. Has been replaced in functions with
93+
#' \code{check_param("states")}.
9594
#'
9695
#' @name stateCd
9796
#' @return stateCd data frame.
@@ -112,9 +111,8 @@ NULL
112111

113112
#' US County Code Lookup Table
114113
#'
115-
#' Data originally pulled from \url{https://www2.census.gov/geo/docs/reference/codes/files/national_county.txt}
116-
#' on April 1, 2015. On Feb. 11, 2022, the fields were updated with the
117-
#' file found in inst/extdata, which is used internally with NWIS retrievals.
114+
#' Classic lookup table for counties. Has been replaced in functions with
115+
#' \code{check_param("counties")}.
118116
#'
119117
#' @name countyCd
120118
#' @return countyCd data frame.

‎R/findNLDI.R‎

Lines changed: 2 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -270,8 +270,6 @@ valid_ask <- function(all, type) {
270270
#' ## Find feature by NWIS ID
271271
#' findNLDI(nwis = "11120000")
272272
#'
273-
#' ## Find feature by WQP ID
274-
#' findNLDI(wqp = "USGS-04024315")
275273
#'
276274
#' ## Find feature by LOCATION
277275
#' findNLDI(location = c(-115, 40))
@@ -290,14 +288,14 @@ valid_ask <- function(all, type) {
290288
#' # Discover Features(flowlines will not be returned unless included in find)
291289
#'
292290
#' ## Find feature(s) on the upper tributary of USGS-11120000
293-
#' findNLDI(nwis = "11120000", nav = "UT", find = c("nwis", "wqp"))
291+
#' findNLDI(nwis = "11120000", nav = "UT", find = c("nwis"))
294292
#'
295293
#' ## Find upstream basin boundary and of USGS-11120000
296294
#' findNLDI(nwis = "11120000", find = "basin")
297295
#'
298296
#' # Control Distance
299297
#' ## Limit search to 50 km
300-
#' findNLDI(comid = 101, nav = "DM", find = c("nwis", "wqp", "flowlines"), distance_km = 50)
298+
#' findNLDI(comid = 101, nav = "DM", find = c("nwis", "flowlines"), distance_km = 50)
301299
#' }
302300

303301
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)

0 commit comments

Comments
 (0)