Unverified Commit 8aaecddd authored by Laura A DeCicco's avatar Laura A DeCicco Committed by GitHub
Browse files

Merge pull request #588 from ldecicco-USGS/master

Check internet
parents a363245b 6c5efaba
...@@ -2,7 +2,6 @@ ...@@ -2,7 +2,6 @@
export(addWaterYear) export(addWaterYear)
export(calcWaterYear) export(calcWaterYear)
export(checkWQPdates)
export(constructNWISURL) export(constructNWISURL)
export(constructUseURL) export(constructUseURL)
export(constructWQPURL) export(constructWQPURL)
......
...@@ -5,12 +5,7 @@ ...@@ -5,12 +5,7 @@
#' #'
#' @param values named list with arguments to send to the Water Quality Portal #' @param values named list with arguments to send to the Water Quality Portal
#' @return values named list with corrected arguments to send to the Water Quality Portal #' @return values named list with corrected arguments to send to the Water Quality Portal
#' @export
#' @keywords internal #' @keywords internal
#' @examples
#' values <- list(startDateLo="01-01-2002", characteristicName="Phosphorous",
#' endDate=as.Date("2014-01-01"))
#' values <- checkWQPdates(values)
checkWQPdates <- function(values){ checkWQPdates <- function(values){
dateNames <- c("startDateLo","startDateHi","startDate","endDate") dateNames <- c("startDateLo","startDateHi","startDate","endDate")
......
...@@ -22,7 +22,7 @@ ...@@ -22,7 +22,7 @@
#' } #' }
getWebServiceData <- function(obs_url, ...){ getWebServiceData <- function(obs_url, ...){
if (!curl::has_internet()) { if (!has_internet_2(obs_url)) {
message("No internet connection.") message("No internet connection.")
return(invisible(NULL)) return(invisible(NULL))
} }
...@@ -47,7 +47,8 @@ getWebServiceData <- function(obs_url, ...){ ...@@ -47,7 +47,8 @@ getWebServiceData <- function(obs_url, ...){
return(invisible(NULL)) return(invisible(NULL))
} }
if(headerInfo$`content-type` %in% c("text/tab-separated-values;charset=UTF-8")){ if(headerInfo$`content-type` %in% c("text/tab-separated-values;charset=UTF-8",
"text/csv;charset=UTF-8")){
returnedDoc <- httr::content(returnedList, type="text",encoding = "UTF-8") returnedDoc <- httr::content(returnedList, type="text",encoding = "UTF-8")
} else if (headerInfo$`content-type` %in% } else if (headerInfo$`content-type` %in%
c("application/zip", c("application/zip",
...@@ -61,7 +62,7 @@ getWebServiceData <- function(obs_url, ...){ ...@@ -61,7 +62,7 @@ getWebServiceData <- function(obs_url, ...){
return(txt) return(txt)
} else { } else {
returnedDoc <- httr::content(returnedList,encoding = "UTF-8") returnedDoc <- httr::content(returnedList,encoding = "UTF-8")
if(grepl("No sites/data found using the selection criteria specified", returnedDoc)){ if(all(grepl("No sites/data found using the selection criteria specified", returnedDoc))){
message(returnedDoc) message(returnedDoc)
} }
if(headerInfo$`content-type` == "text/xml"){ if(headerInfo$`content-type` == "text/xml"){
...@@ -83,6 +84,9 @@ getWebServiceData <- function(obs_url, ...){ ...@@ -83,6 +84,9 @@ getWebServiceData <- function(obs_url, ...){
} }
} }
#' Create user agent
#'
#' @keywords internal
default_ua <- function() { default_ua <- function() {
versions <- c( versions <- c(
libcurl = curl::curl_version()$version, libcurl = curl::curl_version()$version,
...@@ -99,6 +103,20 @@ default_ua <- function() { ...@@ -99,6 +103,20 @@ default_ua <- function() {
return(ua) return(ua)
} }
#' has_internet2
#'
#' Function to check for internet even if the user
#' is behind a proxy
#'
#' @keywords internal
#' @param obs_url character obs_url to check
has_internet_2 <- function(obs_url) {
host <- gsub("^https://(?:www[.])?([^/]*).*$", "\\1", obs_url )
!is.null(curl::nslookup(host, error = FALSE))
}
#' getting header information from a WQP query #' getting header information from a WQP query
#' #'
#'@param url the query url #'@param url the query url
......
...@@ -16,9 +16,4 @@ values named list with corrected arguments to send to the Water Quality Portal ...@@ -16,9 +16,4 @@ values named list with corrected arguments to send to the Water Quality Portal
Checks date format for inputs to the Water Quality Portal. Used in \code{readWQPqw} Checks date format for inputs to the Water Quality Portal. Used in \code{readWQPqw}
and \code{readWQPdata}. and \code{readWQPdata}.
} }
\examples{
values <- list(startDateLo="01-01-2002", characteristicName="Phosphorous",
endDate=as.Date("2014-01-01"))
values <- checkWQPdates(values)
}
\keyword{internal} \keyword{internal}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/getWebServiceData.R
\name{default_ua}
\alias{default_ua}
\title{Create user agent}
\usage{
default_ua()
}
\description{
Create user agent
}
\keyword{internal}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/getWebServiceData.R
\name{has_internet_2}
\alias{has_internet_2}
\title{has_internet2}
\usage{
has_internet_2(obs_url)
}
\arguments{
\item{obs_url}{character obs_url to check}
}
\description{
Function to check for internet even if the user
is behind a proxy
}
\keyword{internal}
...@@ -49,10 +49,10 @@ test_that("General NWIS retrievals working", { ...@@ -49,10 +49,10 @@ test_that("General NWIS retrievals working", {
expect_is(waterYearStat$parameter_cd,"character") expect_is(waterYearStat$parameter_cd,"character")
#Empty data #Empty data
# note....not empty anymore!
urlTest <- "https://nwis.waterservices.usgs.gov/nwis/iv/?site=11447650&format=waterml,1.1&ParameterCd=63680&startDT=2016-12-13&endDT=2016-12-13" urlTest <- "https://nwis.waterservices.usgs.gov/nwis/iv/?site=11447650&format=waterml,1.1&ParameterCd=63680&startDT=2016-12-13&endDT=2016-12-13"
x <- importWaterML1(urlTest) x <- importWaterML1(urlTest)
expect_equal(names(x), c("agency_cd","site_no","dateTime","tz_cd")) expect_true(all(c("agency_cd","site_no","dateTime","tz_cd") %in% names(x)))
#Test list: #Test list:
args <- list(sites="05114000", service="iv", args <- list(sites="05114000", service="iv",
...@@ -342,7 +342,9 @@ test_that("readWQPdots working", { ...@@ -342,7 +342,9 @@ test_that("readWQPdots working", {
context("getWebServiceData") context("getWebServiceData")
test_that("long urls use POST", { test_that("long urls use POST", {
testthat::skip_on_cran() testthat::skip_on_cran()
url <- paste0(rep("reallylongurl", 200), collapse = '') baseURL <- dataRetrieval:::drURL("Result")
url <- paste0(baseURL,
rep("reallylongurl", 200), collapse = '')
with_mock( with_mock(
RETRY = function(method, ...) { RETRY = function(method, ...) {
return(method == "POST") return(method == "POST")
...@@ -357,7 +359,9 @@ test_that("long urls use POST", { ...@@ -357,7 +359,9 @@ test_that("long urls use POST", {
test_that("ngwmn urls don't use post", { test_that("ngwmn urls don't use post", {
testthat::skip_on_cran() testthat::skip_on_cran()
url <- paste0(rep("urlwithngwmn", 200), collapse = '') baseURL <- dataRetrieval:::drURL("NGWMN")
url <- paste0(baseURL,
rep("urlwithngwmn", 200), collapse = '')
with_mock( with_mock(
RETRY = function(method, ...) { RETRY = function(method, ...) {
return(method == "POST") return(method == "POST")
......
...@@ -372,15 +372,6 @@ test_that("Construct WQP urls", { ...@@ -372,15 +372,6 @@ test_that("Construct WQP urls", {
expect_equal(obs_url_orig, "https://www.waterqualitydata.us/data/Result/search?siteid=IIDFG-41WSSPAHS;USGS-02352560&characteristicName=Temperature;Temperature%2C%20sample;Temperature%2C%20water;Temperature%2C%20water%2C%20deg%20F&mimeType=tsv&zip=yes") expect_equal(obs_url_orig, "https://www.waterqualitydata.us/data/Result/search?siteid=IIDFG-41WSSPAHS;USGS-02352560&characteristicName=Temperature;Temperature%2C%20sample;Temperature%2C%20water;Temperature%2C%20water%2C%20deg%20F&mimeType=tsv&zip=yes")
}) })
context("checkWQPdates")
test_that("checkWQPdates", {
values <- list(startDateLo="01-01-2002", characteristicName="Phosphorous",
endDate=as.Date("2014-01-01"))
values1 <- checkWQPdates(values)
expect_equal(values1$startDateHi, "01-01-2014")
expect_equal(values1$startDateLo, "01-01-2002")
})
context("Construct WQP urls") context("Construct WQP urls")
test_that("Construct WQP urls", { test_that("Construct WQP urls", {
siteNumber <- '01594440' siteNumber <- '01594440'
......
Markdown is supported
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