From 8194336514d0b5e72f64d7273d9b9e67cf9acd60 Mon Sep 17 00:00:00 2001
From: unknown <ldecicco@usgs.gov>
Date: Fri, 12 Dec 2014 15:03:39 -0600
Subject: [PATCH] Improving error handling.
---
R/importWQP.R | 179 ++++++++++++++++++++++++++------------------------
1 file changed, 94 insertions(+), 85 deletions(-)
diff --git a/R/importWQP.R b/R/importWQP.R
index d02e5dc2..89d6d707 100644
--- a/R/importWQP.R
+++ b/R/importWQP.R
@@ -28,107 +28,116 @@
#' }
importWQP <- function(url, zip=FALSE, tz=""){
- h <- basicHeaderGatherer()
+ if(zip){
+ headerInfo <- HEAD(url)$headers
+ temp <- tempfile()
+ options(timeout = 120)
+
+ possibleError <- tryCatch(
+ download.file(url,temp, quiet=TRUE, mode='wb'),
+ error = function(e) e
+ )
+
+ } else {
+ h <- basicHeaderGatherer()
+ possibleError <- tryCatch(
+ doc <- getURL(url, headerfunction = h$update),
+ error = function(e) e
+ )
+ }
- tryCatch({
+ if(!inherits(possibleError, "error")){
+
if(zip){
- headerInfo <- HEAD(url)$headers
- temp <- tempfile()
- options(timeout = 120)
- download.file(url,temp, quiet=TRUE, mode='wb')
doc <- unzip(temp)
unlink(temp)
} else {
- doc <- getURL(url, headerfunction = h$update)
headerInfo <- h$value()
+ }
+ if(tz != ""){
+ tz <- match.arg(tz, c("America/New_York","America/Chicago",
+ "America/Denver","America/Los_Angeles",
+ "America/Anchorage","America/Honolulu",
+ "America/Jamaica","America/Managua",
+ "America/Phoenix","America/Metlakatla"))
}
- }, warning = function(w) {
- message(paste("URL caused a warning:", url))
- message(w)
- }, error = function(e) {
- message(paste("URL does not seem to exist:", url))
- message(e)
- return(NA)
- })
-
- if(tz != ""){
- tz <- match.arg(tz, c("America/New_York","America/Chicago",
- "America/Denver","America/Los_Angeles",
- "America/Anchorage","America/Honolulu",
- "America/Jamaica","America/Managua",
- "America/Phoenix","America/Metlakatla"))
- }
+
+ numToBeReturned <- as.numeric(headerInfo["Total-Result-Count"])
- numToBeReturned <- as.numeric(headerInfo["Total-Result-Count"])
+ if (!is.na(numToBeReturned) & numToBeReturned != 0){
- if (!is.na(numToBeReturned) | numToBeReturned != 0){
-
- suppressWarnings(namesData <- read.delim(if(zip) doc else textConnection(doc) , header = TRUE, quote="\"",
- dec=".", sep='\t',
- colClasses='character',
- fill = TRUE,nrow=1))
-
- classColumns <- setNames(rep('character',ncol(namesData)),names(namesData))
-
- classColumns[grep("MeasureValue",names(classColumns))] <- NA
-
- suppressWarnings(retval <- read.delim(if(zip) doc else textConnection(doc), header = TRUE, quote="\"",
- dec=".", sep='\t',
- colClasses=as.character(classColumns),
- fill = TRUE))
-
- actualNumReturned <- nrow(retval)
-
- retval[,names(which(sapply(retval[,grep("MeasureValue",names(retval))], function(x)all(is.na(x)))))] <- ""
-
- if(actualNumReturned != numToBeReturned) warning(numToBeReturned, " sample results were expected, ", actualNumReturned, " were returned")
-
- offsetLibrary <- setNames(c(5, 4, 6, 5, 7, 6, 8, 7, 9, 8, 10, 10),
- c("EST","EDT","CST","CDT","MST","MDT","PST","PDT","AKST","AKDT","HAST","HST"))
-
- timeZoneStart <- offsetLibrary[retval$ActivityStartTime.TimeZoneCode]
- timeZoneEnd <- offsetLibrary[retval$ActivityEndTime.TimeZoneCode]
- timeZoneStart[is.na(timeZoneStart)] <- 0
- timeZoneEnd[is.na(timeZoneEnd)] <- 0
-
- if("ActivityStartDate" %in% names(retval)){
- if(any(retval$ActivityStartDate != "")){
- suppressWarnings(retval$ActivityStartDate <- as.Date(parse_date_time(retval$ActivityStartDate, c("Ymd", "mdY"))))
+ suppressWarnings(namesData <- read.delim(if(zip) doc else textConnection(doc) , header = TRUE, quote="\"",
+ dec=".", sep='\t',
+ colClasses='character',
+ fill = TRUE,nrow=1))
+
+ classColumns <- setNames(rep('character',ncol(namesData)),names(namesData))
+
+ classColumns[grep("MeasureValue",names(classColumns))] <- NA
+
+ suppressWarnings(retval <- read.delim(if(zip) doc else textConnection(doc), header = TRUE, quote="\"",
+ dec=".", sep='\t',
+ colClasses=as.character(classColumns),
+ fill = TRUE))
+
+ actualNumReturned <- nrow(retval)
+
+ retval[,names(which(sapply(retval[,grep("MeasureValue",names(retval))], function(x)all(is.na(x)))))] <- ""
+
+ if(actualNumReturned != numToBeReturned) warning(numToBeReturned, " sample results were expected, ", actualNumReturned, " were returned")
+
+ offsetLibrary <- setNames(c(5, 4, 6, 5, 7, 6, 8, 7, 9, 8, 10, 10),
+ c("EST","EDT","CST","CDT","MST","MDT","PST","PDT","AKST","AKDT","HAST","HST"))
+
+ timeZoneStart <- offsetLibrary[retval$ActivityStartTime.TimeZoneCode]
+ timeZoneEnd <- offsetLibrary[retval$ActivityEndTime.TimeZoneCode]
+ timeZoneStart[is.na(timeZoneStart)] <- 0
+ timeZoneEnd[is.na(timeZoneEnd)] <- 0
+
+ if("ActivityStartDate" %in% names(retval)){
+ if(any(retval$ActivityStartDate != "")){
+ suppressWarnings(retval$ActivityStartDate <- as.Date(parse_date_time(retval$ActivityStartDate, c("Ymd", "mdY"))))
+ }
+ }
+
+ if("ActivityEndDate" %in% names(retval)){
+ if(any(retval$ActivityEndDate != "")){
+ suppressWarnings(retval$ActivityEndDate <- as.Date(parse_date_time(retval$ActivityEndDate, c("Ymd", "mdY"))))
+ }
+ }
+
+ if(any(!is.na(timeZoneStart))){
+
+ retval$ActivityStartDateTime <- with(retval, as.POSIXct(paste(ActivityStartDate, ActivityStartTime.Time),format="%Y-%m-%d %H:%M:%S", tz = "UTC"))
+ retval$ActivityStartDateTime <- retval$ActivityStartDateTime + timeZoneStart*60*60
+ retval$ActivityStartDateTime <- as.POSIXct(retval$ActivityStartDateTime)
+ attr(retval$ActivityStartDateTime, "tzone") <- "UTC"
+
}
- }
-
- if("ActivityEndDate" %in% names(retval)){
- if(any(retval$ActivityEndDate != "")){
- suppressWarnings(retval$ActivityEndDate <- as.Date(parse_date_time(retval$ActivityEndDate, c("Ymd", "mdY"))))
- }
- }
-
- if(any(!is.na(timeZoneStart))){
- retval$ActivityStartDateTime <- with(retval, as.POSIXct(paste(ActivityStartDate, ActivityStartTime.Time),format="%Y-%m-%d %H:%M:%S", tz = "UTC"))
- retval$ActivityStartDateTime <- retval$ActivityStartDateTime + timeZoneStart*60*60
- retval$ActivityStartDateTime <- as.POSIXct(retval$ActivityStartDateTime)
- attr(retval$ActivityStartDateTime, "tzone") <- "UTC"
+ if(any(!is.na(timeZoneEnd))){
+ retval$ActivityEndDateTime <- with(retval, as.POSIXct(paste(ActivityEndDate, ActivityEndTime.Time),format="%Y-%m-%d %H:%M:%S", tz = "UTC"))
+ retval$ActivityEndDateTime <- retval$ActivityEndDateTime + timeZoneEnd*60*60
+ retval$ActivityEndDateTime <- as.POSIXct(retval$ActivityEndDateTime)
+ attr(retval$ActivityEndDateTime, "tzone") <- "UTC"
+ }
- }
-
- if(any(!is.na(timeZoneEnd))){
- retval$ActivityEndDateTime <- with(retval, as.POSIXct(paste(ActivityEndDate, ActivityEndTime.Time),format="%Y-%m-%d %H:%M:%S", tz = "UTC"))
- retval$ActivityEndDateTime <- retval$ActivityEndDateTime + timeZoneEnd*60*60
- retval$ActivityEndDateTime <- as.POSIXct(retval$ActivityEndDateTime)
- attr(retval$ActivityEndDateTime, "tzone") <- "UTC"
- }
+ if(all(is.na(retval$ActivityEndDateTime))){
+ retval$ActivityEndDateTime <- NULL
+ }
+
+ return(retval)
- if(all(is.na(retval$ActivityEndDateTime))){
- retval$ActivityEndDateTime <- NULL
+ } else {
+ warning("No data to retrieve")
+ return(NA)
}
-
- return(retval)
-
} else {
- warning("No data to retrieve")
- return(NA)
+ if(zip){
+ unlink(temp)
+ }
+ message(e)
}
}
\ No newline at end of file
--
GitLab