getWebServiceData.R 2.35 KB
Newer Older
1
2
3
4
5
6
#' Function to return data from web services
#'
#' This function accepts a url parameter, and returns the raw data. The function enhances
#' \code{\link[RCurl]{getURI}} with more informative error messages.
#'
#' @param obs_url character containing the url for the retrieval
7
#' @param \dots information to pass to header request
Laura A DeCicco's avatar
Laura A DeCicco committed
8
9
10
11
12
#' @importFrom httr GET
#' @importFrom httr user_agent
#' @importFrom httr stop_for_status
#' @importFrom httr status_code
#' @importFrom httr headers
13
#' @importFrom httr content
Laura A DeCicco's avatar
Laura A DeCicco committed
14
#' @importFrom curl curl_version
15
16
17
18
19
20
21
22
23
#' @export
#' @return raw data from web services
#' @examples
#' siteNumber <- "02177000"
#' startDate <- "2012-09-01"
#' endDate <- "2012-10-01"
#' offering <- '00003'
#' property <- '00060'
#' obs_url <- constructNWISURL(siteNumber,property,startDate,endDate,'dv')
24
#' \dontrun{
25
#' rawData <- getWebServiceData(obs_url)
26
#' }
27
getWebServiceData <- function(obs_url, ...){
Laura A DeCicco's avatar
Laura A DeCicco committed
28
  
29
  returnedList <- GET(obs_url, ..., user_agent(default_ua()))
30
  
Laura A DeCicco's avatar
Laura A DeCicco committed
31
32
33
34
35
36
37
38
39
    if(status_code(returnedList) != 200){
      message("For: ", obs_url,"\n")
      stop_for_status(returnedList)
    } else {
      
      headerInfo <- headers(returnedList)
      
      if(headerInfo$`content-type` == "text/tab-separated-values;charset=UTF-8"){
        returnedDoc <- content(returnedList, type="text",encoding = "UTF-8")
40
41
      } else if (headerInfo$`content-type` == "text/xml;charset=UTF-8"){
        returnedDoc <- xmlcontent(returnedList)
Laura A DeCicco's avatar
Laura A DeCicco committed
42
43
      } else {
        returnedDoc <- content(returnedList)
44
45
46
47
        
        if(grepl("No sites/data found using the selection criteria specified", returnedDoc)){
          message(returnedDoc)
        }
Laura A DeCicco's avatar
Laura A DeCicco committed
48
49
      }

50

Laura A DeCicco's avatar
Laura A DeCicco committed
51
52
53
      attr(returnedDoc, "headerInfo") <- headerInfo

      return(returnedDoc)
Laura A DeCicco's avatar
Laura A DeCicco committed
54
    }
55
56
57
58
}

default_ua <- function() {
  versions <- c(
Laura A DeCicco's avatar
Laura A DeCicco committed
59
60
    libcurl = curl_version()$version,
    httr = as.character(packageVersion("httr")),
Laura A DeCicco's avatar
Laura A DeCicco committed
61
    dataRetrieval = as.character(packageVersion("dataRetrieval"))
62
63
  )
  paste0(names(versions), "/", versions, collapse = " ")
64
65
66
67
68
69
70
71
72
73
74
75
}

#' drop in replacement for httr switching to xml2 from XML
#' 
#' reverts to old parsing pre v1.1.0 for httr
#' 
#' @param response the result of httr::GET(url)
#' @keywords internal
#' @importFrom XML xmlParse
xmlcontent <- function(response){
  XML::xmlTreeParse(iconv(readBin(response$content, character()), from = "UTF-8", to = "UTF-8"),
                    useInternalNodes=TRUE,getDTD = FALSE)
76
}