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 @@
export(addWaterYear)
export(calcWaterYear)
export(checkWQPdates)
export(constructNWISURL)
export(constructUseURL)
export(constructWQPURL)
......
......@@ -5,12 +5,7 @@
#'
#' @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
#' @export
#' @keywords internal
#' @examples
#' values <- list(startDateLo="01-01-2002", characteristicName="Phosphorous",
#' endDate=as.Date("2014-01-01"))
#' values <- checkWQPdates(values)
checkWQPdates <- function(values){
dateNames <- c("startDateLo","startDateHi","startDate","endDate")
......
......@@ -22,7 +22,7 @@
#' }
getWebServiceData <- function(obs_url, ...){
if (!curl::has_internet()) {
if (!has_internet_2(obs_url)) {
message("No internet connection.")
return(invisible(NULL))
}
......@@ -47,7 +47,8 @@ getWebServiceData <- function(obs_url, ...){
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")
} else if (headerInfo$`content-type` %in%
c("application/zip",
......@@ -61,7 +62,7 @@ getWebServiceData <- function(obs_url, ...){
return(txt)
} else {
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)
}
if(headerInfo$`content-type` == "text/xml"){
......@@ -83,6 +84,9 @@ getWebServiceData <- function(obs_url, ...){
}
}
#' Create user agent
#'
#' @keywords internal
default_ua <- function() {
versions <- c(
libcurl = curl::curl_version()$version,
......@@ -99,6 +103,20 @@ default_ua <- function() {
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
#'
#'@param url the query url
......
......@@ -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}
and \code{readWQPdata}.
}
\examples{
values <- list(startDateLo="01-01-2002", characteristicName="Phosphorous",
endDate=as.Date("2014-01-01"))
values <- checkWQPdates(values)
}
\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", {
expect_is(waterYearStat$parameter_cd,"character")
#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"
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:
args <- list(sites="05114000", service="iv",
......@@ -342,7 +342,9 @@ test_that("readWQPdots working", {
context("getWebServiceData")
test_that("long urls use POST", {
testthat::skip_on_cran()
url <- paste0(rep("reallylongurl", 200), collapse = '')
baseURL <- dataRetrieval:::drURL("Result")
url <- paste0(baseURL,
rep("reallylongurl", 200), collapse = '')
with_mock(
RETRY = function(method, ...) {
return(method == "POST")
......@@ -357,7 +359,9 @@ test_that("long urls use POST", {
test_that("ngwmn urls don't use post", {
testthat::skip_on_cran()
url <- paste0(rep("urlwithngwmn", 200), collapse = '')
baseURL <- dataRetrieval:::drURL("NGWMN")
url <- paste0(baseURL,
rep("urlwithngwmn", 200), collapse = '')
with_mock(
RETRY = function(method, ...) {
return(method == "POST")
......
......@@ -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")
})
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")
test_that("Construct WQP urls", {
siteNumber <- '01594440'
......
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