improving identifiers, DOI

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: dataset
 Title: Create Data Frames that are Easier to Exchange and Reuse
-Version: 0.3.4001
-Date: 2024-12-24
+Version: 0.3.4002
+Date: 2024-12-26
 DOI: 10.32614/CRAN.package.dataset
 Language: en-GB
 Authors@R: 

R/dublincore.R

@@ -82,8 +82,11 @@
 #' applicability of the dataset, or jurisdiction under which the dataset
 #' is relevant. See
 #' \href{https://www.dublincore.org/specifications/dublin-core/dcmi-terms/elements11/coverage/}{DCMI: Coverage}.
-#' @param contributor An entity responsible for making contributions to the dataset. See
-#' \href{https://www.dublincore.org/specifications/dublin-core/dcmi-terms/elements11/contributor/}{DCMI: Contributor}.
+#' @param contributor An entity responsible for making contributions to the dataset.
+#' See
+#' \href{https://www.dublincore.org/specifications/dublin-core/dcmi-terms/elements11/contributor/}{DCMI: Contributor}, and
+#' for possible contribution type, please review
+#' \href{https://www.loc.gov/marc/relators/relaterm.html}{MARC Code List for Relators}.
 #' @param language A language of the dataset. See
 #' \href{https://www.dublincore.org/specifications/dublin-core/dcmi-terms/elements11/language/}{DCMI: Language}.
 #' @importFrom utils person bibentry
@@ -298,7 +301,7 @@ new_dublincore <- function (title,
 
   assertthat::assert_that(all(inherits(creator, "person")))
 
-  dublincore_object <- RefManageR::BibEntry(
+  dublincore_object <- utils::bibentry(
     bibtype = "Misc",
     title = title,
     author = creator,

R/identifier.R

@@ -1,18 +1,23 @@
 #' @title Get/set the Identifier of the object.
-#' @description Add the optional Identifier property as an attribute to an R object.
-#' @details The \code{Identifier} is an unambiguous reference to the resource within a given context.
-#' Recommended practice is to identify the resource by means of a string conforming to an
-#' identification system. Examples include International Standard Book Number (ISBN),
+#' @description Add the optional Identifier property as an attribute to an R
+#' object.
+#' @details The \code{Identifier} is an unambiguous reference to the resource
+#' within a given context. Recommended practice is to identify the resource by
+#' means of a string conforming to an identification system. Examples include
+#' International Standard Book Number (ISBN),
 #' Digital Object Identifier (DOI), and Uniform Resource Name (URN).
 #' Select and identifier scheme from
 #' \href{https://www.ukoln.ac.uk/metadata/dcmi-ieee/identifiers/index.html}{registered URI schemes maintained by IANA}.
 #' More details: \href{https://www.ukoln.ac.uk/metadata/dcmi-ieee/identifiers/}{Guidelines for using resource identifiers in Dublin Core metadata and IEEE LOM}.
 #' Similar to \code{Identifier} in \code{\link{datacite}}.
 #' \href{https://support.datacite.org/docs/datacite-metadata-schema-v44-mandatory-properties#1-identifier}{DataCite 4.4}.\cr
-#' It is not part of the "core" Dublin Core terms, but we always add it to the metadata attributes
-#' of a dataset (in case you use a strict Dublin Core property sheet you can omit it.)
+#' It is not part of the "core" Dublin Core terms, but we always add it to the
+#' metadata attributes of a dataset (in case you use a strict Dublin Core
+#' property sheet you can omit it.)
 #' \href{https://www.dublincore.org/specifications/dublin-core/dcmi-terms/}{Dublin Core metadata terms}.
-#' @param x An R object, such as a data.frame, a tibble, or a data.table.
+#' @param x An \code{\link{dataset_df}} object or a
+#' \code{\link[utils:bibentry]{utils::bibentry}} object, including possibly an
+#' instance of its \code{\link{dublincore}} or \code{\link{datacite}} subclass.
 #' @param value The  \code{Identifier} as a character string.
 #' @param overwrite If the attributes should be overwritten. In case it is set to \code{FALSE},
 #' it gives a message with the current \code{Identifier} property instead of overwriting it.
@@ -27,33 +32,71 @@
 
 #' @export
 identifier <- function(x) {
-  assert_that(is.dataset_df(x),
-              msg = "identifier(x): x must be a dataset object created with dataset_df() or as_dataset_df().")
+  assert_that(inherits(x, "bibentry") | inherits(x, "dataset_df"),
+              msg = "identifier(x): x must be a dataset_df or a bibentry object.")
+
+  if (is.dataset_df(x)) {
+    ds_bibentry <- get_bibentry(x)
+  } else {
+    ds_bibentry <- x
+  }
 
-  ds_bibentry <- get_bibentry(x)
   ds_bibentry$identifier
 }
 
 #' @rdname identifier
 #' @export
 `identifier<-`  <- function(x,  overwrite = TRUE, value) {
-  assert_that(is.dataset_df(x),
-              msg = "identifier(x) <- value: x must be a dataset object created with dataset_df() or as_dataset_df().")
 
-  ds_bibentry <- get_bibentry(x)
+  if (is.numeric(value)) value <- as.character(value)
+
+  assert_that(inherits(x, "bibentry") | inherits(x, "dataset_df"),
+              msg = "identifier(x) <- value: x must be a dataset_df or a bibentry object.")
+
+  assert_that(is.null(value) | inherits(value, "character"),
+              msg="identifier(x) <- value: value must be a named or not named character string of length 1.")
+
+  if (is.dataset_df(x)) {
+    ds_bibentry <- get_bibentry(x)
+  } else {
+    ds_bibentry <- x
+  }
+
   old_identifier <- ds_bibentry$identifier
 
   if (is.null(value)) {
     value <- ":unas"
   }
 
+  is_doi <- function(i) {
+    if(!is.null(names(i))) {
+      if (tolower(names(i)) == "doi")
+        return(TRUE)
+    } else {
+      ifelse(grepl("https://doi.org", i), TRUE, FALSE)
+    }
+  }
+
+
   if ( overwrite | old_identifier %in% c(":unas", ":tba")) {
-    ds_bibentry$identifier <- as.character(value)
-    attr(x, "dataset_bibentry") <- ds_bibentry
+    ds_bibentry$identifier <- value
+    if (is_doi(value)) {
+      doi <- gsub("https://doi.org/", "", value)
+      doi <- gsub("/$", "", doi)
+      ds_bibentry$doi <- doi
+      }
   } else {
     warning ("The dataset has already an identifier: ",
              old_identifier, ".\nYou can overwrite this message with identifier(x, overwrite = TRUE) <- value" )
   }
-  invisible(x)
+
+
+  if(inherits(x, "bibentry")) {
+   ds_bibentry
+    } else {
+      if (is_doi(value)) attr(x, "doi") <- gsub("https://doi.org/", "", value)
+      attr(x, "dataset_bibentry") <- ds_bibentry
+      invisible(x)
+    }
 }
 

README.Rmd

@@ -24,7 +24,7 @@ rlang::check_installed("here")
 [![CRAN_time_from_release](https://www.r-pkg.org/badges/ago/dataset)](https://cran.r-project.org/package=dataset)
 [![Status at rOpenSci Software Peer Review](https://badges.ropensci.org/553_status.svg)](https://github.com/ropensci/software-review/issues/553)
 [![DOI](https://zenodo.org/badge/DOI/10.32614/CRAN.package.dataset.svg)](https://zenodo.org/record/6950435#.YukDAXZBzIU)
-[![devel-version](https://img.shields.io/badge/devel%20version-0.3.4001-blue.svg)](https://github.com/dataobservatory-eu/dataset)
+[![devel-version](https://img.shields.io/badge/devel%20version-0.3.4002-blue.svg)](https://github.com/dataobservatory-eu/dataset)
 [![dataobservatory](https://img.shields.io/badge/ecosystem-dataobservatory.eu-3EA135.svg)](https://dataobservatory.eu/)
 [![Coveralls test coverage](https://coveralls.io/repos/github/dataobservatory-eu/dataset/badge.svg)](https://coveralls.io/r/dataobservatory-eu/dataset?branch=master)
 <!-- badges: end -->

README.md

@@ -14,7 +14,7 @@ WIP](https://www.repostatus.org/badges/latest/wip.svg)](https://www.repostatus.o
 [![Status at rOpenSci Software Peer
 Review](https://badges.ropensci.org/553_status.svg)](https://github.com/ropensci/software-review/issues/553)
 [![DOI](https://zenodo.org/badge/DOI/10.32614/CRAN.package.dataset.svg)](https://zenodo.org/record/6950435#.YukDAXZBzIU)
-[![devel-version](https://img.shields.io/badge/devel%20version-0.3.4001-blue.svg)](https://github.com/dataobservatory-eu/dataset)
+[![devel-version](https://img.shields.io/badge/devel%20version-0.3.4002-blue.svg)](https://github.com/dataobservatory-eu/dataset)
 [![dataobservatory](https://img.shields.io/badge/ecosystem-dataobservatory.eu-3EA135.svg)](https://dataobservatory.eu/)
 [![Coveralls test
 coverage](https://coveralls.io/repos/github/dataobservatory-eu/dataset/badge.svg)](https://coveralls.io/r/dataobservatory-eu/dataset?branch=master)

tests/testthat/test-identifier.R

@@ -1,14 +1,34 @@
+test_that("identifier() works", {
+  a <- dublincore(title="Test",
+                  creator = person("Person", "Unknown"),
+                  identifier = c(DOI="https://doi.org/10.1111/j.1469-1809.1936.tb02137.x")
+  )
+  expect_equal(identifier(a), "https://doi.org/10.1111/j.1469-1809.1936.tb02137.x")
+  identifier(x=a, overwrite = TRUE) <-  "https://doi.org/10.1111/"
+  expect_equal(identifier(a), "https://doi.org/10.1111/")
+  expect_equal(a$doi, "10.1111")
+})
 
-
+test_that("identifier() works", {
+  test_df <- dataset_df(
+    a = defined(1:2, label="test"),
+    dataset_bibentry = dublincore(title="Test",
+                                  creator = person("Person", "Unknown"),
+                                  identifier = c(DOI="https://doi.org/10.1111/j.1469-1809.1936.tb02137.x"))
+  )
+  expect_equal(identifier(test_df), "https://doi.org/10.1111/j.1469-1809.1936.tb02137.x")
+  identifier(test_df) <- NULL
+  expect_equal(identifier(test_df), ":unas")
+  identifier(test_df) <- 1234
+  expect_equal(identifier(test_df), "1234")
+})
 
 test_that("identifier() works", {
   iris_dataset_2 <- iris_dataset
   identifier(iris_dataset_2) <- NULL
   expect_equal(identifier(iris_dataset_2), ":unas")
 })
 
-
-
 test_that("identifier()<- assignment works", {
   iris_dataset_2 <- iris_dataset
   identifier(iris_dataset_2) <- "https://doi.org/10.1111/j.1469-1809.1936.tb02137.x"