genesys.R 5.88 KB
Newer Older
Matija Obreza's avatar
Matija Obreza committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
# Copyright 2018 Global Crop Diversity Trust
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.

15
16
#' Max pages to retrieve
.MAX_ALLOWED_PAGES <- 500
Matija Obreza's avatar
Matija Obreza committed
17
18
19
20
21

#' Who am i?
#'
#' @export
me <- function() {
Matija Obreza's avatar
Matija Obreza committed
22
  resp <- .api_call("/me")
Matija Obreza's avatar
Matija Obreza committed
23
24
25
26
  message(jsonlite::toJSON(resp, pretty = TRUE))
  invisible(resp)
}

27
#' Fetch accession passport data (paginated)
Matija Obreza's avatar
Matija Obreza committed
28
29
30
31
#'
#' @param filters an R \code{structure} with Genesys filters
#' @param size number of records to load per page (page size)
#' @param page the page index (0-based)
32
#' @param selector NULL or a function to "select" variables of interest
Matija Obreza's avatar
Matija Obreza committed
33
34
35
36
#'
#' @seealso \code{\link{mcpd_filter}}
#'
#' @examples
37
#' \dontrun{
38
#'   # Retrieve accession data by country of origin
Matija Obreza's avatar
Matija Obreza committed
39
#'   accessions <- fetch_accessions(mcpd_filter(ORIGCTY = c("DEU", "SVN")))
40
41
#' }
#' 
Matija Obreza's avatar
Matija Obreza committed
42
#' @return Paged data structure
Matija Obreza's avatar
Matija Obreza committed
43
.fetch_accessions_page <- function(filters = list(), page = 0, size = 1000, selector = NULL) {
44
  start_time <- as.numeric(as.numeric(Sys.time())*1000, digits=15)
Matija Obreza's avatar
Matija Obreza committed
45
  resp <- .post(path = "/acn/list", query=list(p = page, l = size), body = filters)
46
  end_time <- as.numeric(as.numeric(Sys.time())*1000, digits=15)
47
  paged <- jsonlite::fromJSON(httr::content(resp, "text"), simplifyVector = FALSE)
48
  message(paste("Retrieved page", page + 1, "of", paged$totalPages, "with", paged$numberOfElements, "rows in", end_time - start_time, "ms."))
49
50
51
52
53
54
55
56
57
58
59
60
61
62
  
  # Apply selector
  if (is.function(selector)) {
    paged$content <- lapply(paged$content, selector)
  }
  paged
}

#' Fetch accession passport data
#'
#' @param filters an R \code{structure} with Genesys filters
#' @param size number of records to load per page (page size)
#' @param page the page index (0-based)
#' @param selector NULL or a function to "select" variables of interest
63
#' @param at.least stop fetching when at.least records are received from Genesys
64
65
#'
#' @examples
66
#' \dontrun{
67
68
69
70
71
72
73
74
75
76
#'   # Retrieve all accession data by country of origin
#'   accessions <- fetch_accessions(mcpd_filter(ORIGCTY = c("DEU", "SVN")))
#'
#'   # Fetch Musa
#'   musa <- genesysr::fetch_accessions(list(taxonomy.genus = c('Musa')))
#'
#'   # Apply selector function
#'   accessions <- fetch_accessions(mcpd_filter(ORIGCTY = c("DEU", "SVN")), selector = function(x) {
#'     list(id = x$id, acceNumb = x$acceNumb, instCode = x$institute$code)
#'   })
77
78
#' }
#' 
79
80
#' @export
#' @return Paged data structure
81
fetch_accessions <- function(filters = list(), page = NULL, size = 1000, selector = NULL, at.least = NULL) {
82
83
  if (! is.null(page)) {
    # Fetch page
Matija Obreza's avatar
Matija Obreza committed
84
    return(.fetch_accessions_page(filters, page, size, selector));
85
86
87
  }
  
  # Fetch first page to determine number of records
Matija Obreza's avatar
Matija Obreza committed
88
  paged <- .fetch_accessions_page(filters, page = 0, size, selector)
89
90
91
  pages <- paged$totalPages
  
  for (page in 1:pages) {
92
    if (page > .MAX_ALLOWED_PAGES) {
Matija Obreza's avatar
Matija Obreza committed
93
      # Break if over max pages
94
95
      message(paste("Not requesting data after page", .MAX_ALLOWED_PAGES, "Stopping."))
      break
96
    }
Matija Obreza's avatar
Matija Obreza committed
97
    p <- .fetch_accessions_page(filters, page, size, selector)
98
99
100
101
102
103
104
105
106
    
    paged$content <- c(paged$content, p$content)
    paged$last <- p$last
    paged$numberOfElements <- paged$numberOfElements + p$numberOfElements
    
    if (p$last) {
      # print("Got last page")
      break
    }
Matija Obreza's avatar
Matija Obreza committed
107
108
    if (! is.null(at.least) && at.least <= paged$numberOfElements) {
      message(paste("Receved", paged$numberOfElements, "of", at.least, "requested. Stopping."))
109
110
      break
    }
111
112
113
  }
  
  paged
Matija Obreza's avatar
Matija Obreza committed
114
}
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187


#' Download all passport data for one genebank in Excel format and save it to disk
#'
#' @param instituteCode FAO WIEWS institute code
#' @param file Target file name. Defaults to Genesys-provided file name in the current working directory.
#'
#' @examples
#' \dontrun{
#'   # Download MCPD passport data for NGA039
#'   excelData <- download_mcpd("NGA039")
#' }
#' 
#' @export
#' @return HTTP response data
download_mcpd <- function(instituteCode, file = NULL) {
  if (is.na(instituteCode)) {
    stop("instituteCode parameter is required")
  }

  if (is.null(file)) {
    file <- paste0("genesys-accessions-", instituteCode, ".xlsx")
  }

  resp <- httr::POST(
    api1_url(paste0("/wiews/", instituteCode, "/download")),
    body = list(mcpd = "mcpd"), encode = "form",
    httr::write_disk(file),
    httr::add_headers(
      Authorization = .genesysEnv$Authorization
    )) # , httr::verbose())
  if (httr::status_code(resp) != 200) {
    stop("Genesys responded with HTTP status code ", httr::status_code(resp), ". Expected 200.")
  }
  invisible(resp)
}


#' Download PDCI data for one genebank in Excel format and save it to disk.
#'
#' @param instituteCode FAO WIEWS institute code
#' @param file Target file name. Defaults to Genesys-provided file name in the current working directory.
#'
#' @examples
#' \dontrun{
#'   # Download PDCI  data for NGA039
#'   excelData <- download_pdci("NGA039")
#' }
#' 
#' @export
#' @return HTTP response data
download_pdci <- function(instituteCode, file = NULL) {
  if (is.na(instituteCode)) {
    stop("instituteCode parameter is required")
  }
  
  if (is.null(file)) {
    file <- paste0("genesys-pdci-", instituteCode, ".xlsx")
  }
  
  resp <- httr::POST(
    api1_url(paste0("/wiews/", instituteCode, "/download")),
    body = list(pdci = "pdci"), encode = "form",
    httr::write_disk(file),
    httr::add_headers(
      Authorization = .genesysEnv$Authorization
    )) # , httr::verbose())
  if (httr::status_code(resp) != 200) {
    stop("Genesys responded with HTTP status code ", httr::status_code(resp), ". Expected 200.")
  }
  invisible(resp)
}