diff --git a/R/bold_search.R b/R/bold_search.R index 373d6c9c..cfffdbeb 100644 --- a/R/bold_search.R +++ b/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) diff --git a/R/eol_dataobjects.R b/R/eol_dataobjects.R index 74459650..ff926b92 100644 --- a/R/eol_dataobjects.R +++ b/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) { diff --git a/R/get_pow.R b/R/get_pow.R index 7495e5a1..454bb5db 100644 --- a/R/get_pow.R +++ b/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){ diff --git a/R/get_utils.R b/R/get_utils.R index cb345883..5471b3e9 100644 --- a/R/get_utils.R +++ b/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", diff --git a/R/gn_parse.R b/R/gn_parse.R index 91412934..4818ada4 100644 --- a/R/gn_parse.R +++ b/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", diff --git a/R/gni_details.R b/R/gni_details.R index fd074c1f..41bde8fa 100644 --- a/R/gni_details.R +++ b/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" +# )) } diff --git a/R/pow_search.R b/R/pow_search.R index 1c3003b8..cc239971 100644 --- a/R/pow_search.R +++ b/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" diff --git a/man/pow_search.Rd b/man/pow_search.Rd index c75c2374..fa741124 100644 --- a/man/pow_search.Rd +++ b/man/pow_search.Rd @@ -52,7 +52,7 @@ asc$data$name } } \references{ -http://powo.science.kew.org/ +https://powo.science.kew.org/ } \seealso{ Other pow: diff --git a/scratch/hanging_vcr_call.R b/scratch/hanging_vcr_call.R new file mode 100644 index 00000000..609c56b5 --- /dev/null +++ b/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") diff --git a/tests/fixtures/apgFamilies.yml b/tests/fixtures/apgFamilies.yml index 9be093ce..2f8fc376 100644 --- a/tests/fixtures/apgFamilies.yml +++ b/tests/fixtures/apgFamilies.yml @@ -6,9 +6,10 @@ http_interactions: encoding: '' string: '' headers: - User-Agent: libcurl/7.54.0 r-curl/3.3 crul/0.7.0.9100 Accept-Encoding: gzip, deflate Accept: application/json, text/xml, application/xml, */* + User-Agent: r-curl/5.2.2 crul/1.5.0 rOpenSci(taxize/0.9.102) + X-USER-AGENT: r-curl/5.2.2 crul/1.5.0 rOpenSci(taxize/0.9.102) response: status: status_code: '200' @@ -18,22 +19,29 @@ http_interactions: status: HTTP/1.1 200 OK content-type: text/html content-encoding: gzip - last-modified: Fri, 28 Dec 2018 20:51:23 GMT + last-modified: Tue, 09 Apr 2024 19:07:58 GMT accept-ranges: bytes - etag: '"80d78b17ef9ed41:0"' + etag: '"ea74423cb18ada1:0"' vary: Accept-Encoding - server: Microsoft-IIS/7.5 + server: Microsoft-IIS/10.0 x-powered-by: ASP.NET - date: Sat, 26 Jan 2019 00:21:33 GMT - content-length: '22481' + date: Wed, 04 Sep 2024 23:38:51 GMT + content-length: '43127' body: - encoding: UTF-8 - string: "\r\n
\r\n\t