Commit e8f62186 authored by Matija Obreza's avatar Matija Obreza
Browse files

List WIEWS institutes

parent 194946db
...@@ -18,6 +18,7 @@ export(filter_SAMPSTAT) ...@@ -18,6 +18,7 @@ export(filter_SAMPSTAT)
export(filter_SPECIES) export(filter_SPECIES)
export(get_accessions) export(get_accessions)
export(list_crops) export(list_crops)
export(list_institutes)
export(list_species) export(list_species)
export(mcpd_filter) export(mcpd_filter)
export(me) export(me)
......
...@@ -228,17 +228,22 @@ api2_url <- function(path) { ...@@ -228,17 +228,22 @@ api2_url <- function(path) {
#' @keywords internal #' @keywords internal
.post <- function(path, query = NULL, body = NULL, content.type = "application/json", accept = "application/json") { .post <- function(path, query = NULL, body = NULL, content.type = "application/json", accept = "application/json") {
.check_auth() .check_auth()
content <- jsonlite::toJSON(body) content <- jsonlite::toJSON(body, auto_unbox = TRUE)
if (! is.null(body) && length(body) == 0) { if (! is.null(body) && length(body) == 0) {
# If body is provided, but has length of 0 # If body is provided, but has length of 0
content <- "{}" content <- "{}"
} }
# print(paste("Body is:", content)) # print(paste("Body is:", content))
resp <- httr::POST(path, query = query, httr::add_headers( resp <- httr::POST(path, query = query,
Authorization = .genesysEnv$Authorization, httr::add_headers(
"Content-Type" = content.type, Authorization = .genesysEnv$Authorization,
"Accept" = accept "Content-Type" = content.type,
), body = content) "Accept" = accept
),
# httr::verbose(),
body = content
)
if (httr::status_code(resp) != 200) { if (httr::status_code(resp) != 200) {
stop("Genesys responded with HTTP status code ", httr::status_code(resp), ". Expected 200. See response content:\n", httr::content(resp), call. = FALSE) stop("Genesys responded with HTTP status code ", httr::status_code(resp), ". Expected 200. See response content:\n", httr::content(resp), call. = FALSE)
} }
......
...@@ -365,3 +365,95 @@ list_species <- function(filters = list()) { ...@@ -365,3 +365,95 @@ list_species <- function(filters = list()) {
data data
} }
#' Fetch a page of data from Genesys
#'
#' @param path API path
#' @param filters Filters
#' @param accept Accepted content type
#' @param page Page to request
#' @param size Size of page
#'
#' @keywords internal
.fetch_csv_page <- function(path, filters = list(), accept = "text/csv", page = 0, size = 1000) {
start_time <- as.numeric(as.numeric(Sys.time())*1000, digits=15)
resp <- .post(path, query = list(l = size, p = page), body = filters, accept = accept)
if (httr::status_code(resp) != 200) {
stop("Genesys responded with HTTP status code ", httr::status_code(resp), ". Expected 200.")
}
if (httr::http_type(resp) != accept) {
stop("API returned ", httr::http_type(resp), ". Expected text/csv.")
}
end_time <- as.numeric(as.numeric(Sys.time())*1000, digits=15)
headers <- httr::headers(resp)
message(paste("Retrieved institute data in", end_time - start_time, "ms."))
body <- httr::content(resp, "text")
if (nchar(trimws(body)) == 0) {
message(paste("Received 0 bytes"))
data <- data.frame()
} else {
data <- read.csv(text = body, quote = '"', sep = '\t', stringsAsFactors = FALSE)
}
data
}
#' List FAO WIEWS institutes.
#'
#' Institute filters:
#' - code: list of WIEWS institute codes
#' - accessions: boolean, TRUE list only institutes with accessions in Genesys, FALSE without accessions
#' - country$code3: list of ISO3166 country codes
#'
#' @param filters an R \code{structure} with Institute filters
#'
#' @examples
#' \dontrun{
#' # Retrieve taxa of selected accessions
#' filters <- c();
#' filters$accessions = TRUE; # Has accessions in Genesys
#' institutes <- genesysr::list_institutes(filters)
#' }
#'
#' @seealso \code{\link{mcpd_filter}}
#'
#' @export
#' @return List of institutes
list_institutes <- function(filters = list(), at.least = NULL) {
path <- api1_url("/wiews/list")
# Fetch first page to determine number of records
data <- .fetch_csv_page(path, filters, page = 0, size = 100)
pages <- .MAX_ALLOWED_PAGES
for (page in 1:pages) {
if (page > .MAX_ALLOWED_PAGES) {
# Break if over max pages
message(paste("Not requesting data after page", .MAX_ALLOWED_PAGES, "Stopping."))
break
}
p <- .fetch_csv_page(path, filters, page = page, size = 100)
if (nrow(p) == 0) {
# print("Got last page")
break
}
data[setdiff(names(p), names(data))] <- NA
p[setdiff(names(data), names(p))] <- NA
data <- rbind(data, p)
if (length(p) == 0) {
# print("Got last page")
break
}
if (! is.null(at.least) && at.least <= length(data)) {
message(paste("Received", length(data), "of", at.least, "requested. Stopping."))
break
}
}
data
}
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment