USGS-R / sbtools

Compare a0b423f ... +4 ... 212d027

Showing 23 of 41 files from the diff.

@@ -11,16 +11,15 @@
Loading
11 11
#' (uses the spatial object's bounding box) or long/lat coordinates defining the bounding box limits. 
12 12
#' 
13 13
#' 
14 -
#' @examples
15 -
#' 
14 +
#' @examples \donttest{
16 15
#' #specify the latitude and longitude points to define the bounding box range. 
17 16
#' # This is simply bottom left and top right points
18 17
#' query_sb_spatial(long=c(-104.4, -95.1), lat=c(37.5, 41.0), limit=3)
19 18
#' 
20 19
#' #use a pre-formatted WKT polygon to grab data
21 20
#' 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))", 
22 21
#' 	                limit=3)
23 -
#' 
22 +
#' }
24 23
#' @export
25 24
#' 
26 25
query_sb_spatial = function(bbox, long, lat, bb_wkt, ..., limit=20, session=current_session()){

@@ -13,8 +13,7 @@
Loading
13 13
#' @import jsonlite
14 14
#' @import httr
15 15
#' 
16 -
#' @examples 
17 -
#' \dontrun{
16 +
#' @examples \dontrun{
18 17
#' authenticate_sb()
19 18
#' 
20 19
#' ex_item = item_create(title='identifier example')

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

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

@@ -15,7 +15,7 @@
Loading
15 15
	
16 16
	r = POST(url=url, ..., httrUserAgent(), accept_json(), body=body, handle=session, 
17 17
					 timeout = httr::timeout(default_timeout())) 
18 -
	handle_errors(r, url, "POST", supported_types)	
18 +
	r <- handle_errors(r, url, "POST", supported_types)	
19 19
	# if (!strsplit(headers(r)[['content-type']], '[;]')[[1]][1] %in% supported_types)
20 20
	# 	stop('POST failed to ',url,'. check authorization and/or content')
21 21
	
@@ -52,7 +52,7 @@
Loading
52 52
																		"error was:\n", e))
53 53
																 return(list(status = 404))
54 54
	})
55 -
	handle_errors(r, url, "GET", supported_types)
55 +
	r <- handle_errors(r, url, "GET", supported_types)
56 56
	session_age_reset()
57 57
	return(r)
58 58
}
@@ -72,8 +72,8 @@
Loading
72 72
#' @keywords internal
73 73
sbtools_PUT <- function(url, body, ..., session) {
74 74
	check_session(session)
75 -
	r = PUT(url = url, ..., httrUserAgent(), body = body, handle = session, timeout = httr::timeout(default_timeout()))
76 -
	handle_errors(r, url, "PUT", NULL)
75 +
	r <- PUT(url = url, ..., httrUserAgent(), body = body, handle = session, timeout = httr::timeout(default_timeout()))
76 +
	r <- handle_errors(r, url, "PUT", NULL)
77 77
	session_age_reset()
78 78
	return(r)
79 79
}
@@ -94,7 +94,7 @@
Loading
94 94
	check_session(session)
95 95
	r = DELETE(url = url, ..., httrUserAgent(), accept_json(), 
96 96
						 handle = session, timeout = httr::timeout(default_timeout()))
97 -
	handle_errors(r, url, "DELETE", NULL)
97 +
	r <- handle_errors(r, url, "DELETE", NULL)
98 98
	session_age_reset()
99 99
	return(r)
100 100
}
@@ -116,20 +116,37 @@
Loading
116 116
117 117
# helpers -------------
118 118
handle_errors <- function(x, url, method, types) {
119 +
	tryCatch({
119 120
	if(is(x, "list")) {
120 121
		if(x$status == 404) warning("Could not access sciencebase")
121 122
		return(NULL)
122 123
	}
123 124
	
124 125
	if (!is.null(types)) {
125 126
		if (!strsplit(headers(x)[['content-type']], '[;]')[[1]][1] %in% types) {
126 -
			stop(method, ' failed to ', url, '. check authorization and/or content', call. = FALSE)
127 +
			message(method, ' failed to ', url, '. check authorization and/or content', call. = FALSE)
128 +
			return(NULL)
127 129
		}
128 130
	}
129 131
	
130 132
	if ('errors' %in% names(content(x))) {
131 -
		stop(content(x)$errors$message, call. = FALSE)
133 +
		
134 +
		if(length(errors <- content(x)$errors) == 1) {
135 +
			message(errors$message, call. = FALSE)
136 +
		} else {
137 +
			message(paste(sapply(errors, function (x) x$message), collapse = "\n"), call. = FALSE)
138 +
		}
139 +
		
140 +
		return(NULL)
132 141
	}
142 +
	
143 +
	return(x)
144 +
	}, error = function(e) {
145 +
		
146 +
		message(paste("Error when calling sciencebase,", e))
147 +
		return(NULL)
148 +
		
149 +
	})
133 150
}
134 151
135 152
#' @importFrom curl curl_version

Click to load this diff.
Loading diff...

Click to load this diff.
Loading diff...

Click to load this diff.
Loading diff...

Click to load this diff.
Loading diff...

Click to load this diff.
Loading diff...

Click to load this diff.
Loading diff...

Click to load this diff.
Loading diff...

Click to load this diff.
Loading diff...

Click to load this diff.
Loading diff...

Click to load this diff.
Loading diff...

Click to load this diff.
Loading diff...

Click to load this diff.
Loading diff...

Click to load this diff.
Loading diff...

Click to load this diff.
Loading diff...

Click to load this diff.
Loading diff...

Click to load this diff.
Loading diff...

Click to load this diff.
Loading diff...

Click to load this diff.
Loading diff...

Learn more Showing 1 files with coverage changes found.

Changes in R/REST_helpers.R
-1
+1
Loading file...
Files Coverage
R -0.91% 50.09%
Project Totals (50 files) 50.09%
Loading