Nothing
## TODO:
## 1. get a list of stations
## 2. get a list of reports and matching headers / units
## 3. better documentation / testing
## 4. work with Deb / programmers to get compressed output
##
## see: http://www.wcc.nrcs.usda.gov/web_service/awdb_webservice_announcements.htm
## http://www.wcc.nrcs.usda.gov/web_service/AWDB_Web_Service_Reference.htm
## http://www.wcc.nrcs.usda.gov/report_generator/WebReportScripting.htm
# req is a named vector or list
fetchSCAN <- function(req) {
# convert to list as needed
if(class(list) != 'list')
req <- as.list(req)
# check for required packages
if(!requireNamespace('httr', quietly = TRUE))
stop('please install the `httr` package', call.=FALSE)
# base URL to service
uri <- 'http://www.wcc.nrcs.usda.gov/nwcc/view'
# note: the SCAN form processor checks the refering page and user-agent
new.headers <- c(
"Referer"="http://www.wcc.nrcs.usda.gov/nwcc/",
"User-Agent" = "Mozilla/5.0 (Macintosh; U; Intel Mac OS X 10.6; en-US; rv:1.9.2.13) Gecko/20101203 Firefox/3.6.13"
)
# enable follow-location
# http://stackoverflow.com/questions/25538957/suppressing-302-error-returned-by-httr-post
# cf <- httr::config(followlocation = 1L, verbose=1L) # debugging
cf <- httr::config(followlocation = 1L)
# submit request
r <- httr::POST(uri, body=req, encode='form', config = cf, httr::add_headers(new.headers))
httr::stop_for_status(r)
# extract content as text, cannot be directly read-in
r.content <- httr::content(r, as='text')
# connect to the text as a standard file
tc <- textConnection(r.content)
# attempt to read column headers, after skipping the first two lines of data
h <- unlist(read.table(tc, nrows=1, skip=2, header=FALSE, stringsAsFactors=FALSE, sep=',', quote='', strip.white=TRUE, na.strings='-99.9', comment.char=''))
# the last header is junk (NA)
h <- as.vector(na.omit(h))
# split colunmn names on white space and keep the first element
h <- sapply(strsplit(h, split=' '), function(i) i[[1]])
# clean some more junk
h <- gsub('-1', '', fixed=TRUE, h)
h <- gsub(':-', '_', h)
# NOTE: we have already read-in the first 3 lines above, therefore we don't need to skip lines here
# read as CSV, skipping junk + headers, accomodating white-space and NA values encoded as -99.9
x <- read.table(tc, header=FALSE, stringsAsFactors=FALSE, sep=',', quote='', strip.white=TRUE, na.strings='-99.9', comment.char='')
# the last column is always junk
x[[names(x)[length(x)]]] <- NULL
# apply truncated column names:
names(x) <- h
# clean-up connections
close.connection(tc)
# convert date to Date class
x$Date <- as.Date(x$Date)
# done
return(x)
}
### old version based on RCurl
# fetchSCAN.old <- function(req) {
#
# # check for required packages
# if(!requireNamespace('httr', quietly = TRUE))
# stop('please install the `httr` package', call.=FALSE)
#
# # base URL to service
# uri <- 'http://www.wcc.nrcs.usda.gov/nwcc/view'
#
# # set CURL options here
# o <- curlOptions(
# referer="http://www.wcc.nrcs.usda.gov/nwcc/",
# useragent = "Mozilla/5.0 (Macintosh; U; Intel Mac OS X 10.6; en-US; rv:1.9.2.13) Gecko/20101203 Firefox/3.6.13"
# )
#
# # post form, result is a pile of text
# res <- postForm(uri, .params=req, .opts=o, style="POST")
#
# # connect to the text as a standard file
# tc <- textConnection(res)
#
# # attempt to read column headers, after skipping the first two lines of data
# h <- unlist(read.table(tc, nrows=1, skip=2, header=FALSE, stringsAsFactors=FALSE, sep=',', quote='', strip.white=TRUE, na.strings='-99.9', comment.char=''))
#
# # the last header is junk (NA)
# h <- as.vector(na.omit(h))
#
# # split colunmn names on white space and keep the first element
# h <- sapply(strsplit(h, split=' '), function(i) i[[1]])
#
# # clean some more junk
# h <- gsub('-1', '', fixed=TRUE, h)
# h <- gsub(':-', '_', h)
#
#
# # NOTE: we have already read-in the first 3 lines above, therefore we don't need to skip lines here
# # read as CSV, skipping junk + headers, accomodating white-space and NA values encoded as -99.9
# x <- read.table(tc, header=FALSE, stringsAsFactors=FALSE, sep=',', quote='', strip.white=TRUE, na.strings='-99.9', comment.char='')
#
# # the last column is always junk
# x[[names(x)[length(x)]]] <- NULL
#
# # apply truncated column names:
# names(x) <- h
#
# # clean-up connections
# close.connection(tc)
#
# # convert date to Date class
# x$Date <- as.Date(x$Date)
#
# # done
# return(x)
# }
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.