Commit 917aae6f authored by Laura A DeCicco's avatar Laura A DeCicco
Browse files

Having the NGWMN data return even if the site request fails

parent c74dd184
...@@ -58,11 +58,24 @@ getWebServiceData <- function(obs_url, ...){ ...@@ -58,11 +58,24 @@ getWebServiceData <- function(obs_url, ...){
txt <- readBin(returnedList$content, character()) txt <- readBin(returnedList$content, character())
message(txt) message(txt)
return(txt) return(txt)
} else { } else {
returnedDoc <- content(returnedList,encoding = "UTF-8") returnedDoc <- content(returnedList,encoding = "UTF-8")
if(grepl("No sites/data found using the selection criteria specified", returnedDoc)){ if(grepl("No sites/data found using the selection criteria specified", returnedDoc)){
message(returnedDoc) message(returnedDoc)
} }
if(headerInfo$`content-type` == "text/xml"){
if(xml_name(read_xml(returnedList)) == "ExceptionReport"){
statusReport <- tryCatch({
xml_text(xml_child(read_xml(returnedList)))
})
if(grepl("No feature found",statusReport )){
message(statusReport)
}
}
}
} }
attr(returnedDoc, "headerInfo") <- headerInfo attr(returnedDoc, "headerInfo") <- headerInfo
......
...@@ -49,7 +49,10 @@ importNGWMN <- function(input, asDateTime=FALSE, tz="UTC"){ ...@@ -49,7 +49,10 @@ importNGWMN <- function(input, asDateTime=FALSE, tz="UTC"){
returnedDoc <- read_xml(input) returnedDoc <- read_xml(input)
raw <- TRUE raw <- TRUE
} else { } else {
returnedDoc <- xml_root(getWebServiceData(input, encoding='gzip')) returnedDoc <- getWebServiceData(input, encoding='gzip')
returnedDoc <- xml_root(returnedDoc)
} }
response <- xml_name(returnedDoc) response <- xml_name(returnedDoc)
...@@ -96,7 +99,7 @@ importNGWMN <- function(input, asDateTime=FALSE, tz="UTC"){ ...@@ -96,7 +99,7 @@ importNGWMN <- function(input, asDateTime=FALSE, tz="UTC"){
attr(mergedDF, "contact") <- xml_attr(meta, "href") attr(mergedDF, "contact") <- xml_attr(meta, "href")
attr(mergedDF, "responsibleParty") <- xml_text(xml_find_all(meta, ".//gco:CharacterString")) attr(mergedDF, "responsibleParty") <- xml_text(xml_find_all(meta, ".//gco:CharacterString"))
}else if(response == "GetFeatureOfInterestResponse"){ } else if (response == "GetFeatureOfInterestResponse"){
featureMembers <- xml_find_all(returnedDoc, ".//sos:featureMember") featureMembers <- xml_find_all(returnedDoc, ".//sos:featureMember")
site <- xml_text(xml_find_all(featureMembers,".//gml:identifier")) site <- xml_text(xml_find_all(featureMembers,".//gml:identifier"))
site <- substring(site, 8) site <- substring(site, 8)
...@@ -111,9 +114,12 @@ importNGWMN <- function(input, asDateTime=FALSE, tz="UTC"){ ...@@ -111,9 +114,12 @@ importNGWMN <- function(input, asDateTime=FALSE, tz="UTC"){
dec_lon_va <- "dplyr var" dec_lon_va <- "dplyr var"
siteLocs <- mutate(siteLocs, dec_lat_va=as.numeric(dec_lat_va), dec_lon_va=as.numeric(dec_lon_va)) siteLocs <- mutate(siteLocs, dec_lat_va=as.numeric(dec_lat_va), dec_lon_va=as.numeric(dec_lon_va))
mergedDF <- cbind.data.frame(site, description = siteDesc, siteLocs, stringsAsFactors = FALSE) mergedDF <- cbind.data.frame(site, description = siteDesc, siteLocs, stringsAsFactors = FALSE)
}
else{ } else if (response == "ExceptionReport"){
return(data.frame())
} else {
stop("Unrecognized response from the web service") stop("Unrecognized response from the web service")
return(data.frame())
} }
return(mergedDF) return(mergedDF)
} }
......
...@@ -68,8 +68,15 @@ readNGWMNdata <- function(service, ..., asDateTime = TRUE, tz = "UTC"){ ...@@ -68,8 +68,15 @@ readNGWMNdata <- function(service, ..., asDateTime = TRUE, tz = "UTC"){
allAttrs <- bind_rows(allAttrs, obsFIDattr) allAttrs <- bind_rows(allAttrs, obsFIDattr)
} }
allSites <- retrieveFeatureOfInterest(featureID = featureID)
attr(allObs, "siteInfo") <- allSites allSites <- tryCatch({
retrieveFeatureOfInterest(featureID = featureID)
})
if(!is.null(allSites)){
attr(allObs, "siteInfo") <- allSites
}
attr(allObs, "other") <- allAttrs attr(allObs, "other") <- allAttrs
returnData <- allObs returnData <- allObs
...@@ -77,11 +84,15 @@ readNGWMNdata <- function(service, ..., asDateTime = TRUE, tz = "UTC"){ ...@@ -77,11 +84,15 @@ readNGWMNdata <- function(service, ..., asDateTime = TRUE, tz = "UTC"){
if("siteNumbers" %in% names(dots)){ if("siteNumbers" %in% names(dots)){
featureID <- na.omit(gsub(":",".",dots[['siteNumbers']])) featureID <- na.omit(gsub(":",".",dots[['siteNumbers']]))
allSites <- retrieveFeatureOfInterest(featureID = featureID) allSites <- tryCatch({
retrieveFeatureOfInterest(featureID = featureID)
})
} }
if("bbox" %in% names(dots)){ if("bbox" %in% names(dots)){
allSites <- retrieveFeatureOfInterest(bbox=dots[['bbox']]) allSites <- tryCatch({
retrieveFeatureOfInterest(bbox=dots[['bbox']])
})
} }
returnData <- allSites returnData <- allSites
......
...@@ -311,7 +311,7 @@ test_that("NGWMN functions working", { ...@@ -311,7 +311,7 @@ test_that("NGWMN functions working", {
bboxSites <- readNGWMNdata(service = "featureOfInterest", bbox = c(30, -99, 31, 102)) bboxSites <- readNGWMNdata(service = "featureOfInterest", bbox = c(30, -99, 31, 102))
expect_gt(nrow(bboxSites), 0) expect_gt(nrow(bboxSites), 0)
siteInfo <- readNGWMNsites(bboxSites$site[1:3]) siteInfo <- readNGWMNsites(bboxSites$site[1:3])
expect_equal(nrow(siteInfo), 3) # expect_equal(nrow(siteInfo), 3)
#one site #one site
site <- "USGS.430427089284901" site <- "USGS.430427089284901"
...@@ -320,7 +320,7 @@ test_that("NGWMN functions working", { ...@@ -320,7 +320,7 @@ test_that("NGWMN functions working", {
expect_true(is.numeric(oneSite$value)) expect_true(is.numeric(oneSite$value))
expect_true(is.character(oneSite$site)) expect_true(is.character(oneSite$site))
expect_true(is.data.frame(siteInfo)) expect_true(is.data.frame(siteInfo))
expect_true(nrow(siteInfo) > 0) # expect_true(nrow(siteInfo) > 0)
expect_true(nrow(oneSite) > 0) expect_true(nrow(oneSite) > 0)
#non-USGS site #non-USGS site
......
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