Adding support for installations #788

DESCRIPTION

@@ -8,7 +8,7 @@ Description: A programmatic interface to the Web Service methods
     retrieving information on data providers, getting species occurrence
     records, getting counts of occurrence records, and using the GBIF
     tile map service to make rasters summarizing huge amounts of data.
-Version: 3.8.2.2
+Version: 3.8.2.3
 License: MIT + file LICENSE
 Authors@R: c(
     person("Scott", "Chamberlain", role = "aut", comment = c("0000-0003-1444-9135")),

NAMESPACE

@@ -69,6 +69,14 @@ export(gbif_oai_list_records)
 export(gbif_oai_list_sets)
 export(gbif_photos)
 export(gbif_wkt2bbox)
+export(installation_comment)
+export(installation_contact)
+export(installation_dataset)
+export(installation_endpoint)
+export(installation_identifier)
+export(installation_machinetag)
+export(installation_search)
+export(installation_tag)
 export(installations)
 export(lit_count)
 export(lit_export)

R/dataset_search.r

@@ -138,7 +138,7 @@ dataset_search <- function(query = NULL,
                            start = NULL,
                            description = FALSE,
                            curlopts = list()) {
-
+  
   assert(query,"character")
   assert(type,"character")
   assert(subtype,"character")
@@ -165,7 +165,7 @@ dataset_search <- function(query = NULL,
                     facetOffset=facetOffset,
                     facetMincount=facetMincount,
                     facetMultiselect=facetMultiselect
-                    )))
+    )))
 
   args <- rgbif_compact(c(
     args,
@@ -192,7 +192,7 @@ dataset_search <- function(query = NULL,
 
   # metadata
   meta <- tt[c('offset','limit','endOfRecords','count')]
-
+  
   # facets
   facets <- tt$facets
   if (!length(facets) == 0) {

R/installation_search.R

@@ -0,0 +1,105 @@
+#' Search for installations 
+#'
+#' @param query A search query string. 
+#' @param type Choose from : IPT_INSTALLATION, DGIR INSTALLATION, TAPIR_INSTALLATION,
+#' BIOCASE_INSTALLATION, HTTP_INSTALLATION, SYMBIOTA_INSTALLATION, 
+#' EARTHCAPE_INSTALLATION, MDT_INSTALLATION. Only accepts one value.
+#' @param identifierType Choose from : URL, LSID, HANDLER, DOI, UUID, FTP, URI, 
+#' UNKNOWN, GBIF_PORTAL, GBIF_NODE, GBIF_PARTICIPANT, GRSCICOLL_ID, 
+#' GRSCICOLL_URI, IH_IRN, ROR, GRID, CITES, SYMBIOTA_UUID, WIKIDATA, 
+#' NCBI_BIOCOLLECTION, ISIL, CLB_DATASET_KEY. 
+#' @param identifier An identifier of the type given by the identifierType 
+#' parameter, for example a DOI or UUID.
+#' @param machineTagNamespace Filters for entities with a machine tag in the 
+#' specified namespace.
+#' @param machineTagName Filters for entities with a machine tag with the 
+#' specified name (use in combination with the machineTagNamespace parameter).
+#' @param machineTagValue Filters for entities with a machine tag with the 
+#' specified value (use in combination with the machineTagNamespace and 
+#' machineTagName parameters).
+#' @param modified The modified date of the dataset. Accepts ranges and 
+#' a `*` can be used as a wildcard, e.g. modified=2023-04-01,`*`
+#' @param limit The maximum number of results to return. Defaults to 20.
+#' @param offset The offset of the first result to return. 
+#' @param curlopts A list of curl options to pass to the request.
+#'
+#' @return A `list`
+#' 
+#' @export
+#'
+#' @examples \dontrun{
+#' instllation_search() 
+#' installation_search(query="Estonia")
+#' installation_search(type="IPT_INSTALLATION") 
+#' installation_search(modified="2023-04-01,*")
+#' 
+#' }
+
+
+installation_search <- function(
+    query = NULL,
+    type = NULL,
+    identifierType = NULL,
+    identifier = NULL,
+    machineTagNamespace = NULL,
+    machineTagName = NULL,
+    machineTagValue = NULL,
+    modified = NULL,
+    limit = 20,
+    offset = NULL,
+    curlopts = list()
+  ) {
+
+  assert(query,"character")
+  assert(identifierType, "character")
+  assert(identifier, "character")
+  assert(machineTagNamespace, "character")
+  assert(machineTagName, "character")
+  assert(machineTagValue, "character")
+  assert(modified, "character")
+
+  type_choices <- c("IPT_INSTALLATION", "DGIR INSTALLATION",
+                    "TAPIR_INSTALLATION", "BIOCASE_INSTALLATION",
+                    "HTTP_INSTALLATION", "SYMBIOTA_INSTALLATION",
+                    "EARTHCAPE_INSTALLATION", "MDT_INSTALLATION")
+  if(is.null(type)) { type = NULL } else { type = match.arg(type, type_choices) }
+  indentifierType_choices <- c("URL", "LSID", "HANDLER", "DOI", "UUID",
+                               "FTP", "URI", "UNKNOWN", "GBIF_PORTAL",
+                               "GBIF_NODE", "GBIF_PARTICIPANT", "GRSCICOLL_ID",
+                               "GRSCICOLL_URI", "IH_IRN", "ROR", "GRID",
+                               "CITES", "SYMBIOTA_UUID", "WIKIDATA",
+                               "NCBI_BIOCOLLECTION", "ISIL", "CLB_DATASET_KEY")
+
+
+  if(is.null(identifierType)) { identifierType = NULL } else { 
+    identifierType = match.arg(identifierType, indentifierType_choices) 
+  }
+
+  if (xor(is.null(identifierType), is.null(identifier))) {
+    stop("Both 'identifierType' and 'indentifier' must be provided 
+         together or both be NULL.")
+  }
+
+  args <- rgbif_compact(list(
+    q = query,
+    type = type,
+    identifierType = identifierType,
+    identifier = identifier,
+    machineTagNamespace = machineTagNamespace,
+    machineTagName = machineTagName,
+    machineTagValue = machineTagValue,
+    modified = modified,
+    limit = limit,
+    offset = offset
+  ))
+
+  url <- paste0(gbif_base(), "/installation")
+  tt <- gbif_GET(url, args, TRUE, curlopts)
+
+  # metadata
+  meta <- tt[c('offset','limit','endOfRecords','count')]
+
+  # data
+  out <- tibble::as_tibble(tt$results)
+  list(meta = data.frame(meta), data = out)
+}

R/intallation_uuid_funs.R

@@ -0,0 +1,90 @@
+#' Get installation metadata using a installationkey
+#' 
+#' @param uuid A GBIF installationKey uuid.
+#' @param limit The number of results to return. Default is 20.
+#' @param start The offset of the first result to return.
+#' @param curlopts A list of curl options to pass to the request.
+#' 
+#' @return A `tibble` or a `list`. 
+#' 
+#' @examples \dontrun{
+#' # Get all datasets for a given installation 
+#' installation_dataset(uuid="d209e552-7e6e-4840-b13c-c0596ef36e55", limit=10)
+#' installation_comment(uuid="a0e05292-3d09-4eae-9f83-02ae3516283c")
+#' installation_contact(uuid="896898e8-c0ac-47a0-8f38-0f792fbe3343")
+#' installation_endpoint(uuid="896898e8-c0ac-47a0-8f38-0f792fbe3343")
+#' installation_identifier(uuid="896898e8-c0ac-47a0-8f38-0f792fbe3343")
+#' installation_machinetag(uuid="896898e8-c0ac-47a0-8f38-0f792fbe3343")
+#' }
+#' 
+
+#' @name installation_uuid_funs
+#' @export
+installation_dataset <- function(uuid=NULL,limit=20, start = NULL, curlopts = list()) {
+  installation_uuid_get_(uuid=uuid,endpoint="/dataset",limit=limit,start=start,curlopts,meta=TRUE)
+}
+
+#' @name installation_uuid_funs
+#' @export
+installation_comment <- function(uuid=NULL, curlopts = list()) {
+  installation_uuid_get_(uuid=uuid,endpoint="/comment",meta=FALSE)
+}
+
+#' @name installation_uuid_funs
+#' @export
+installation_contact <- function(uuid=NULL, curlopts = list()) {
+  installation_uuid_get_(uuid=uuid,endpoint="/contact",meta=FALSE)
+}
+
+#' @name installation_uuid_funs
+#' @export
+installation_endpoint <- function(uuid=NULL, curlopts = list()) {
+  installation_uuid_get_(uuid=uuid,endpoint="/endpoint",meta=FALSE)
+}
+
+#' @name installation_uuid_funs
+#' @export
+installation_identifier <- function(uuid=NULL, curlopts = list()) {
+  installation_uuid_get_(uuid=uuid,endpoint="/identifier",meta=FALSE)
+}
+
+#' @name installation_uuid_funs
+#' @export
+installation_machinetag <- function(uuid=NULL, curlopts = list()) {
+  installation_uuid_get_(uuid=uuid,endpoint="/machineTag",meta=FALSE)
+}
+
+#' @name installation_uuid_funs
+#' @export
+installation_tag <- function(uuid=NULL, curlopts = list()) {
+  installation_uuid_get_(uuid=uuid,endpoint="/tag",meta=FALSE)
+}
+
+installation_uuid_get_ <- function(uuid=NULL,endpoint,curlopts,limit=NULL, start=NULL,meta) {
+    if(!is_uuid(uuid)) stop("'uuid' should be a GBIF installationKey uuid.")
+    url <- paste0(gbif_base(),"/installation/",uuid,endpoint)
+    if(!is.null(limit)) {
+      args <- rgbif_compact(c(limit=limit,offset=start))
+      tt <- gbif_GET(url, args, TRUE, curlopts)
+    } else {
+      tt <- gbif_GET(url, args = NULL, TRUE, curlopts)
+    }
+    if(meta) {
+      meta <- tt[c('offset','limit','endOfRecords','count')]
+      if (length(tt$results) == 0) {
+        out <- NULL
+      } else {
+        out <- tibble::as_tibble(tt$results)  
+      }
+      list(meta = data.frame(meta), data = out) 
+    } else {
+      tibble::as_tibble(tt)
+    }
+  }
+
+
+
+
+
+
+

R/lit_search.R

@@ -190,8 +190,8 @@ lit_search <- function(
   if(is.null(limit)) {
     limit <- count_limit
     if(length(args) == 0) {
-        message("No filters used, but 'limit=NULL' returning just the first 1000 results. If you actually just want the first 10,000 records, use 'limit=10000'.")
-        limit <- 1000
+      message("No filters used, but 'limit=NULL' returning just the first 1000 results. If you actually just want the first 10,000 records, use 'limit=10000'.")
+      limit <- 1000
     }
   }
 
@@ -261,9 +261,9 @@ lit_count <- function(...) {
                      "journalPublisher")
   if(!all(names(x) %in% accepted_args)) {
     stop(
-    paste0(
-    "Please use accepted argument from lit_search() :",toString(accepted_args)
-    ))}
+      paste0(
+        "Please use accepted argument from lit_search() :",toString(accepted_args)
+      ))}
 
   count <- lit_search(
     q=x$q,
@@ -308,7 +308,7 @@ lit_export <- function(
     abstract=FALSE,
     limit=NULL,
     curlopts = list()
-  ) {
+) {
 
   if(!is_uuid(datasetKey) & !is.null(datasetKey)) stop("'datasetKey' should be a GBIF dataset uuid.")
   if(!is_uuid(publishingOrg) & !is.null(publishingOrg)) stop("'publishingOrg' should be a GBIF publisher uuid.")
@@ -335,22 +335,22 @@ lit_export <- function(
          year = year,
          peerReview = peerReview,
          openAccess = openAccess
-        ))
+    ))
 
   args <- rgbif_compact(
-            c(args,
-            convmany(relevance),
-            convmany(countriesOfResearcher),
-            convmany(countriesOfCoverage),
-            convmany(literatureType),
-            convmany(topics),
-            convmany_rename(datasetKey,"gbifDatasetKey"),
-            convmany_rename(publishingOrg,"publishingOrganizationKey"),
-            convmany_rename(downloadKey,"gbifDownloadKey"), 
-            convmany(doi), 
-            convmany_rename(journalSource,"source"), 
-            convmany_rename(journalPublisher,"publisher")
-            ))
+    c(args,
+      convmany(relevance),
+      convmany(countriesOfResearcher),
+      convmany(countriesOfCoverage),
+      convmany(literatureType),
+      convmany(topics),
+      convmany_rename(datasetKey,"gbifDatasetKey"),
+      convmany_rename(publishingOrg,"publishingOrganizationKey"),
+      convmany_rename(downloadKey,"gbifDownloadKey"), 
+      convmany(doi), 
+      convmany_rename(journalSource,"source"), 
+      convmany_rename(journalPublisher,"publisher")
+    ))
 
   url_query <- paste0(names(args),"=",args,collapse="&")
   url_query <- utils::URLencode(url_query)