New API

.lintr

@@ -1,3 +1,8 @@
 linters: linters_with_defaults() # see vignette("lintr")
 encoding: "UTF-8"
-exclusions: list("data-raw")
+exclusions: list(
+                  "data-raw",
+                  "tests/testthat/test_ci/test-full_cff.R",
+                  "vignettes/cffr.Rmd",
+                  "vignettes/bibtex_cff.Rmd"
+                )

NAMESPACE

@@ -1,7 +1,11 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(as.data.frame,cff)
+S3method(as.person,cff)
 S3method(c,cff)
+S3method(head,cff)
 S3method(print,cff)
+S3method(tail,cff)
 export(as.cff)
 export(cff)
 export(cff_create)
@@ -14,6 +18,10 @@ export(cff_parse_citation)
 export(cff_parse_person)
 export(cff_parse_person_bibtex)
 export(cff_read)
+export(cff_read_bib)
+export(cff_read_cff_citation)
+export(cff_read_citation)
+export(cff_read_description)
 export(cff_schema_definitions_entity)
 export(cff_schema_definitions_person)
 export(cff_schema_definitions_refs)
@@ -33,9 +41,11 @@ importFrom(utils,bibentry)
 importFrom(utils,capture.output)
 importFrom(utils,citation)
 importFrom(utils,download.file)
+importFrom(utils,head)
 importFrom(utils,installed.packages)
 importFrom(utils,modifyList)
 importFrom(utils,packageDescription)
 importFrom(utils,person)
 importFrom(utils,read.csv)
+importFrom(utils,tail)
 importFrom(utils,toBibtex)

NEWS.md

@@ -1,11 +1,33 @@
 # cffr (development version)
 
-## Major changes in the API
+## Major changes
+
+-   Now `class()` of `cff` objects are `c("cff", "list")` instead of single
+    value (`"cff"`).
+
+    ### API
 
 -   The conversion from `cff` to `bibentry` is performed now by a new function
     `cff_to_bibentry()`. Previous names of this function were `cff_to_bibtex()`
     and `cff_extract_to_bibtex()` that are now superseded.
 
+-   Now reading from external files is performed exclusively by `cff_read()` and
+    additionally by the more-specific new functions `cff_read_cff_citation()`,
+    `cff_read_description()`, `cff_read_citation()` and `cff_read_bib()`.
+
+    ### Methods
+
+-   New methods added:
+
+    -   `as.data.frame.cff().`
+    -   `as.person.cff()`, that provides results **only** for CFF keys defined
+        as
+        [person](https://github.com/citation-file-format/citation-file-format/blob/main/schema-guide.md#definitionsperson)
+        or
+        [entity](https://github.com/citation-file-format/citation-file-format/blob/main/schema-guide.md#definitionsentity)
+        (e.g. authors, contacts, editors, publisher).
+    -   `head.cff()`, `tail.cff()`.
+
 ## Changes on bibtex crosswalk
 
 -   **\@inbook** and **\@book** gains a new value on [CFF]{.underline} when

R/assertions.R

@@ -6,10 +6,11 @@ is_email <- function(email) {
     return(FALSE)
   }
 
-  # See https://www.nicebread.de/validating-email-adresses-in-r/
-  x <- grepl("\\<[A-Z0-9._%+-]+@[A-Z0-9.-]+\\.[A-Z]{2,}\\>",
-    as.character(email),
-    ignore.case = TRUE
+  email <- trimws(as.character(email))
+
+  # See CFF  validation schema
+  x <- grepl("^[\\S]+@[\\S]+\\.[\\S]{2,}$", email,
+    ignore.case = TRUE, perl = TRUE
   )
   x
 }
@@ -22,7 +23,7 @@ is_url <- function(url) {
     return(FALSE)
   }
 
-  x <- grepl("^http://|^https://|^ftp://|sftp://", url)
+  x <- grepl("^(https|http|ftp|sftp)://.+", url)
   x
 }
 

R/cff-methods.R

@@ -0,0 +1,127 @@
+#' Print Values
+#'
+#' @noRd
+#' @export
+print.cff <- function(x, ...) {
+  cat(yaml::as.yaml(x))
+}
+
+#' Combine Values into a Vector or List
+#'
+#' @source
+#' Based on `?c.person` \CRANpkg{utils}.
+#'
+#' <https://github.com/wch/r-source/blob/trunk/src/library/utils/R/citation.R>
+#'
+#' @noRd
+#' @export
+c.cff <- function(..., recursive = FALSE) {
+  args <- list(...)
+  args <- lapply(args, unclass)
+  rval <- do.call("c", args)
+  class(rval) <- "cff"
+  rval
+}
+
+
+#' Coerce to a Data Frame
+#'
+#' @noRd
+#' @export
+as.data.frame.cff <- function(x, row.names = NULL, optional = FALSE, ...) {
+  # If the cff is unnamed is a list of persons/references
+  if (is.null(names(x))) {
+    the_df <- cff_list_to_df(x)
+  } else {
+    the_df <- cff_to_df(x)
+  }
+
+  the_df <- as.data.frame(the_df,
+    row.names = row.names, optional = optional,
+    ...
+  )
+
+  return(the_df)
+}
+
+#' Persons
+#'
+#' @noRd
+#' @export
+as.person.cff <- function(x) {
+  # If single enclose on a list
+  is_single <- any(grepl("^name$|^given-names|^family-names", names(x)))
+
+  if (is_single) x <- list(x)
+
+
+  pers <- lapply(x, make_r_person)
+
+  # If not all extracted, malformed, return null
+  if (!all(lengths(pers) > 0)) {
+    return(person())
+  }
+  do.call(c, pers)
+}
+
+#' Head
+#'
+#' @noRd
+#' @export
+head.cff <- function(x, n = 6L, ...) {
+  as.cff(NextMethod())
+}
+
+#' Tail
+#'
+#' @noRd
+#' @export
+tail.cff <- function(x, n = 6L, ...) {
+  as.cff(NextMethod())
+}
+
+make_r_person <- function(x) {
+  if (is.null(names(x))) {
+    return(person())
+  }
+  checknames <- grepl("^name$|given-names|family-names", names(x))
+  if (!isTRUE(any(checknames))) {
+    return(person())
+  }
+  # Prepare list
+  # Family is special key
+  fam1 <- clean_str(x$name)
+  fam2 <- clean_str(
+    paste(
+      clean_str(x$`name-particle`), clean_str(x$`family-names`),
+      clean_str(x$`name-suffix`)
+    )
+  )
+
+  given <- clean_str(x$`given-names`)
+  family <- clean_str(c(fam1, fam2))
+
+  # Make comments
+  x_comments <- x[!names(x) %in% c(
+    "family-names", "given-names",
+    "name-particle", "name-suffix", "email"
+  )]
+
+  x_comments <- lapply(x_comments, clean_str)
+  x_comments <- unlist(x_comments, use.names = TRUE)
+
+  # Prepare ORCID
+  x_comments <- gsub("^https://orcid.org/", "", x_comments)
+  nm <- gsub("orcid", "ORCID", names(x_comments), fixed = TRUE)
+  names(x_comments) <- nm
+
+  pers_list <- list(
+    given = given,
+    family = family,
+    email = clean_str(x$email),
+    comment = x_comments
+  )
+
+
+  do.call(person, pers_list)
+}