network error clean up

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: sbtools
 Title: USGS ScienceBase Tools
 Maintainer: David Blodgett <[email protected]>
-Version: 1.1.15
+Version: 1.1.16
 Authors@R: c(person("David", "Blodgett", role=c("cre"),
     email = "[email protected]"),
     person("Luke", "Winslow", role = c("aut"),

R/REST_helpers.R

@@ -15,7 +15,7 @@ sbtools_POST <- function(url, body, ..., session){
 
 	r = POST(url=url, ..., httrUserAgent(), accept_json(), body=body, handle=session, 
 					 timeout = httr::timeout(default_timeout())) 
-	handle_errors(r, url, "POST", supported_types)	
+	r <- handle_errors(r, url, "POST", supported_types)	
 	# if (!strsplit(headers(r)[['content-type']], '[;]')[[1]][1] %in% supported_types)
 	# 	stop('POST failed to ',url,'. check authorization and/or content')
 
@@ -52,7 +52,7 @@ sbtools_GET <- function(url, ..., session = NULL) {
 																		"error was:\n", e))
 																 return(list(status = 404))
 	})
-	handle_errors(r, url, "GET", supported_types)
+	r <- handle_errors(r, url, "GET", supported_types)
 	session_age_reset()
 	return(r)
 }
@@ -72,8 +72,8 @@ sbtools_GET <- function(url, ..., session = NULL) {
 #' @keywords internal
 sbtools_PUT <- function(url, body, ..., session) {
 	check_session(session)
-	r = PUT(url = url, ..., httrUserAgent(), body = body, handle = session, timeout = httr::timeout(default_timeout()))
-	handle_errors(r, url, "PUT", NULL)
+	r <- PUT(url = url, ..., httrUserAgent(), body = body, handle = session, timeout = httr::timeout(default_timeout()))
+	r <- handle_errors(r, url, "PUT", NULL)
 	session_age_reset()
 	return(r)
 }
@@ -94,7 +94,7 @@ sbtools_DELETE <- function(url, ..., session) {
 	check_session(session)
 	r = DELETE(url = url, ..., httrUserAgent(), accept_json(), 
 						 handle = session, timeout = httr::timeout(default_timeout()))
-	handle_errors(r, url, "DELETE", NULL)
+	r <- handle_errors(r, url, "DELETE", NULL)
 	session_age_reset()
 	return(r)
 }
@@ -123,13 +123,24 @@ handle_errors <- function(x, url, method, types) {
 
 	if (!is.null(types)) {
 		if (!strsplit(headers(x)[['content-type']], '[;]')[[1]][1] %in% types) {
-			stop(method, ' failed to ', url, '. check authorization and/or content', call. = FALSE)
+			message(method, ' failed to ', url, '. check authorization and/or content', call. = FALSE)
+			return(NULL)
 		}
 	}
 
 	if ('errors' %in% names(content(x))) {
-		stop(content(x)$errors$message, call. = FALSE)
+
+		if(length(errors <- content(x)$errors) == 1) {
+			message(errors$message, call. = FALSE)
+		} else {
+			message(paste(sapply(errors, function (x) x$message), collapse = "\n"), call. = FALSE)
+		}
+
+		return(NULL)
 	}
+
+	return(x)
+
 }
 
 #' @importFrom curl curl_version

R/current_session.R

@@ -7,12 +7,12 @@
 #' 
 #' 
 #' 
-#' @examples
+#' @examples \donttest{
 #' 
 #' session = current_session()
 #' #null unless currently authenticated
 #' session
-#'
+#' }
 #'@export
 current_session = function(){
 	if(session_expired(pkg.env$session)){

R/identifier_exists.R

@@ -10,14 +10,13 @@
 #' @importFrom methods is
 #' 
 #' @return Logical, \code{TRUE} or \code{FALSE}
-#' @examples
-#' 
+#' @examples \donttest{
 #' # identifier exists
 #' identifier_exists(sb_id = "4f4e4b24e4b07f02db6aea14")
 #' 
 #' # identifier does not exist
 #' identifier_exists(sb_id = "aaaaaaakkkkkkkbbbbbb")
-#' 
+#' }
 identifier_exists <- function(sb_id, ..., session = current_session()) {
 	#sb_id = as.sbitem(sb_id)
 	if(is(sb_id, 'sbitem')){

R/item_exists.R

@@ -9,8 +9,7 @@
 #' @param session an SB session
 #' @return boolean for whether item exists
 #'
-#' @examples
-#' \dontrun{
+#' @examples \dontrun{
 #' item_exists('mda_streams','ts_doobs','nwis_01018035')
 #' item_exists('mda_streams','site_root','nwis_01018035')
 #' }

R/item_get.R

@@ -10,8 +10,7 @@
 #' access is restricted due to permissions. 
 #' 
 #' 
-#' @examples 
-#' \donttest{
+#' @examples \donttest{
 #' # Get an item
 #' item_get("4f4e4b24e4b07f02db6aea14")
 #' 
@@ -35,6 +34,8 @@ get_item <- function(id, ..., session=current_session()) {
 
 	if(is(res, "list")) {
 		if(res$status == 404) return(NULL)
+	} else if(is.null(res)) {
+		return(NULL)
 	}
 
 	return(as.sbitem(content(res)))

R/item_get_fields.R

@@ -7,8 +7,7 @@
 #' @return List serialization of chosen metadata for an SB item
 #' @import httr
 #' @export
-#' @examples 
-#' \donttest{
+#' @examples \donttest{
 #' # Get certain fields from an item
 #' item_get_fields("4f4e4b24e4b07f02db6aea14", c('title', 'citation', 'contacts'))
 #' 

R/item_list_files.R

@@ -13,11 +13,9 @@
 #' files attached to an item and all children items.
 #'
 #' @export
-#' @examples 
-#' \donttest{
+#' @examples \dontrun{
+#' 
 #' item_list_files("4f4e4b24e4b07f02db6aea14")
-#' }
-#' \dontrun{
 #' # list files recursively
 #' ## create item
 #' id <- item_create(user_id(), title="some title")

R/item_rename_files.R

@@ -7,8 +7,7 @@
 #' @param names List of names of files to rename
 #' @param new_names List of new file names to use
 #' 
-#' @examples 
-#' \dontrun{
+#' @examples \dontrun{
 #' 
 #' names = c('file1.txt', 'file2.txt')
 #' new_names = c('newname1.txt', 'newname2.txt')

R/item_update_identifier.R

@@ -11,9 +11,7 @@
 #' \code{\link{query_item_identifier}} for finding items based on alternative
 #' identifier.
 #'  
-#' @examples
-#'
-#' \dontrun{
+#' @examples \dontrun{
 #'
 #' session = authenticate_sb("user@@usgs.gov")
 #' item_update_identifier("5485fd99e4b02acb4f0c7e81", "scheme", "type", "key", session=session)

R/item_upload_files.R

@@ -56,8 +56,7 @@ item_upload_create = function(parent_id, files, ..., scrape_files = TRUE, sessio
 #'
 #' @import httr
 #'
-#' @examples 
-#' \dontrun{
+#' @examples \dontrun{
 #' res <- item_create(user_id(), "testing 123")
 #' cat("foo bar", file = "foobar.txt")
 #' item_append_files(res$id, "foobar.txt")
@@ -71,6 +70,8 @@ item_append_files = function(sb_id, files, ..., scrape_files = TRUE, session=cur
 
 	item <- as.sbitem(sb_id)
 
+	if(is.null(item)) return(NULL)
+
 	params <- paste0("?id=", item$id)
 
 	if(!scrape_files) {

R/query_item_identifier.R

@@ -13,8 +13,7 @@
 #' @import jsonlite
 #' @import httr
 #' 
-#' @examples 
-#' \dontrun{
+#' @examples \dontrun{
 #' authenticate_sb()
 #' 
 #' ex_item = item_create(title='identifier example')

R/query_sb.R

@@ -47,8 +47,7 @@
 #'  boxes and representational points. This is a alphanumeric string.
 #' }
 #' 
-#' @examples 
-#' \dontrun{
+#' @examples \dontrun{
 #' query_sb(list(q = "water"))
 #' 
 #' # Search by project status

R/query_sb_datatype.R

@@ -13,8 +13,7 @@
 #' @description 
 #' Queries ScienceBase for items with matching datatype.
 #' 
-#' @examples 
-#' \donttest{
+#' @examples \donttest{
 #' #query for items with WFS Layer data
 #' query_sb_datatype('Static Map Image')
 #' 
@@ -40,10 +39,10 @@ query_sb_datatype = function(datatype, ..., limit=20, session=current_session())
 #' coupled with \code{\link{query_sb_datatype}} to query based on the type of data
 #' 
 #' 
-#' @examples 
+#' @examples \donttest{
 #' #return all datatypes (limit 50 by default)
 #' sb_datatypes()
-#' 
+#' }
 #' 
 #' @export
 sb_datatypes = function(limit=50, session=current_session()){

R/query_sb_date.R

@@ -15,8 +15,7 @@
 #' @description 
 #' Queries ScienceBase for items with timestamps within a certain date/time range.
 #' 
-#' @examples
-#' \dontrun{
+#' @examples \dontrun{
 #' # find items updated today
 #' query_sb_date(Sys.time(), Sys.time())
 #' 

R/query_sb_doi.R

@@ -12,12 +12,12 @@
 #' Queries for ScienceBase items with a specific DOI identifier. 
 #' In ScienceBase, these are stored as additional unique identifiers.
 #' 
-#' @examples 
+#' @examples \donttest{
 #' #Two example DOI-specific queries
 #' query_sb_doi('10.5066/F7M043G7')
 #' 
 #' query_sb_doi('10.5066/F7Z60M35')
-#' 
+#' }
 #' @export
 query_sb_doi = function(doi, ..., limit=20, session=current_session()){
 

R/query_sb_spatial.R

@@ -11,16 +11,15 @@
 #' (uses the spatial object's bounding box) or long/lat coordinates defining the bounding box limits. 
 #' 
 #' 
-#' @examples
-#' 
+#' @examples \donttest{
 #' #specify the latitude and longitude points to define the bounding box range. 
 #' # This is simply bottom left and top right points
 #' query_sb_spatial(long=c(-104.4, -95.1), lat=c(37.5, 41.0), limit=3)
 #' 
 #' #use a pre-formatted WKT polygon to grab data
 #' query_sb_spatial(bb_wkt="POLYGON((-104.4 41.0,-95.1 41.0,-95.1 37.5,-104.4 37.5,-104.4 41.0))", 
 #' 	                limit=3)
-#' 
+#' }
 #' @export
 #' 
 query_sb_spatial = function(bbox, long, lat, bb_wkt, ..., limit=20, session=current_session()){

R/query_sb_text.R

@@ -12,13 +12,13 @@
 #' Queries for ScienceBase items that have matching text in the title or 
 #' description
 #' 
-#' @examples 
+#' @examples \donttest{
 #' #query for a person's name
 #' query_sb_text('Luna Leopold')
 #' 
 #' #query for one of the old river gaging stations
 #' query_sb_text('Lees Ferry')
-#' 
+#' }
 #' 
 #' @export
 query_sb_text = function(text, ..., limit=20, session=current_session()){

R/sb_ping.R

@@ -4,10 +4,10 @@
 #' @param ... Additional parameters are passed on to \code{\link[httr]{GET}}
 #' @return Boolean (TRUE) indicating if a connection to ScienceBase can be established 
 #' and if it is responding as expected. FALSE otherwise. 
-#' @examples 
+#' @examples \donttest{
 #' #TRUE if all is well and SB can be contacted
 #' sb_ping()
-#' 
+#' }
 sb_ping <- function(...) {
 
 	tryCatch({

R/session_age.R

@@ -5,8 +5,7 @@
 #' 
 #' @template manipulate_item
 #' @return difftime object
-#' @examples 
-#' \dontrun{
+#' @examples \dontrun{
 #' authenticate_sb('bbadger@@usgs.gov')
 #' sbtools::session_age()
 #' }

R/session_renew.R

@@ -13,8 +13,7 @@
 #'   
 #' @return Returns the session object.
 #'   
-#' @examples
-#' \dontrun{
+#' @examples \dontrun{
 #' # an empty call is sufficient if the session is current, 
 #' # but will break if haven't been logged in before
 #' session_renew()

R/session_validate.R

@@ -15,8 +15,7 @@
 #' 
 #' @importFrom methods new
 #' 
-#' @examples
-#' \dontrun{
+#' @examples \dontrun{
 #' session = authenticate_sb('user@@usgs.gov')
 #' 
 #' #return true as underlying RCurl session is valid

R/set_endpoint.R

@@ -8,9 +8,7 @@
 #'
 #'@author Luke Winslow
 #'
-#'@examples
-#'
-#'\donttest{
+#'@examples \donttest{
 #'set_endpoint('prod')
 #'
 #'# getting item from production SB servers