trying to fix issues with tests

R/bold_search.R

@@ -74,7 +74,7 @@ bold_search <- function(sci = NULL, id = NULL, fuzzy = FALSE,
   type <- if (is.null(sci)) "id" else "sci"
   tmp <- switch(type,
          sci = bold_tax_name(name = sci, fuzzy = fuzzy, response = response, ...),
-         id = bold_tax_id(id = id, dataTypes = dataTypes, includeTree = includeTree,
+         id = bold::bold_tax_id2(id = id, dataTypes = dataTypes, includeTree = includeTree,
                           response = response, ...)
   )
   return(tmp)

R/eol_dataobjects.R

@@ -18,23 +18,25 @@
 #' eol_dataobjects(id = 7561533, verbose = TRUE)
 #' }
 eol_dataobjects <- function(id, taxonomy = TRUE, language = NULL, ...) {
+
+  .Defunct("eol", "originr", msg = "This function is defunct since it seems that the data_objects part of the EOL API v1 does not work anymore.")
 
-  cli <- crul::HttpClient$new(
-    url = file.path(eol_url("data_objects"), paste0(id, ".json")),
-    headers = tx_ual,
-    opts = list(...)
-  )
-  args <- argsnull(tc(list(taxonomy = as_l(taxonomy), language = language)))
-  res <- cli$get(query = args)
-  res$raise_for_status()
-  tt <- res$parse("UTF-8")
-  tmp <- jsonlite::fromJSON(tt)
-  tmp <- nmslwr(tmp)
-  if ("taxonconcepts" %in% names(tmp)) {
-    tmp$taxonconcepts <- nmslwr(tmp$taxonconcepts)
-    tmp$taxonconcepts$taxonrank <- tolower(tmp$taxonconcepts$taxonrank)
-  }
-  return(tmp)
+  # cli <- crul::HttpClient$new(
+  #   url = file.path(eol_url("data_objects"), paste0(id, ".json")),
+  #   headers = tx_ual,
+  #   opts = list(...)
+  # )
+  # args <- argsnull(tc(list(taxonomy = as_l(taxonomy), language = language)))
+  # res <- cli$get(query = args)
+  # res$raise_for_status()
+  # tt <- res$parse("UTF-8")
+  # tmp <- jsonlite::fromJSON(tt)
+  # tmp <- nmslwr(tmp)
+  # if ("taxonconcepts" %in% names(tmp)) {
+  #   tmp$taxonconcepts <- nmslwr(tmp$taxonconcepts)
+  #   tmp$taxonconcepts$taxonrank <- tolower(tmp$taxonconcepts$taxonrank)
+  # }
+  # return(tmp)
 }
 
 nmslwr <- function(x) {

R/get_pow.R

@@ -278,7 +278,7 @@ as.data.frame.pow <- function(x, ...){
 }
 
 make_pow <- function(x, check=TRUE) {
-  make_generic(x, 'http://powo.science.kew.org/taxon/%s', "pow", check)
+  make_generic(x, 'https://powo.science.kew.org/taxon/%s', "pow", check)
 }
 
 check_pow <- function(x){

R/get_utils.R

@@ -52,7 +52,7 @@ tx_msg_not_found <-
 # url templates for uri attributes of get_* functions
 get_url_templates <- list(
   gbif = "https://www.gbif.org/species/%s",
-  pow = "http://powo.science.kew.org/taxon/%s",
+  pow = "https://powo.science.kew.org/taxon/%s",
   tol = "https://tree.opentreeoflife.org/opentree/argus/ottol@%s",
   tropicos = "http://tropicos.org/Name/%s",
   worms = "http://www.marinespecies.org/aphia.php?p=taxdetails&id=%s",

R/gn_parse.R

@@ -24,7 +24,10 @@ gn_parse <- function(names, ...) {
   assert(names, "character")
   method <- ifelse(length(names) <= 20, "get", "post")
   tmp <- gn_http(method, names, ...)
-  tibble::as_tibble(jsonlite::fromJSON(tmp))
+  out <- jsonlite::fromJSON(tmp)
+  out[paste0('canonical_', colnames(out$canonical))] <- out$canonical
+  out$canonical <- NULL
+  tibble::as_tibble(out)
 }
 
 gn_http <- function(method, names, ...) {
@@ -33,8 +36,8 @@ gn_http <- function(method, names, ...) {
   res <- switch(method,
     get = {
       names <- paste0(names, collapse = "|")
-      args <- list(q = names)
-      cli$get("api", query = args)
+      # args <- list(q = names)
+      cli$get(paste0("api/v1/", names))
     },
     post = {
       cli$headers <- c(cli$headers, list(`Content-Type` = "application/json",

R/gni_details.R

@@ -18,33 +18,35 @@
 #' gni_details(id = 17802847, verbose = TRUE)
 #' }
 gni_details <- function(id, all_records = 1, ...) {
-  calls <- names(sapply(match.call(), deparse))[-1]
-  calls_vec <- "url" %in% calls
-  if (any(calls_vec)) stop("The parameter url has been removed", call. = FALSE)
-
-	url2 <- paste0(gni_base(), "name_strings/", id, ".json")
-	query <- tc(list(all_records = all_records))
-	cli <- crul::HttpClient$new(url2, headers = tx_ual, opts = list(...))
-	tt <- cli$get(query = argsnull(query))
-	tt$raise_for_status()
-  out <- jsonlite::fromJSON(tt$parse("UTF-8"), FALSE)
-	outdf <-
-		dt2df(lapply(out$data, function(x)
-			data.frame(t(c(checknull(x$records[[1]]$created_at),
-				checknull(x$records[[1]]$updated_at),
-				checknull(x$records[[1]]$global_id),
-				checknull(x$records[[1]]$url),
-				checknull(x$records[[1]]$kingdom_id),
-				checknull(x$records[[1]]$original_name_string),
-				checknull(x$records[[1]]$id),
-				checknull(x$records[[1]]$name_rank_id),
-				checknull(x$records[[1]]$name_index_id),
-				checknull(x$records[[1]]$record_hash),
-				checknull(x$records[[1]]$local_id),
-				checknull(x$records[[1]]$nomenclatural_code_id) )))), idcol = FALSE)
-	stats::setNames(outdf, c(
-	  "created_at","updated_at","global_id","url","kingdom_id",
-	  "original_name_string","id","name_rank_id","name_index_id","record_hash",
-	  "local_id","nomenclatural_code_id"
-	))
+  .Defunct(msg = "This function is defunct - See ?`taxize-defunct`")
+
+#   calls <- names(sapply(match.call(), deparse))[-1]
+#   calls_vec <- "url" %in% calls
+#   if (any(calls_vec)) stop("The parameter url has been removed", call. = FALSE)
+# 
+# 	url2 <- paste0(gni_base(), "name_strings/", id, ".json")
+# 	query <- tc(list(all_records = all_records))
+# 	cli <- crul::HttpClient$new(url2, headers = tx_ual, opts = list(...))
+# 	tt <- cli$get(query = argsnull(query))
+# 	tt$raise_for_status()
+#   out <- jsonlite::fromJSON(tt$parse("UTF-8"), FALSE)
+# 	outdf <-
+# 		dt2df(lapply(out$data, function(x)
+# 			data.frame(t(c(checknull(x$records[[1]]$created_at),
+# 				checknull(x$records[[1]]$updated_at),
+# 				checknull(x$records[[1]]$global_id),
+# 				checknull(x$records[[1]]$url),
+# 				checknull(x$records[[1]]$kingdom_id),
+# 				checknull(x$records[[1]]$original_name_string),
+# 				checknull(x$records[[1]]$id),
+# 				checknull(x$records[[1]]$name_rank_id),
+# 				checknull(x$records[[1]]$name_index_id),
+# 				checknull(x$records[[1]]$record_hash),
+# 				checknull(x$records[[1]]$local_id),
+# 				checknull(x$records[[1]]$nomenclatural_code_id) )))), idcol = FALSE)
+# 	stats::setNames(outdf, c(
+# 	  "created_at","updated_at","global_id","url","kingdom_id",
+# 	  "original_name_string","id","name_rank_id","name_index_id","record_hash",
+# 	  "local_id","nomenclatural_code_id"
+# 	))
 }

R/pow_search.R

@@ -11,7 +11,7 @@
 #' @return a list with slots for metadata (`meta`) with list of response
 #' attributes, and data (`data`) with a data.frame of results
 #' @author Scott Chamberlain, 
-#' @references http://powo.science.kew.org/
+#' @references https://powo.science.kew.org/
 #' @family pow
 #' @examples \dontrun{
 #' x <- pow_search(sci_com = "Quercus")
@@ -111,4 +111,4 @@ pow_GET <- function(url, args, ...){
   list(meta = meta, data = json$results)
 }
 
-pow_base <- function() "http://www.plantsoftheworldonline.org"
+pow_base <- function() "https://powo.science.kew.org"

scratch/hanging_vcr_call.R

@@ -0,0 +1,13 @@
+library(vcr)
+library(taxize)
+
+# Works as expected
+children(161994, "itis")
+
+# Hangs indefinitely
+use_cassette("deleteme", {
+  children(161994, "itis")
+})
+
+# Clean up
+file.remove("deleteme.yml")