Unverified Commit 08ee437d authored by Laura A DeCicco's avatar Laura A DeCicco Committed by GitHub
Browse files

Merge pull request #581 from ldecicco-USGS/master

Failing gracefully
parents f62b51b5 5f94aff2
......@@ -20,9 +20,7 @@ jobs:
config:
- {os: macOS-latest, r: 'release'}
- {os: windows-latest, r: 'release'}
- {os: ubuntu-16.04, r: 'devel', rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest", http-user-agent: "R/4.0.0 (ubuntu-16.04) R (4.0.0 x86_64-pc-linux-gnu x86_64 linux-gnu) on GitHub Actions" }
- {os: ubuntu-16.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
- {os: ubuntu-16.04, r: 'oldrel', rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
- {os: ubuntu-18.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/bionic/latest"}
env:
R_REMOTES_NO_ERRORS_FROM_WARNINGS: true
......
Package: dataRetrieval
Type: Package
Title: Retrieval Functions for USGS and EPA Hydrologic and Water Quality Data
Version: 2.7.9.0001
Version: 2.7.10
Authors@R: c(
person("Laura", "DeCicco", role = c("aut","cre"),
email = "ldecicco@usgs.gov",
......
dataRetrieval 2.8.10
==================
* Functions that come back from a server that had and error now return with a message and NULL rather than error.
dataRetrieval 2.7.9
===================
* Fix bug caused by changes in NLDI services
......
......@@ -33,13 +33,20 @@ getWebServiceData <- function(obs_url, ...){
response400 <- httr::content(returnedList, type="text", encoding = "UTF-8")
statusReport <- xml_text(xml_child(read_xml(response400), 2)) # making assumption that - body is second node
statusMsg <- gsub(pattern=", server=.*", replacement="", x = statusReport)
stop(statusMsg)
message(statusMsg)
return(invisible(NULL))
} else if(httr::status_code(returnedList) != 200){
message("For: ", obs_url,"\n")
httr::stop_for_status(returnedList)
httr::message_for_status(returnedList)
return(invisible(NULL))
} else {
headerInfo <- httr::headers(returnedList)
if(!"content-type" %in% names(headerInfo)){
message("Unknown content, returning NULL")
return(invisible(NULL))
}
if(headerInfo$`content-type` %in% c("text/tab-separated-values;charset=UTF-8")){
returnedDoc <- httr::content(returnedList, type="text",encoding = "UTF-8")
} else if (headerInfo$`content-type` %in%
......
......@@ -25,7 +25,8 @@
#' "observedProperty=urn:ogc:def:property:OGC:GroundWaterLevel",
#' "responseFormat=text/xml",
#' "featureOfInterest=VW_GWDP_GEOSERVER.USGS.403836085374401",sep="&")
#' data <- importNGWMN(obs_url)
#'
#' data_returned <- importNGWMN(obs_url)
#'
#' }
#'
......@@ -43,7 +44,9 @@ importNGWMN <- function(input, asDateTime=FALSE, tz="UTC"){
raw <- TRUE
} else {
returnedDoc <- getWebServiceData(input, encoding='gzip')
if(is.null(returnedDoc)){
return(invisible(NULL))
}
returnedDoc <- xml_root(returnedDoc)
}
......@@ -141,7 +144,9 @@ importNGWMN <- function(input, asDateTime=FALSE, tz="UTC"){
#' "statCd=00003",
#' "parameterCd=00060",sep="&")
#' \donttest{
#'
#' timesereies <- importWaterML2(URL, asDateTime=TRUE, tz="UTC")
#'
#' }
importWaterML2 <- function(input, asDateTime=FALSE, tz="UTC") {
......
......@@ -54,22 +54,31 @@
#' \donttest{
#' data <- importRDB1(obs_url)
#'
#'
#' urlMultiPcodes <- constructNWISURL("04085427",c("00060","00010"),
#' startDate,endDate,"dv",statCd=c("00003","00001"),"tsv")
#'
#' multiData <- importRDB1(urlMultiPcodes)
#'
#' unitDataURL <- constructNWISURL(site_id,property,
#' "2020-10-30","2020-11-01","uv",format="tsv") #includes timezone switch
#'
#' unitData <- importRDB1(unitDataURL, asDateTime=TRUE)
#'
#' qwURL <- constructNWISURL(c('04024430','04024000'),
#' c('34247','30234','32104','34220'),
#' "2010-11-03","","qw",format="rdb")
#'
#' qwData <- importRDB1(qwURL, asDateTime=TRUE, tz="America/Chicago")
#'
#' iceSite <- '04024000'
#' start <- "2015-11-09"
#' end <- "2015-11-24"
#' urlIce <- constructNWISURL(iceSite,"00060",start, end,"uv",format="tsv")
#'
#' ice <- importRDB1(urlIce, asDateTime=TRUE)
#' iceNoConvert <- importRDB1(urlIce, convertType=FALSE)
#'
#' }
#' # User file:
#' filePath <- system.file("extdata", package="dataRetrieval")
......@@ -94,6 +103,9 @@ importRDB1 <- function(obs_url, asDateTime=TRUE, convertType = TRUE, tz="UTC"){
doc <- getWebServiceData(obs_url,
httr::write_disk(f),
encoding='gzip')
if(is.null(doc)){
return(invisible(NULL))
}
if("warn" %in% names(attr(doc, "headerInfo"))){
data <- data.frame()
attr(data, "headerInfo") <- attr(doc,"headerInfo")
......
......@@ -25,11 +25,14 @@
#' rawSample <- importWQP(rawSampleURL)
#'
#' rawSampleURL_NoZip <- constructWQPURL('USGS-01594440','01075', '', '', zip=FALSE)
#'
#' rawSample2 <- importWQP(rawSampleURL_NoZip, zip=FALSE)
#'
#' STORETex <- constructWQPURL('WIDNR_WQX-10032762','Specific conductance', '', '')
#'
#' STORETdata <- importWQP(STORETex)
#' }
#'
importWQP <- function(obs_url, zip=TRUE, tz="UTC",
csv=FALSE){
......@@ -49,6 +52,9 @@ importWQP <- function(obs_url, zip=TRUE, tz="UTC",
doc <- getWebServiceData(obs_url,
httr::write_disk(temp),
httr::accept("application/zip"))
if(is.null(doc)){
return(invisible(NULL))
}
headerInfo <- httr::headers(doc)
doc <- utils::unzip(temp, exdir=tempdir())
unlink(temp)
......@@ -56,6 +62,9 @@ importWQP <- function(obs_url, zip=TRUE, tz="UTC",
} else {
doc <- getWebServiceData(obs_url,
httr::accept("text/tsv"))
if(is.null(doc)){
return(invisible(NULL))
}
headerInfo <- attr(doc, "headerInfo")
}
......
......@@ -115,7 +115,7 @@ importWaterML1 <- function(obs_url,asDateTime=FALSE, tz="UTC"){
timeSeries <- xml_find_all(returnedDoc, ".//ns1:timeSeries") #each parameter/site combo
#some intial attributes
#some initial attributes
queryNodes <- xml_children(xml_find_all(returnedDoc,".//ns1:queryInfo"))
notes <- queryNodes[xml_name(queryNodes)=="note"]
noteTitles <- xml_attrs(notes)
......@@ -124,7 +124,10 @@ importWaterML1 <- function(obs_url,asDateTime=FALSE, tz="UTC"){
names(noteList) <- noteTitles
if(0 == length(timeSeries)){
df <- data.frame()
df <- data.frame(agency_cd = character(),
site_no = character(),
dateTime = as.POSIXct(character()),
tz_cd = character())
attr(df, "queryInfo") <- noteList
if(!raw){
attr(df, "url") <- obs_url
......@@ -410,7 +413,12 @@ check_if_xml <- function(obs_url){
} else if(inherits(obs_url, c("xml_node", "xml_nodeset"))) {
returnedDoc <- obs_url
} else {
returnedDoc <- xml_root(getWebServiceData(obs_url, encoding='gzip'))
doc <- getWebServiceData(obs_url, encoding='gzip')
if(is.null(doc)){
return(invisible(NULL))
}
returnedDoc <- xml_root(doc)
}
return(returnedDoc)
}
\ No newline at end of file
......@@ -56,6 +56,7 @@
#' @examples
#' \donttest{
#' # Examples not run for time considerations
#'
#' dataTemp <- readNWISdata(stateCd="OH",parameterCd="00010", service="dv")
#' instFlow <- readNWISdata(sites="05114000", service="iv",
#' parameterCd="00060",
......@@ -76,32 +77,35 @@
#'
#' startDate <- as.Date("2013-10-01")
#' endDate <- as.Date("2014-09-30")
#' waterYear <- readNWISdata(bBox=c(-83,36.5,-81,38.5), parameterCd="00010",
#' waterYear <- readNWISdata(bBox=c(-83,36.5,-82.5,36.75), parameterCd="00010",
#' service="dv", startDate=startDate, endDate=endDate)
#' siteInfo <- readNWISdata(stateCd="WI", parameterCd="00010",
#' hasDataTypeCd="iv", service="site")
#' temp <- readNWISdata(bBox=c(-83,36.5,-81,38.5), parameterCd="00010", service="site",
#' temp <- readNWISdata(bBox=c(-83,36.5,-82.5,36.75), parameterCd="00010", service="site",
#' seriesCatalogOutput=TRUE)
#' wiGWL <- readNWISdata(stateCd="WI",service="gwlevels")
#' meas <- readNWISdata(state_cd="WI",service="measurements",format="rdb_expanded")
#' wiGWL <- readNWISdata(stateCd = "WI", service = "gwlevels")
#' meas <- readNWISdata(state_cd = "WI", service = "measurements",
#' format = "rdb_expanded")
#'
#' waterYearStat <- readNWISdata(site=c("01646500"),service="stat",statReportType="annual",
#' statYearType="water", missingData="on")
#' waterYearStat <- readNWISdata(site = c("01646500"),
#' service = "stat",
#' statReportType="annual",
#' statYearType = "water",
#' missingData = "on")
#' monthlyStat <- readNWISdata(site=c("01646500"),
#' service="stat",
#' statReportType="monthly")
#' dailyStat <- readNWISdata(site=c("01646500"),
#' service="stat",
#' statReportType="daily",
#' statType=c("p25","p50","p75","min","max"),
#' parameterCd="00060")
#'
#' dailyRI <- readNWISdata(stateCd = "Rhode Island", parameterCd = "00060")
#' dailyStat <- readNWISdata(site = c("01646500"),
#' service = "stat",
#' statReportType = "daily",
#' statType = c("p25","p50","p75","min","max"),
#' parameterCd = "00060")
#'
#' arg.list <- list(site="03111548",
#' statReportType="daily",
#' statType=c("p25","p50","p75","min","max"),
#' parameterCd="00060")
#' arg.list <- list(site = "03111548",
#' statReportType = "daily",
#' statType = c("p25","p50","p75","min","max"),
#' parameterCd = "00060")
#' allDailyStats_2 <- readNWISdata(arg.list, service="stat")
#'
#' #' # use county names to get data
......@@ -113,6 +117,7 @@
#' va_counties <- c("51001","51003","51005","51007","51009","51011","51013","51015")
#' va_counties_data <- readNWISdata(startDate = "2015-01-01", endDate = "2015-12-31",
#' parameterCd = "00060", countycode = va_counties)
#'
#' site_id <- '01594440'
#' rating_curve <- readNWISdata(service = "rating", site_no = site_id, file_type="base")
#' all_sites_base <- readNWISdata(service = "rating", file_type="base")
......@@ -120,13 +125,11 @@
#' all_sites_exsa <- readNWISdata(service = "rating", file_type="exsa")
#' all_sites_24hrs <- readNWISdata(service = "rating", file_type="exsa", period = 24)
#'
#' today <- readNWISdata(service="iv", startDate = Sys.Date(),
#' parameterCd = "00060", siteNumber = "05114000")
#'
#' peak_data <- readNWISdata(service = "peak",
#' site_no = c("01594440","040851325"),
#' range_selection = "data_range")
#'
#'
#' }
readNWISdata <- function(..., asDateTime=TRUE,convertType=TRUE,tz="UTC"){
......
......@@ -21,6 +21,7 @@
#' @export
#' @seealso \code{\link{importRDB1}}
#' @examples
#'
#' paramINFO <- readNWISpCode(c('01075','00060','00931'))
#' paramINFO <- readNWISpCode(c('01075','00060','00931', NA))
readNWISpCode <- function(parameterCd){
......
......@@ -61,8 +61,10 @@
#' @export
#' @examples
#' \donttest{
#'
#' siteINFO <- readNWISsite('05114000')
#' siteINFOMulti <- readNWISsite(c('05114000','09423350'))
#'
#' }
readNWISsite <- function(siteNumbers){
......
......@@ -54,6 +54,7 @@
#' startDate <- "2014-10-10"
#' endDate <- "2014-10-10"
#' \donttest{
#'
#' rawData <- readNWISuv(site_id,parameterCd,startDate,endDate)
#'
#' rawData_today <- readNWISuv(site_id, parameterCd, Sys.Date(),Sys.Date())
......@@ -68,8 +69,8 @@
#' # Adding 'Z' to the time indicates to the web service to call the data with UTC time:
#' GMTdata <- readNWISuv(site_id,parameterCd,
#' "2014-10-10T00:00Z", "2014-10-10T23:59Z")
#' }
#'
#' }
readNWISuv <- function (siteNumbers,parameterCd,startDate="",endDate="", tz="UTC"){
if(as.character(startDate) == "" || (as.Date(startDate) <= Sys.Date()-120)){
......
......@@ -51,6 +51,7 @@
#' @export
#' @examples
#' \donttest{
#'
#' availableData <- whatNWISdata(siteNumber = '05114000')
#' # To find just unit value ('instantaneous') data:
#' uvData <- whatNWISdata(siteNumber = '05114000',service="uv")
......@@ -58,6 +59,7 @@
#' flowAndTemp <- whatNWISdata(stateCd = "WI", service = "uv",
#' parameterCd = c("00060","00010"),
#' statCd = "00003")
#'
#' }
whatNWISdata <- function(..., convertType=TRUE){
......
......@@ -30,8 +30,10 @@
#'
#' @examples
#' \donttest{
#'
#' siteListPhos <- whatNWISsites(stateCd="OH",parameterCd="00665")
#' oneSite <- whatNWISsites(sites="05114000")
#'
#' }
whatNWISsites <- function(...){
......@@ -43,7 +45,9 @@ whatNWISsites <- function(...){
urlCall <- drURL('site',Access=pkg.env$access, arg.list = values)
rawData <- getWebServiceData(urlCall, encoding='gzip')
if(is.null(rawData)){
return(invisible(NULL))
}
doc <- xml_root(rawData)
siteCategories <- xml_children(doc)
retVal <- NULL
......
......@@ -3,10 +3,12 @@
#' @export
#' @examples
#' \donttest{
#'
#' site1 <- whatWQPsamples(siteid="USGS-01594440")
#'
#' type <- "Stream"
#' sites <- whatWQPsamples(countycode="US:55:025",siteType=type)
#'
#' }
whatWQPsamples <- function(...){
......@@ -159,6 +161,9 @@ whatWQPdata <- function(..., saveFile = tempfile()){
}
doc <- getWebServiceData(baseURL, httr::write_disk(saveFile_zip))
if(is.null(doc)){
return(invisible(NULL))
}
headerInfo <- attr(doc, "headerInfo")
if(headerInfo$`total-site-count` == 0){
......
......@@ -58,12 +58,14 @@
#' @seealso whatNWISdata
#' @examples
#' \donttest{
#'
#' site1 <- whatWQPsites(siteid="USGS-01594440")
#'
#' type <- "Stream"
#' sites <- whatWQPsites(countycode="US:55:025",
#' characteristicName = "Phosphorus",
#' siteType=type)
#'
#' }
whatWQPsites <- function(...){
......
......@@ -26,6 +26,6 @@ offering <- '00003'
property <- '00060'
obs_url <- constructNWISURL(siteNumber,property,startDate,endDate,'dv')
\donttest{
rawData <- getWebServiceData(obs_url)
rawData <- getWebServiceData(obs_url)
}
}
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment