#137 support methods for additional titles/descriptions

R/ZenodoRecord.R

@@ -10,6 +10,8 @@
 ZenodoRecord <-  R6Class("ZenodoRecord",
   inherit = zen4RLogger,
   private = list(
+    allowed_additional_title_types = c("alternative-title", "subtitle", "translated-title", "other"),
+    allowed_additional_description_types = c("abstract", "methods", "series-information", "table-of-contents", "technical-info", "other"),
     allowed_role_types = c("contactperson", "datacollector", "datacurator", "datamanager", 
                            "distributor", "editor", "funder", "hostinginstitution", "producer", 
                            "projectleader", "projectmanager", "projectmember", "registrationagency", 
@@ -318,12 +320,149 @@ ZenodoRecord <-  R6Class("ZenodoRecord",
       self$metadata$title <- title
     },
 
+    #' @description Add additional record title
+    #' @param title title free text
+    #' @param type type of title, among following values: alternative-title, subtitle, translated-title, other
+    #' @param lang language id
+    #' @return \code{TRUE} if added, \code{FALSE} otherwise
+    addAdditionalTitle = function(title, type, lang = "eng"){
+      added = FALSE
+      if(!(type %in% private$allowed_additional_title_types)){
+        errMsg = sprintf("Additional title type '%s' incorrect. Possible values are: %s",
+                         type, paste0(private$allowed_additional_title_types, collapse=","))
+        self$ERROR(errMsg)
+        stop(errMsg)
+      }
+
+      if(is.null(self$metadata$additional_titles)) self$metadata$additional_titles = list()
+      ids_df <- data.frame(
+        title = character(0),
+        type = character(0),
+        lang = character(0),
+        stringsAsFactors = FALSE
+      )
+      if(length(self$metadata$additional_titles)>0){
+        ids_df <- do.call("rbind", lapply(self$metadata$additional_titles, function(x){
+          data.frame(
+            title = x$title,
+            type = x$type$id,
+            lang = x$lang$id,
+            stringsAsFactors = FALSE
+          )
+        }))
+      }
+      if(nrow(ids_df[ids_df$title == title & 
+                     ids_df$type == type &
+                     ids_df$lang == lang,])==0){
+        new_title = list(
+          title = title,
+          type = list(id = type),
+          lang = list(id = lang)
+        )
+        self$metadata$additional_titles[[length(self$metadata$additional_titles)+1]] <- new_title
+        added = TRUE
+      }
+      return(added)
+    },
+
+    #' @description Removes additional record title.
+    #' @param title title free text
+    #' @param type type of title, among following values: abstract, methods, 
+    #' series-information, table-of-contents, technical-info, other
+    #' @param lang language id
+    #' @return \code{TRUE} if removed, \code{FALSE} otherwise
+    removeAdditionalTitle = function(title, type, lang = "eng"){
+      removed <- FALSE
+      if(!is.null(self$metadata$additional_titles)){
+        for(i in 1:length(self$metadata$additional_titles)){
+          desc <- self$metadata$additional_titles[[i]]
+          if(desc$title == title &&
+             desc$type$id == type &&
+             desc$lang$id == lang){
+            self$metadata$additional_titles[[i]] <- NULL
+            removed <- TRUE
+            break;
+          }
+        }
+      }
+      return(removed)
+    },
+
     #' @description Set the record description
     #' @param description object of class \code{character}
     setDescription = function(description){
       self$metadata$description <- description
     },
 
+    #' @description Add additional record description
+    #' @param description description free text
+    #' @param type type of description, among following values: abstract, methods, 
+    #' series-information, table-of-contents, technical-info, other
+    #' @param lang language id
+    #' @return \code{TRUE} if added, \code{FALSE} otherwise
+    addAdditionalDescription = function(description, type, lang = "eng"){
+      added = FALSE
+      if(!(type %in% private$allowed_additional_description_types)){
+        errMsg = sprintf("Additional description type '%s' incorrect. Possible values are: %s",
+                         type, paste0(private$allowed_additional_description_types, collapse=","))
+        self$ERROR(errMsg)
+        stop(errMsg)
+      }
+
+      if(is.null(self$metadata$additional_descriptions)) self$metadata$additional_descriptions = list()
+      ids_df <- data.frame(
+        description = character(0),
+        type = character(0),
+        lang = character(0),
+        stringsAsFactors = FALSE
+      )
+      if(length(self$metadata$additional_descriptions)>0){
+        ids_df <- do.call("rbind", lapply(self$metadata$additional_descriptions, function(x){
+          data.frame(
+            description = x$description,
+            type = x$type$id,
+            lang = x$lang$id,
+            stringsAsFactors = FALSE
+          )
+        }))
+      }
+      if(nrow(ids_df[ids_df$description == description & 
+                     ids_df$type == type &
+                     ids_df$lang == lang,])==0){
+        new_desc = list(
+          description = description,
+          type = list(id = type),
+          lang = list(id = lang)
+        )
+        self$metadata$additional_descriptions[[length(self$metadata$additional_descriptions)+1]] <- new_desc
+        added = TRUE
+      }
+      return(added)
+    },
+
+    #' @description Removes additional record description
+    #' @param description description free text
+    #' @param type type of description, among following values: abstract, methods, 
+    #' series-information, table-of-contents, technical-info, other
+    #' @param lang language id
+    #' @return \code{TRUE} if removed, \code{FALSE} otherwise
+    removeAdditionalDescription = function(description, type, lang = "eng"){
+      removed <- FALSE
+      if(!is.null(self$metadata$additional_descriptions)){
+        for(i in 1:length(self$metadata$additional_descriptions)){
+          desc <- self$metadata$additional_descriptions[[i]]
+          if(desc$description == description &&
+             desc$type$id == type &&
+             desc$lang$id == lang){
+            self$metadata$additional_descriptions[[i]] <- NULL
+            removed <- TRUE
+            break;
+          }
+        }
+      }
+      return(removed)
+    },
+
     # PERSON OR ORG
     #---------------------------------------------------------------------------
 

tests/testthat/test_records.R

@@ -21,7 +21,11 @@ test_that("create empty record - with pre-reserved DOI",{
 test_that("create and deposit record",{
   myrec <- ZenodoRecord$new()
   myrec$setTitle("zen4R")
+  expect_true(myrec$addAdditionalTitle("This is an alternative title", type = "alternative-title"))
+  expect_false(myrec$addAdditionalTitle("This is an alternative title", type = "alternative-title"))
   myrec$setDescription("Interface to 'Zenodo' REST API")
+  expect_true(myrec$addAdditionalDescription("This is an abstract", type = "abstract"))
+  expect_false(myrec$addAdditionalDescription("This is an abstract", type = "abstract"))
   myrec$setPublicationDate(Sys.Date())
   myrec$setResourceType("software")
   myrec$addCreator(firstname = "Emmanuel", lastname = "Blondel", role = "datamanager", orcid = "0000-0002-5870-5762")
@@ -105,6 +109,7 @@ test_that("create, deposit and publish record",{
   myrec$addReference("Fulano et al., 2018. Título")
   myrec$setPublisher("CRAN")
   #myrec$addGrant("675680", sandbox = TRUE)
+  expect_true(myrec$addRelatedIdentifier("my-record-id", scheme = "urn", relation_type = "isidenticalto"))
   expect_true(myrec$addRelatedIdentifier("https://github.com/eblondel/zen4R/wiki#41-how-to-install-zen4r-in-r", scheme = "url", relation_type = "haspart"))
   expect_false(myrec$addRelatedIdentifier("https://github.com/eblondel/zen4R/wiki#41-how-to-install-zen4r-in-r", scheme = "url", relation_type = "haspart"))
   expect_true(myrec$addRelatedIdentifier("https://github.com/eblondel/zen4R/wiki#42-connect-to-zenodo-rest-api", scheme = "url", relation_type = "haspart"))