Merge pull request #588 from ldecicco-USGS/master

Check internet

NAMESPACE

@@ -2,7 +2,6 @@
 
 export(addWaterYear)
 export(calcWaterYear)
-export(checkWQPdates)
 export(constructNWISURL)
 export(constructUseURL)
 export(constructWQPURL)

R/checkWQPdates.r

@@ -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")
   

R/getWebServiceData.R

@@ -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

man/checkWQPdates.Rd

@@ -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}

man/default_ua.Rd

+% 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}

man/has_internet_2.Rd

+% 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}

tests/testthat/tests_general.R

@@ -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")

tests/testthat/tests_userFriendly_fxns.R

@@ -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'