Merge pull request #149 from jread-usgs/master

straw dog for access pattern

NAMESPACE

@@ -24,6 +24,7 @@ export(readNWISuv)
 export(readWQPdata)
 export(readWQPqw)
 export(renameNWISColumns)
+export(setAccess)
 export(stateCd)
 export(stateCdLookup)
 export(whatNWISdata)

R/AAA.R

+pkg.env <- new.env()
+.onLoad = function(libname, pkgname){
+  suppressMessages(setAccess('public'))
+}
\ No newline at end of file

R/constructNWISURL.r

@@ -149,9 +149,6 @@ constructNWISURL <- function(siteNumber,parameterCd="00060",startDate="",endDate
           
           if ("uv"==service) {
             service <- "iv"
-            baseURL <- paste0("http://nwis.waterservices.usgs.gov/nwis/",service)  
-          } else {
-            baseURL <- paste0("http://waterservices.usgs.gov/nwis/",service)  
           }
           
           format <- match.arg(format, c("xml","tsv","wml1","wml2","rdb"))
@@ -174,30 +171,29 @@ constructNWISURL <- function(siteNumber,parameterCd="00060",startDate="",endDate
             }
           )
 
-          
-          url <- paste0(baseURL,"/?site=",siteNumber, "&format=", formatURL)
+          url <- drURL(service, Access=pkg.env$access, site=siteNumber, format=formatURL)
           
           if("gwlevels"!= service){
-            url <- paste0(url, "&ParameterCd=",parameterCd)
+            url <- appendDrURL(url, ParameterCd=parameterCd)
           }
           
           if("dv"==service) {
             if(length(statCd) > 1){
               statCd <- paste(statCd, collapse=",")
             }            
-            url <- paste0(url, "&StatCd=", statCd)
+            url <- appendDrURL(url, StatCd=statCd)
           }
           
           if (nzchar(startDate)) {
-            url <- paste0(url,"&startDT=",startDate)
+            url <- appendDrURL(url, startDT=startDate)
           } else {
             startorgin <- "1851-01-01"
             if ("iv" == service) startorgin <- "1900-01-01"            
-            url <- paste0(url,"&startDT=",startorgin)
+            url <- appendDrURL(url, startDT=startorgin)
           }
           
           if (nzchar(endDate)) {
-            url <- paste0(url,"&endDT=",endDate)
+            url <- appendDrURL(url, endDT=endDate)
           }
         }
          

R/setAccess.R

+#'Set data endpoint
+#'
+#'access Indicate which dataRetrieval access code
+#' you want to use options: \code{c('public','internal')}
+#'
+#' @param access code for data access. Either "public" or "internal"
+#'
+#'@author Luke Winslow, Jordan S Read
+#'
+#'@examples
+#'
+#'\dontrun{
+#'setAccess('internal')
+#'
+#'setAccess('public')
+#'
+#'}
+#'
+#' @export
+setAccess = function(access="public"){
+  
+  access = match.arg(access, c('public','internal'))
+  
+  if(access=="internal"){
+    pkg.env$access = '3'
+    message('setting access to internal')
+  }else {
+    pkg.env$access = '0'
+    message('setting access to public')
+  }
+  
+  pkg.env$waterservices = "http://waterservices.usgs.gov/nwis/site/"
+  pkg.env$iv = "http://nwis.waterservices.usgs.gov/nwis/iv/"
+  pkg.env$dv =  "http://waterservices.usgs.gov/nwis/dv/"
+  pkg.env$gwlevels = "http://waterservices.usgs.gov/nwis/gwlevels/"
+  
+}
+
+drURL <- function(base.name, ..., arg.list=NULL){
+  
+  
+  queryString <- drQueryArgs(..., arg.list=arg.list)
+  #to do: add something to check for redundant params
+  
+  return(paste0(pkg.env[[base.name]], '?', queryString))
+}
+
+drQueryArgs <- function(..., arg.list){
+  args <- append(expand.grid(..., stringsAsFactors = FALSE), arg.list)
+  # get the args into name=value strings
+  keyValues <- paste0(names(args),unname(lapply(args, function(x) paste0('=',x[[1]]))))
+  return(paste(keyValues, collapse='&'))
+}
+
+appendDrURL <- function(url, ..., arg.list=NULL){
+  
+  queryString <- drQueryArgs(..., arg.list=arg.list)
+  return(paste0(url, "&", queryString))
+}
\ No newline at end of file

R/whatNWISData.r

@@ -87,8 +87,7 @@ whatNWISdata <- function(siteNumbers,service="all",parameterCd="all",statCd="all
     }
   }
   
-  
-  urlSitefile <- paste("http://waterservices.usgs.gov/nwis/site/?format=rdb&seriesCatalogOutput=true&sites=",siteNumber,sep = "")
+  urlSitefile <- drURL('waterservices', Access=pkg.env$access, format='rdb', seriesCatalogOutput='true',sites=paste(siteNumber))
  
   SiteFile <- importRDB1(urlSitefile, asDateTime = FALSE)
   

R/whatNWISsites.R

@@ -35,14 +35,11 @@ whatNWISsites <- function(...){
   matchReturn <- list(...)
   values <- sapply(matchReturn, function(x) URLencode(as.character(paste(eval(x),collapse=",",sep=""))))
   
-  urlCall <- paste(paste(names(values),values,sep="="),collapse="&")
-  
   names(values)[names(values) == "siteNumber"] <- "sites"
   names(values)[names(values) == "siteNumbers"] <- "sites"
   
-  baseURL <- "http://waterservices.usgs.gov/nwis/site/?format=mapper&"
-  urlCall <- paste(baseURL,
-                   urlCall,sep = "")
+  urlCall <- drURL('waterservices',Access=pkg.env$access, format="mapper", arg.list = values)
+
 
   rawData <- getWebServiceData(urlCall)
 

man/setAccess.Rd

+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/setAccess.R
+\name{setAccess}
+\alias{setAccess}
+\title{Set data endpoint}
+\usage{
+setAccess(access = "public")
+}
+\arguments{
+\item{access}{code for data access. Either "public" or "internal"}
+}
+\description{
+access Indicate which dataRetrieval access code
+you want to use options: \code{c('public','internal')}
+}
+\examples{
+
+\dontrun{
+setAccess('internal')
+
+setAccess('public')
+
+}
+
+}
+\author{
+Luke Winslow, Jordan S Read
+}
+

man/whatNWISData.Rd

 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/whatNWISdata.r
+% Please edit documentation in R/whatNWISData.r
 \name{whatNWISdata}
 \alias{whatNWISdata}
 \title{USGS data availability}

man/whatNWISdata.Rd

+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/whatNWISData.r
+\name{whatNWISdata}
+\alias{whatNWISdata}
+\title{USGS data availability}
+\usage{
+whatNWISdata(siteNumbers, service = "all", parameterCd = "all",
+  statCd = "all")
+}
+\arguments{
+\item{siteNumbers}{character USGS site number or multiple sites.}
+
+\item{service}{character. Options are "all", or one or many of "dv"(daily values),
+"uv","rt", or "iv"(unit values), "qw"(water-quality),"sv"(sites visits),"pk"(peak measurements),
+"gw"(groundwater levels), "ad" (sites included in USGS Annual Water Data Reports External Link), 
+"aw" (sites monitored by the USGS Active Groundwater Level Network External Link), "id" (historical 
+instantaneous values)}
+
+\item{parameterCd}{character vector of valid parameter codes to return. Defaults to "all" which will not perform a filter.}
+
+\item{statCd}{character vector of all statistic codes to return. Defaults to "all" which will not perform a filter.}
+}
+\value{
+A data frame with the following columns:
+\tabular{lll}{
+Name \tab Type \tab Description \cr
+agency_cd \tab character \tab The NWIS code for the agency reporting the data\cr
+site_no \tab character \tab The USGS site number \cr
+station_nm \tab character \tab Site name \cr 
+site_tp_cd \tab character \tab Site type \cr
+dec_lat_va \tab numeric \tab Decimal latitude\cr
+dec_long_va \tab numeric \tab Decimal longitude \cr
+coord_acy_cd \tab character \tab Latitude-longitude accuracy \cr
+dec_coord_datum_cd \tab character \tab Decimal Latitude-longitude datum \cr
+alt_va \tab character \tab Altitude of Gage or land surface \cr
+alt_acy_va \tab character \tab Altitude accuracy \cr
+alt_datum_cd \tab character \tab Altitude datum \cr
+huc_cd \tab character \tab Hydrologic unit code \cr
+data_type_cd \tab character \tab Data type \cr
+parm_cd \tab character \tab Parameter code \cr
+stat_cd \tab character \tab Statistical code \cr
+dd_nu \tab character \tab Internal database key \cr
+loc_web_ds \tab character \tab Additional measurement description \cr
+medium_grp_cd \tab character \tab Medium group code \cr
+parm_grp_cd \tab character \tab Parameter group code \cr
+srs_id \tab character \tab SRS ID \cr
+access_cd \tab character \tab Access code \cr
+begin_date \tab Date \tab Begin date \cr
+end_date \tab Date \tab End date \cr
+count_nu \tab integer \tab Record count\cr
+parameter_group_nm \tab character \tab Parameter group name \cr
+parameter_nm \tab character \tab Parameter name \cr
+casrn \tab character \tab Chemical Abstracts Service (CAS) Registry Number \cr
+srsname \tab character \tab Substance Registry Services \cr
+parameter_units \tab character \tab Parameter units \cr
+}
+
+There are also several useful attributes attached to the data frame:
+\tabular{lll}{
+Name \tab Type \tab Description \cr
+url \tab character \tab The url used to generate the data \cr
+comment \tab character \tab Header comments from the RDB file \cr
+queryTime \tab POSIXct \tab The time the data was returned \cr
+}
+}
+\description{
+Imports a table of available parameters, period of record, and count. See \url{http://waterservices.usgs.gov/rest/Site-Service.html}
+for more information.
+}
+\examples{
+\dontrun{
+availableData <- whatNWISdata('05114000')
+# To find just unit value ('instantaneous') data:
+uvData <- whatNWISdata('05114000',service="uv")
+uvDataMulti <- whatNWISdata(c('05114000','09423350'),service=c("uv","dv"))
+siteNumbers <- c("01491000","01645000")
+flowAndTemp <- whatNWISdata(siteNumbers, parameterCd=c("00060","00010"))
+}
+}
+\keyword{USGS}
+\keyword{data}
+\keyword{import}
+\keyword{service}
+\keyword{web}
+

tests/testthat/tests_userFriendly_fxns.R

@@ -19,7 +19,7 @@ test_that("Unit value data returns correct types", {
   expect_is(rawData$dateTime, 'POSIXct')
   expect_is(rawData$Flow_Inst, 'numeric')
   expect_that(attr(rawData, "url"), equals(
-      "http://nwis.waterservices.usgs.gov/nwis/iv/?site=05114000&format=waterml,1.1&ParameterCd=00060&startDT=2014-10-10&endDT=2014-10-10")
+      "http://nwis.waterservices.usgs.gov/nwis/iv/?Access=0&site=05114000&format=waterml,1.1&ParameterCd=00060&startDT=2014-10-10&endDT=2014-10-10")
   )
 #   #First switchover to standard time:
 #   expect_that(as.numeric(timeZoneChange[which(timeZoneChange$tz_cd == "America/Chicago")[1],"dateTime"]),