adding support for verbatim extension downloads

jhnwllr · jhnwllr · commit e8cc08a05ced · 2026-01-15T13:14:10.000+01:00
diff --git a/DESCRIPTION b/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.4.3
+Version: 3.8.4.4
 License: MIT + file LICENSE
 Authors@R: c(
     person("Scott", "Chamberlain", role = "aut", comment = c("0000-0003-1444-9135")),
diff --git a/R/download_predicate_dsl.R b/R/download_predicate_dsl.R
@@ -581,7 +581,7 @@ sub_str <- function(str, max = 100) {
   if (nchar(str) < max) return(str)
   paste0(substring(str, 1, max), " ... ", sprintf("(N chars: %s)", nchar(str)))
 }
-parse_predicates <- function(user, email, type, format, ...) {
+parse_predicates <- function(user, email, type, format, verbatim_extensions, ...) {
   tmp <- list(...)
   if(length(tmp) == 0) { 
     stop("You are requesting a full download. Please use a predicate to filter the data. For example, pred_default().")
@@ -593,12 +593,25 @@ clzzs <- vapply(tmp,
   if (!all(clzzs))
     stop("all inputs must be class occ_predicate/occ_predicate_list; ?occ_download",
       call. = FALSE)
-  payload <- list(
-    creator = unbox(user),
-    notification_address = email,
-    format = unbox(format),
-    predicate = list()
-  )
+  if (!is.null(verbatim_extensions)) {
+    if(format != "DWCA") {
+      warning("verbatim_extensions can only be used with format = 'DWCA'. Ignoring verbatim_extensions.")
+    }
+    payload <- list(
+      creator = unbox(user),
+      notification_address = email,
+      format = unbox(format),
+      verbatimExtensions = verbatim_extensions,
+      predicate = list()
+    )
+  } else {
+    payload <- list(
+      creator = unbox(user),
+      notification_address = email,
+      format = unbox(format),
+      predicate = list()
+    )
+  }
   if (any(vapply(tmp, function(w) "predicates" %in% names(w), logical(1)))) {
     payload$predicate <- list(unclass(tmp[[1]]))
   } else {
diff --git a/R/occ_download.R b/R/occ_download.R
@@ -17,6 +17,8 @@
 #' within, not (!), like, isNotNull
 #' @param format (character) The download format. One of 'DWCA' (default),
 #' 'SIMPLE_CSV', or 'SPECIES_LIST'
+#' @param verbatim_extensions (character vector) A character vector of verbatim 
+#' extensions to include in the download. 
 #' @param user (character) User name within GBIF's website. Required. See
 #' "Authentication" below
 #' @param pwd (character) User password within GBIF's website. Required. See
@@ -177,12 +179,19 @@
 #' # unique(df$countryCode)
 #' # sort(unique(df$year))
 #' }
-occ_download <- function(..., body = NULL, type = "and", format = "DWCA",
-                         user = NULL, pwd = NULL, email = NULL, 
+occ_download <- function(..., 
+                         body = NULL, 
+                         type = "and", 
+                         format = "DWCA",
+                         verbatim_extensions = NULL,
+                         user = NULL, 
+                         pwd = NULL, 
+                         email = NULL, 
                          curlopts = list(http_version = 2)) {
   
-  z <- occ_download_prep(..., body = body, type = type, format = format,
-                         user = user, pwd = pwd, email = email, curlopts = curlopts)
+  z <- occ_download_prep(..., body = body, type = type, format = format, 
+                         verbatim_extensions = verbatim_extensions, user = user, 
+                         pwd = pwd, email = email, curlopts = curlopts)
   out <- rg_POST(z$url, req = z$request, user = z$user, pwd = z$pwd, curlopts)
   md <- occ_download_meta(out) # get meta_data for printing
   citation <- gbif_citation(md)$download # get citation
@@ -204,8 +213,15 @@ download_formats <- c("DWCA", "SIMPLE_CSV", "SPECIES_LIST", "SIMPLE_PARQUET")
 
 #' @export
 #' @rdname occ_download
-occ_download_prep <- function(..., body = NULL, type = "and", format = "DWCA",
-                              user = NULL, pwd = NULL, email = NULL, curlopts = list(http_version = 2)) {
+occ_download_prep <- function(..., 
+                              body = NULL, 
+                              type = "and", 
+                              format = "DWCA",
+                              verbatim_extensions = NULL,
+                              user = NULL, 
+                              pwd = NULL, 
+                              email = NULL, 
+                              curlopts = list(http_version = 2)) {
   
   url <- paste0(gbif_base(), '/occurrence/download/request')
   user <- check_user(user)
@@ -220,7 +236,7 @@ occ_download_prep <- function(..., body = NULL, type = "and", format = "DWCA",
   if (!is.null(body)) {
     req <- body
   } else {
-    req <- parse_predicates(user, email, type, format, ...)
+    req <- parse_predicates(user, email, type, format, verbatim_extensions, ...)
   }
   structure(list(
     url = url,
diff --git a/man/occ_download.Rd b/man/occ_download.Rd
diff --git a/tests/fixtures/occ_download_9.yml b/tests/fixtures/occ_download_9.yml
diff --git a/tests/testthat/test-download_parsing.R b/tests/testthat/test-download_parsing.R
@@ -6,7 +6,7 @@ email <- 'foo@bar.com'
 type <- 'and'
 
 test_that("occ_download input parsing", {
-  aa <- parse_predicates(user, email, type, "DWCA", pred("taxonKey", 7228682))
+  aa <- parse_predicates(user, email, type, "DWCA", NULL, pred("taxonKey", 7228682))
   expect_is(aa, "list")
   expect_named(aa, c("creator", "notification_address", "format", "predicate"))
   expect_is(aa$predicate$type, "character")
@@ -17,7 +17,7 @@ test_that("occ_download input parsing", {
   expect_equal(unclass(aa$predicate$value), "7228682")
   expect_null(aa$predicate$predicates)
 
-  bb <- parse_predicates(user, email, type, "DWCA", pred("hasCoordinate", TRUE))
+  bb <- parse_predicates(user, email, type, "DWCA", NULL, pred("hasCoordinate", TRUE))
   expect_is(bb, "list")
   expect_is(bb$predicate$type, "character")
   expect_is(bb$predicate$type, "scalar")
@@ -27,7 +27,7 @@ test_that("occ_download input parsing", {
   expect_equal(unclass(bb$predicate$value), "true")
   expect_null(bb$predicate$predicates)
 
-  cc <- parse_predicates(user, email, type, "DWCA",
+  cc <- parse_predicates(user, email, type, "DWCA", NULL,
     pred_within("POLYGON((30.1 10.1,40 40,20 40,10 20,30.1 10.1))"))
   expect_is(cc, "list")
   expect_is(cc$predicate$type, "character")
@@ -39,7 +39,7 @@ test_that("occ_download input parsing", {
     "POLYGON((30.1 10.1,40 40,20 40,10 20,30.1 10.1))")
   expect_null(cc$predicate$predicates)
 
-  aa <- parse_predicates(user, email, type, "DWCA",
+  aa <- parse_predicates(user, email, type, "DWCA", NULL,
     pred('taxonKey', 7228682),
     pred('hasCoordinate', TRUE),
     pred('hasGeospatialIssue', FALSE),
@@ -55,7 +55,7 @@ test_that("occ_download input parsing", {
   expect_is(aa$predicate$predicates[[4]]$geometry[1], "character")
 
   # format=SIMPLE_CSV
-  aa <- parse_predicates(user, email, type, "SIMPLE_CSV",
+  aa <- parse_predicates(user, email, type, "SIMPLE_CSV", NULL,
     pred_gte('decimalLatitude', 82))
   expect_is(aa, "list")
   expect_named(aa, c("creator", "notification_address", "format", "predicate"))
@@ -68,7 +68,7 @@ test_that("occ_download input parsing", {
   expect_null(aa$predicate$predicates)
 
   # format=SPECIES_LIST
-  aa <- parse_predicates(user, email, "not", "SPECIES_LIST",
+  aa <- parse_predicates(user, email, "not", "SPECIES_LIST", NULL,
     pred_lt('decimalLatitude', 2000))
   expect_is(aa, "list")
   expect_named(aa, c("creator", "notification_address", "format", "predicate"))
@@ -83,7 +83,18 @@ test_that("occ_download input parsing", {
 
 test_that("parse_predicates fails well", {
   expect_error(
-    parse_predicates(user, email, type, "DWCA", 'hasCoordinate = TRUE'),
+    parse_predicates(user, email, type, "DWCA", NULL, 'hasCoordinate = TRUE'),
     "all inputs must be"
   )
 })
+
+test_that("parse_predicates verbatim_extensions works", {
+  ve <- c("http://rs.tdwg.org/dwc/terms/MeasurementOrFact",
+          "http://rs.gbif.org/terms/1.0/Multimedia")
+  
+  aa <- parse_predicates("john", "email", "and", "DWCA", ve, pred("taxonKey", 22))
+  
+  expect_is(aa, "list")
+  expect_named(aa, c("creator", "notification_address", "format", "verbatimExtensions", "predicate"))
+  expect_equal(unclass(aa$verbatimExtensions), ve)
+})
diff --git a/tests/testthat/test-occ_download.R b/tests/testthat/test-occ_download.R
@@ -185,6 +185,24 @@ test_that("occ_download: real requests work", {
   # check that full downloads fail well 
   expect_error(occ_download(), "You are requesting a full download. Please use a predicate to filter the data. For example, pred_default().")
   
+   vcr::use_cassette("occ_download_9", {
+    bbb <- occ_download(
+      pred("taxonKey",22),
+      format = "DWCA",
+      verbatim_extensions=
+      c("http://rs.gbif.org/terms/1.0/DNADerivedData",
+      "http://rs.tdwg.org/dwc/terms/MeasurementOrFact")
+    )
+  }, match_requests_on = c("method", "uri", "body"))
+  expect_is(unclass(bbb), "character")
+  expect_match(unclass(bbb)[1], "^[0-9]{7}-[0-9]{15}$")
+  expect_equal(attr(bbb, "user"), Sys.getenv("GBIF_USER"))
+  expect_equal(attr(bbb, "email"), Sys.getenv("GBIF_EMAIL"))
+  expect_equal(attr(bbb, "format"), "DWCA")
+  expect_is(attr(bbb,"citation"),"character")
+  expect_is(attr(bbb,"downloadLink"),"character")
+  expect_output(print.occ_download(bbb),"<<gbif download>>")
+  expect_equal(length(capture.output(print(bbb))),22)
 })
 
 
diff --git a/vignettes/getting_occurrence_data.Rmd b/vignettes/getting_occurrence_data.Rmd
@@ -274,6 +274,20 @@ wkt %>%
 
 When generating polygons from public data sources, check the WKT is what you want using a site like [WKT Geometry Plotter](https://www.geometrymapper.com/).  A common mistake is requesting a polygon for the United Kingdom, but finding it includes the UK's territories of Bermuda, Pitcairn and so on.  (`pred("country", "GB")` or `pred_in("country", c("GB", "IM", "GG", "JE"))` is much faster anyway.)
 
+## Downloading verbatim DWCA extensions
+
+GBIF now allows users to download DWCA extensions. These tables are combined and returned to the user as-is ("verbatim"). The `verbatim_extensions` argument only works when `format="DWCA"`. Otherwise, you will get a warning. 
+
+```r
+occ_download(
+  pred("taxonKey",22),
+  format = "DWCA",
+  verbatim_extensions = "http://rs.tdwg.org/dwc/terms/MeasurementOrFact"
+)
+```
+
+To view all of the available extensions use `rgbif::occ_download_describe("dwca")$verbatimExtensions`.
+
 ## Get just the EEZ waters of a country/area 
 
 Sometimes GBIF users just want the **EEZ** (Exclusive Economic Zone) waters of a country. This is possible using the `gadm` filter and `pred_not`.  
