fix tests

DESCRIPTION

@@ -3,7 +3,7 @@ Title: Interface to the 'Orcid.org' 'API'
 Description: Client for the 'Orcid.org' 'API' (<https://orcid.org/>).
     Functions included for searching for people, searching by 'DOI',
     and searching by 'Orcid' 'ID'.
-Version: 0.3.8.9320
+Version: 0.3.8.9324
 Authors@R: c(person("Scott", "Chamberlain", role = c("aut", "cre"),
     email = "myrmecocystus@gmail.com", 
     comment = c(ORCID = "0000-0003-1444-9135")))
@@ -18,7 +18,8 @@ Imports:
     fauxpas,
     jsonlite (>= 1.5),
     xml2 (>= 1.1.1),
-    tibble (>= 1.3.0)
+    tibble (>= 1.3.0),
+    data.table
 Suggests:
     testthat,
     knitr,

NAMESPACE

@@ -11,7 +11,6 @@ S3method(identifiers,orcid_doi)
 S3method(identifiers,orcid_id)
 S3method(identifiers,works)
 S3method(print,or_cid)
-S3method(print,works)
 S3method(summary,or_cid)
 export(as.orcid)
 export(browse)

R/auth.R

@@ -41,7 +41,9 @@
 #' orcid_auth(reauth = TRUE)
 #' #orcid_auth(scope = "/read-public", reauth = TRUE)
 #' }
-orcid_auth <- function(scope = "/authenticate", reauth = FALSE) {
+orcid_auth <- function(scope = "/authenticate", reauth = FALSE, 
+  redirect_uri = getOption("rorcid.redirect_uri")) {
+
   if (exists("auth_config", envir = cache) && !reauth) {
     return(cache$auth_config)
   }
@@ -54,6 +56,11 @@ orcid_auth <- function(scope = "/authenticate", reauth = FALSE) {
          call. = FALSE)
   } else  {
     message("no ORCID token found; attempting OAuth authentication\n")
+
+    # use user supplied redirect_uri if supplied
+    if (!is.null(redirect_uri)) rorcid_app$redirect_uri <- redirect_uri
+
+    # do oauth dance
     endpt <- oauth_endpoint(
       authorize = "https://orcid.org/oauth/authorize",
       access = "https://orcid.org/oauth/token")
@@ -62,9 +69,12 @@ orcid_auth <- function(scope = "/authenticate", reauth = FALSE) {
       rorcid_app, 
       scope = scope, 
       cache = !reauth)
+
+    # put token into a string with Bearer prefix
     auth_config <- paste0("Bearer ", 
       tok$credentials$access_token)
   }
+
   cache$auth_config <- auth_config
   auth_config
 }

R/identifiers.R

@@ -10,9 +10,11 @@
 #' that contains any number of the previous objects.
 #' @param type (character) One of doi (default), pmid, pmc, eid, other_id, 
 #' orcid, scopus, researcherid. The orcid's here are for works, not 
-#' individuals.
+#' individuals. This parameter is ignored for classes `orcid` and `orcid_doi`
+#' both of which would go down a rabbit hole of getting works for all 
+#' ORCIDs which could take a while.
 #' @param ... Ignored.
-#' @return A vector of identifiers, or NULL if none found
+#' @return (character) vector of identifiers, or NULL if none found
 #' @examples \dontrun{
 #' # Result of call to works()
 #' x <- works(orcid_id("0000-0001-8607-8025"))
@@ -34,13 +36,11 @@
 #' 
 #' # Result of call to orcid()
 #' x <- orcid(query="carl+boettiger")
-#' identifiers(x, "scopus")
-#' identifiers(x, "orcid")
-#' identifiers(x, "researcherid")
+#' identifiers(x)
 #' 
 #' # Result of call to orcid_doi()
 #' x <- orcid_doi(dois="10.1087/20120404", fuzzy=TRUE)
-#' identifiers(x, "scopus")
+#' identifiers(x)
 #' }
 identifiers <- function(x, type = "doi", ...) {
   UseMethod("identifiers")
@@ -55,12 +55,12 @@ identifiers.default <- function(x, type = "doi", ...) {
 identifiers.works <- function(x, type = "doi", ...) {
   type <- check_type(type)
   if (type == "orcid") {
-    x$data$`source.source-orcid.path`
+    Filter(Negate(is.na), x$`source.source-orcid.path`)
   } else {
-    tmp <- x$data$`work-external-identifiers.work-external-identifier`
+    tmp <- x$`external-ids.external-id`
     unlist(lapply(tmp, function(z) {
-      z[tolower(z$`work-external-identifier-type`) %in% type, 
-        "work-external-identifier-id.value"]
+      z[tolower(z$`external-id-type`) %in% type, 
+        "external-id-value"]
     }))
   }
 }
@@ -74,32 +74,25 @@ identifiers.list <- function(x, type = "doi", ...) {
 #' @export
 #' @rdname identifiers
 identifiers.orcid_id <- function(x, type = "doi", ...) {
-  prof <- attr(x, "profile")
-  tmp <- x$works$`work-external-identifiers.work-external-identifier`
+  # prof <- attr(x, "profile")
+  wks <- works(x)
+  tmp <- wks$`external-ids.external-id`
   unlist(lapply(tmp, function(z) {
-    z[tolower(z$`work-external-identifier-type`) %in% check_type(type), 
-      "work-external-identifier-id.value"]
+    z[tolower(z$`external-id-type`) %in% check_type(type), 
+      "external-id-value"]
   }))
 }
 
 #' @export
 #' @rdname identifiers
 identifiers.orcid <- function(x, type = "doi", ...) {
-  tmp <- suppressWarnings(x$`external-identifiers.external-identifier`)
-  unlist(lapply(tmp, function(z) {
-    z[grep(check_type(type), tolower(z$`external-id-common-name.value`)), 
-      "external-id-reference.value"]
-  }))
+  x$`orcid-identifier.path`
 }
 
 #' @export
 #' @rdname identifiers
 identifiers.orcid_doi <- function(x, type = "doi", ...) {
-  tmp <- x[[1]]$`external-identifiers.external-identifier`
-  unlist(lapply(tmp, function(z) {
-    z[grep(check_type(type), tolower(z$`external-id-common-name.value`)), 
-      "external-id-reference.value"]
-  }))
+  x[[1]]$`orcid-identifier.path`
 }
 
 # helpers ------------------

R/orcid_id.r

@@ -26,7 +26,7 @@
 #' vapply(res, function(x) x[[1]]$name$`family-name`$value, "")
 #' }
 orcid_id <- function(orcid, ...) {
-	stopifnot(is.character(orcid))
+  stopifnot(is.character(orcid))
 	stopifnot(length(orcid) == 1)
 	structure(orcid_person(orcid, ...), class = "orcid_id")
 }

R/orcid_works.R

@@ -3,10 +3,10 @@
 #' @export
 #' @param orcid (character) Orcid identifier(s), of the form 
 #' XXXX-XXXX-XXXX-XXXX. required.
-#' @param put_code (character/integer) one or more put codes. required.
-#' @param format (character) Name of the content-type format. One of 
-#' "application/vnd.orcid+xml; qs=5", "application/orcid+xml; qs=3", 
-#' "application/xml", "application/vnd.orcid+json; qs=4", 
+#' @param put_code (character/integer) one or more put codes. optional
+#' @param format (character) Name of the content-type format. One of
+#' "application/vnd.orcid+xml; qs=5", "application/orcid+xml; qs=3",
+#' "application/xml", "application/vnd.orcid+json; qs=4",
 #' "application/orcid+json; qs=2", "application/json"
 #' "application/vnd.citationstyles.csl+json". optional
 #' @param ... Curl options passed on to [crul::HttpClient()]
@@ -34,8 +34,8 @@
 #'   "application/vnd.citationstyles.csl+json")
 #' }
 orcid_works <- function(orcid, put_code = NULL, format = "application/json", 
-                        ...) {
-  
+  ...) {
+
   if (!is.null(put_code)) {
     if (length(orcid) > 1) {
       stop("if 'put_code' is given, 'orcid' must be length 1")

R/works.R

@@ -1,19 +1,18 @@
 #' Get works data 
 #' 
 #' @export
-#' @param x Input from a call to [orcid_id()] or [as.orcid()]
-#' @param ... Ignored.
-#' @return An S3 object of class `works`
-#' @details The goal of this function is to get a pretty printed quick sense
-#' of the works for 1 or more ORCID's. You can also access the complete
-#' data.frame of results. If an ORCID has works, this function prints the 
-#' titles of the first 10. 
+#' @param x Anything that can be coerced via [as.orcid()], see 
+#' [as.orcid()] for help
+#' @param ... curl options passed on to [crul::HttpClient]
+#' @return A tibble (data.frame)
+#' @details This function gets works using the function [orcid_works]
+#' and packages up the data in a data.frame for easier processing
 #' @examples \dontrun{
 #' out <- works(orcid_id("0000-0002-9341-7985"))
 #' out
-#' out$data
+#' out$type
+#' out$path
 #' 
-#' #works( orcid_id("0000-0003-1620-1408") )
 #' works( orcid_id("0000-0002-1642-628X") )
 #' works( orcid_id("0000-0003-1444-9135") )
 #' works( orcid_id("0000-0003-1419-2405") )
@@ -23,31 +22,17 @@
 #' works(orcid_id(out$`orcid-identifier.path`[8]))
 #' works(orcid_id(out$`orcid-identifier.path`[9]))
 #' works(orcid_id(out$`orcid-identifier.path`[10]))
-#' 
-#' works(as.orcid("0000-0002-1642-628X"))
 #' }
 works <- function(x) {
   tmp <- as.orcid(x)
-  works <- tmp[[1]]$works
-  if (is.null(works) || NROW(works) == 0) {
-    structure(list(data = "None"), class = "works", orcid = names(tmp))
-  } else {
-    structure(list(data = works), class = "works", orcid = names(tmp))
-  }
-}
-
-#' @export
-print.works <- function(x, ..., n = 10) {
-  if (inherits(unclass(x)$data, "character")) {
-    y <- x
+  works <- orcid_works(tmp[[1]]$name$path)
+  if (is.null(works) || NROW(works[[1]]$group) == 0) {
+    dat <- tibble::data_frame()
+    structure(dat, class = c(class(dat), "works"), 
+      orcid = names(tmp))
   } else {
-    y <- x$data$`work-title.title.value`
-  }
-  cat(sprintf('<WORKS> %s', attr(x, "orcid")), sep = "\n\n")
-  cat(sprintf('  Count: %s - First %s', NROW(x$data), n), sep = "\n\n")
-  stopifnot(is.numeric(n))
-  y <- y[1:min(n, length(y))]
-  for (i in seq_along(y)) {
-    cat(sprintf("- %s", y[i]), sep = "\n")
+    dat <- as_dt(works[[1]]$group$`work-summary`)
+    structure(dat, class = c(class(dat), "works"), 
+      orcid = names(tmp))
   }
 }

R/zzz.R

@@ -146,3 +146,8 @@ orcid_putcode_helper <- function(path, orcid, put_code, format, ...) {
   }
 }
 
+as_dt <- function(x) {
+  tibble::as_tibble(data.table::setDF(
+    data.table::rbindlist(x, use.names = TRUE, fill = TRUE)
+  ))
+}