Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Water
dataRetrieval
Commits
8aaecddd
Unverified
Commit
8aaecddd
authored
Nov 19, 2021
by
Laura A DeCicco
Committed by
GitHub
Nov 19, 2021
Browse files
Merge pull request #588 from ldecicco-USGS/master
Check internet
parents
a363245b
6c5efaba
Changes
8
Hide whitespace changes
Inline
Side-by-side
NAMESPACE
View file @
8aaecddd
...
...
@@ -2,7 +2,6 @@
export(addWaterYear)
export(calcWaterYear)
export(checkWQPdates)
export(constructNWISURL)
export(constructUseURL)
export(constructWQPURL)
...
...
R/checkWQPdates.r
View file @
8aaecddd
...
...
@@ -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
View file @
8aaecddd
...
...
@@ -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
View file @
8aaecddd
...
...
@@ -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
0 → 100644
View file @
8aaecddd
% 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
0 → 100644
View file @
8aaecddd
% 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
View file @
8aaecddd
...
...
@@ -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
View file @
8aaecddd
...
...
@@ -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'
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment