From 649e1e8b5c57e19a0fb2ee38838eec6d019e22da Mon Sep 17 00:00:00 2001
From: eblondel <emmanuel.blondel1@gmail.com>
Date: Wed, 15 May 2024 08:56:11 +0200
Subject: [PATCH] #137 support methods for additional titles/descriptions

---
 R/ZenodoRecord.R              | 139 ++++++++++++++++++++++++++++++++++
 man/ZenodoRecord.Rd           | 103 +++++++++++++++++++++++++
 tests/testthat/test_records.R |   5 ++
 3 files changed, 247 insertions(+)

diff --git a/R/ZenodoRecord.R b/R/ZenodoRecord.R
index 0cf7101..978b887 100644
--- a/R/ZenodoRecord.R
+++ b/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
     #---------------------------------------------------------------------------
     
diff --git a/man/ZenodoRecord.Rd b/man/ZenodoRecord.Rd
index de961dd..66973a7 100644
--- a/man/ZenodoRecord.Rd
+++ b/man/ZenodoRecord.Rd
@@ -88,7 +88,11 @@ Emmanuel Blondel <emmanuel.blondel1@gmail.com>
 \item \href{#method-ZenodoRecord-addDate}{\code{ZenodoRecord$addDate()}}
 \item \href{#method-ZenodoRecord-removeDate}{\code{ZenodoRecord$removeDate()}}
 \item \href{#method-ZenodoRecord-setTitle}{\code{ZenodoRecord$setTitle()}}
+\item \href{#method-ZenodoRecord-addAdditionalTitle}{\code{ZenodoRecord$addAdditionalTitle()}}
+\item \href{#method-ZenodoRecord-removeAdditionalTitle}{\code{ZenodoRecord$removeAdditionalTitle()}}
 \item \href{#method-ZenodoRecord-setDescription}{\code{ZenodoRecord$setDescription()}}
+\item \href{#method-ZenodoRecord-addAdditionalDescription}{\code{ZenodoRecord$addAdditionalDescription()}}
+\item \href{#method-ZenodoRecord-removeAdditionalDescription}{\code{ZenodoRecord$removeAdditionalDescription()}}
 \item \href{#method-ZenodoRecord-addPersonOrOrg}{\code{ZenodoRecord$addPersonOrOrg()}}
 \item \href{#method-ZenodoRecord-removePersonOrOrg}{\code{ZenodoRecord$removePersonOrOrg()}}
 \item \href{#method-ZenodoRecord-addCreator}{\code{ZenodoRecord$addCreator()}}
@@ -531,6 +535,55 @@ Set the record title.
 }
 }
 \if{html}{\out{<hr>}}
+\if{html}{\out{<a id="method-ZenodoRecord-addAdditionalTitle"></a>}}
+\if{latex}{\out{\hypertarget{method-ZenodoRecord-addAdditionalTitle}{}}}
+\subsection{Method \code{addAdditionalTitle()}}{
+Add additional record title
+\subsection{Usage}{
+\if{html}{\out{<div class="r">}}\preformatted{ZenodoRecord$addAdditionalTitle(title, type, lang = "eng")}\if{html}{\out{</div>}}
+}
+
+\subsection{Arguments}{
+\if{html}{\out{<div class="arguments">}}
+\describe{
+\item{\code{title}}{title free text}
+
+\item{\code{type}}{type of title, among following values: alternative-title, subtitle, translated-title, other}
+
+\item{\code{lang}}{language id}
+}
+\if{html}{\out{</div>}}
+}
+\subsection{Returns}{
+\code{TRUE} if added, \code{FALSE} otherwise
+}
+}
+\if{html}{\out{<hr>}}
+\if{html}{\out{<a id="method-ZenodoRecord-removeAdditionalTitle"></a>}}
+\if{latex}{\out{\hypertarget{method-ZenodoRecord-removeAdditionalTitle}{}}}
+\subsection{Method \code{removeAdditionalTitle()}}{
+Removes additional record title.
+\subsection{Usage}{
+\if{html}{\out{<div class="r">}}\preformatted{ZenodoRecord$removeAdditionalTitle(title, type, lang = "eng")}\if{html}{\out{</div>}}
+}
+
+\subsection{Arguments}{
+\if{html}{\out{<div class="arguments">}}
+\describe{
+\item{\code{title}}{title free text}
+
+\item{\code{type}}{type of title, among following values: abstract, methods, 
+series-information, table-of-contents, technical-info, other}
+
+\item{\code{lang}}{language id}
+}
+\if{html}{\out{</div>}}
+}
+\subsection{Returns}{
+\code{TRUE} if removed, \code{FALSE} otherwise
+}
+}
+\if{html}{\out{<hr>}}
 \if{html}{\out{<a id="method-ZenodoRecord-setDescription"></a>}}
 \if{latex}{\out{\hypertarget{method-ZenodoRecord-setDescription}{}}}
 \subsection{Method \code{setDescription()}}{
@@ -548,6 +601,56 @@ Set the record description
 }
 }
 \if{html}{\out{<hr>}}
+\if{html}{\out{<a id="method-ZenodoRecord-addAdditionalDescription"></a>}}
+\if{latex}{\out{\hypertarget{method-ZenodoRecord-addAdditionalDescription}{}}}
+\subsection{Method \code{addAdditionalDescription()}}{
+Add additional record description
+\subsection{Usage}{
+\if{html}{\out{<div class="r">}}\preformatted{ZenodoRecord$addAdditionalDescription(description, type, lang = "eng")}\if{html}{\out{</div>}}
+}
+
+\subsection{Arguments}{
+\if{html}{\out{<div class="arguments">}}
+\describe{
+\item{\code{description}}{description free text}
+
+\item{\code{type}}{type of description, among following values: abstract, methods, 
+series-information, table-of-contents, technical-info, other}
+
+\item{\code{lang}}{language id}
+}
+\if{html}{\out{</div>}}
+}
+\subsection{Returns}{
+\code{TRUE} if added, \code{FALSE} otherwise
+}
+}
+\if{html}{\out{<hr>}}
+\if{html}{\out{<a id="method-ZenodoRecord-removeAdditionalDescription"></a>}}
+\if{latex}{\out{\hypertarget{method-ZenodoRecord-removeAdditionalDescription}{}}}
+\subsection{Method \code{removeAdditionalDescription()}}{
+Removes additional record description
+\subsection{Usage}{
+\if{html}{\out{<div class="r">}}\preformatted{ZenodoRecord$removeAdditionalDescription(description, type, lang = "eng")}\if{html}{\out{</div>}}
+}
+
+\subsection{Arguments}{
+\if{html}{\out{<div class="arguments">}}
+\describe{
+\item{\code{description}}{description free text}
+
+\item{\code{type}}{type of description, among following values: abstract, methods, 
+series-information, table-of-contents, technical-info, other}
+
+\item{\code{lang}}{language id}
+}
+\if{html}{\out{</div>}}
+}
+\subsection{Returns}{
+\code{TRUE} if removed, \code{FALSE} otherwise
+}
+}
+\if{html}{\out{<hr>}}
 \if{html}{\out{<a id="method-ZenodoRecord-addPersonOrOrg"></a>}}
 \if{latex}{\out{\hypertarget{method-ZenodoRecord-addPersonOrOrg}{}}}
 \subsection{Method \code{addPersonOrOrg()}}{
diff --git a/tests/testthat/test_records.R b/tests/testthat/test_records.R
index 163373a..25fd60f 100644
--- a/tests/testthat/test_records.R
+++ b/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"))