#' ZenodoRecord
#' @docType class
#' @export
#' @keywords zenodo record
#' @return Object of \code{\link{R6Class}} for modelling an ZenodoRecord
#' @format \code{\link{R6Class}} object.
#'
#' @author Emmanuel Blondel <emmanuel.blondel1@@gmail.com>
#'
ZenodoRecord <- R6Class("ZenodoRecord",
inherit = zen4RLogger,
private = list(
allowed_role_types = c("contactperson", "datacollector", "datacurator", "datamanager",
"distributor", "editor", "funder", "hostinginstitution", "producer",
"projectleader", "projectmanager", "projectmember", "registrationagency",
"registrationauthority", "relatedperson", "researcher", "researchgroup",
"rightsholder", "supervisor", "sponsor", "workpackageleader",
"other"),
allowed_relations = c("isCitedBy", "cites", "isSupplementTo", "isSupplementedBy", "isContinuedBy", "continues",
"isDescribedBy", "describes", "hasMetadata", "isMetadataFor", "isNewVersionOf", "isPreviousVersionOf",
"isPartOf", "hasPart", "isReferencedBy", "references", "isDocumentedBy", "documents", "isCompiledBy",
"compiles", "isVariantFormOf", "isOriginalFormof", "isIdenticalTo", "isAlternateIdentifier",
"isReviewedBy", "reviews", "isDerivedFrom", "isSourceOf", "requires", "isRequiredBy",
"isObsoletedBy", "obsoletes"),
export_formats = c("BibTeX","CSL","DataCite","DublinCore","DCAT","JSON","JSON-LD","GeoJSON","MARCXML"),
getExportFormatExtension = function(format){
switch(format,
"BibTeX" = "bib",
"CSL" = "json",
"DataCite" ="xml",
"DublinCore" = "xml",
"DCAT" = "rdf",
"JSON" = "json",
"JSON-LD" = "json",
"GeoJSON" = "json",
"MARCXML" = "xml"
)
},
fromList = function(obj){
self$access = obj$access
self$conceptdoi = obj$conceptdoi
self$conceptrecid = obj$conceptrecid
self$created = obj$created
self$doi = obj$doi
self$doi_url = obj$doi_url
self$files = lapply(obj$files, function(file){
list(
filename = if(!is.null(file$filename)) file$filename else file$key,
filesize = if(!is.null(file$filesize)) file$filesize else file$size,
checksum = if(!startsWith(file$checksum, "md5:")) file$checksum else unlist(strsplit(file$checksum, "md5:"))[2],
download = if(!is.null(file$links$download)) file$links$download else file$links$self
)
})
self$id = obj$id
self$recid = obj$recid
self$links = obj$links
self$metadata = obj$metadata
resource_type = self$metadata$resource_type
if(!is.null(resource_type)){
resource_type_id = resource_type$type
if(!is.null(resource_type$subtype)) resource_type_id = paste(resource_type_id, resource_type$subtype,sep="-")
self$metadata$resource_type = list(id = resource_type_id)
}
self$modified = obj$modified
self$owners = obj$owners
self$status = obj$status
self$state = obj$state
self$submitted = obj$submitted
self$revision = obj$revision
if(!is.null(obj$stats)) self$stats = data.frame(obj$stats)
}
),
public = list(
#' @field access access policies
access = list(
record = "public",
files = "public"
),
#' @field conceptdoi record Concept DOI (common to all record versions)
conceptdoi = NULL,
#' @field conceptrecid record concept id
conceptrecid = NULL,
#' @field created record creation date
created = NULL,
#' @field doi record doi
doi = NULL,
#' @field doi_url record doi URL
doi_url = NULL,
#' @field files list of files associated to the record
files = list(),
#' @field id record id
id = NULL,
#' @field links list of links associated to the record
links = list(),
#' @field metadata metadata elements associated to the record
metadata = list(),
#' @field modified record modification date
modified = NULL,
#' @field owners record owners
owners = NULL,
#' @field recid recid
recid = NULL,
#' @field status record status
status = NULL,
#' @field state record state
state = NULL,
#' @field submitted record submission status
submitted = FALSE,
#' @field revision record revision
revision = NULL,
#' @field stats stats
stats = NULL,
#' @description method is used to instantiate a \code{\link{ZenodoRecord}}
#' @param obj an optional list object to create the record
#' @param logger a logger to print log messages. It can be either NULL, "INFO" (with minimum logs),
#' or "DEBUG" (for complete curl http calls logs)
initialize = function(obj = NULL, logger = "INFO"){
super$initialize(logger = logger)
if(!is.null(obj)) private$fromList(obj)
},
#Invenio RDM API new methods
#---------------------------------------------------------------------------
#'@description Set the access policy for record, among values "public" (default) or "restricted"
#'@param access access policy ('public' or 'restricted')
setAccessPolicyRecord = function(access = c("public","resticted")){
self$access$record = access
},
#'@description Set the access policy for files, among values "public" (default) or "restricted"
#'@param access access policy ('public' or 'restricted')
setAccessPolicyFiles = function(access = c("public","resticted")){
self$access$files = access
},
#'@description Set access policy embargo options
#'@param active whether embargo is active or not. Default is \code{FALSE}
#'@param until embargo date, object of class \code{Date}. Default is \code{NULL}. Must be provided if embargo is active
#'@param reason embargo reason, object of class \code{character}. Default is an empty string
setAccessPolicyEmbargo = function(active = FALSE, until = NULL, reason = ""){
if(!is.null(until)) if(!is(until, "Date")) stop("Argument 'until' should be of class 'Date'")
self$access$embargo = list(active = active, until = until, reason = reason)
},
#legacy REST API methods (to be evaluated under Zenodo Invenio RDM migration)
#----------------------------------------------------------------------------
#' @description Set prereserve_doi if \code{TRUE}, \code{FALSE} otherwise to create a record without
#' prereserved DOI by Zenodo. By default, this method will be called to prereserve a DOI assuming
#' the record created doesn't yet handle a DOI. To avoid prereserving a DOI call \code{$prereserveDOI(FALSE)}
#' on your record.
#' @param prereserve whether a DOI has to be pre-reserved by Zenodo
prereserveDOI = function(prereserve){
if(!is(prereserve,"logical")){
stop("The argument should be 'logical' (TRUE/FALSE)")
}
self$metadata$prereserve_doi <- prereserve
},
#' @description Set the DOI. This method can be used if a DOI has been already assigned outside Zenodo.
#' This method will call the method \code{$prereserveDOI(FALSE)}.
#' @param doi DOI to set for the record
setDOI = function(doi){
self$metadata$doi <- doi
self$prereserveDOI(FALSE)
},
#' @description Get the concept (generic) DOI. The concept DOI is a generic DOI common to all versions
#' of a Zenodo record. When a deposit is unsubmitted, this concept DOI is inherited based
#' on the prereserved DOI of the first record version.
#' @return the concept DOI, object of class \code{character}
getConceptDOI = function(){
conceptdoi <- self$conceptdoi
if(is.null(conceptdoi)){
doi <- self$metadata$prereserve_doi
if(!is.null(doi)) {
doi_parts <- unlist(strsplit(doi$doi, "zenodo."))
conceptdoi <- paste0(doi_parts[1], "zenodo.", self$conceptrecid)
}
}
return(conceptdoi)
},
#' @description Get DOI of the first record version.
#' @return the first DOI, object of class \code{character}
getFirstDOI = function(){
versions <- self$getVersions()
return(versions[1,"doi"])
},
#' @description Get DOI of the latest record version.
#' @return the last DOI, object of class \code{character}
getLastDOI = function(){
versions <- self$getVersions()
return(versions[nrow(versions),"doi"])
},
#' @description Get record versions with creation/publication date,
#' version (ordering number) and DOI.
#' @return a \code{data.frame} with the record versions
getVersions = function(){
record_type <- if(self$state == "done") "record" else if(self$state == "unsubmitted") "deposit"
ref_link <- if(record_type == "record") "latest_html" else if(record_type == "deposit") "latest_draft_html"
zenodo_url <- paste0(unlist(strsplit(self$links[[ref_link]], paste0("/", record_type)))[1],"/api")
zenodo <- ZenodoManager$new(url = zenodo_url)
records <- zenodo$getRecords(q = sprintf("conceptrecid:%s", self$conceptrecid), all_versions = T)
versions <- data.frame(
created = character(0),
date = character(0),
version = character(0),
doi = character(0),
stringsAsFactors = FALSE
)
if(length(records)>0){
versions = do.call("rbind", lapply(records, function(version){
return(data.frame(
created = as.POSIXct(version$created, format = "%Y-%m-%dT%H:%M:%OS"),
date = as.Date(version$metadata$publication_date),
version = if(!is.null(version$metadata$version)) version$metadata$version else NA,
doi = version$doi,
stringsAsFactors = FALSE
))
}))
versions <- versions[order(versions$created),]
row.names(versions) <- 1:nrow(versions)
if(all(is.na(versions$version))) versions$version <- 1:nrow(versions)
}
return(versions)
},
#' @description Get record statistics
#' @return statistics as \code{data.frame}
getStats = function(){
return(self$stats)
},
#' @description Set the resource type (mandatory).
#' @param resourceType record resource type
setResourceType = function(resourceType){
zenodo = ZenodoManager$new()
zen_resourcetype <- zenodo$getResourceTypeById(resourceType)
if(is.null(zen_resourcetype)){
errorMsg <- sprintf("Resource type with id '%s' doesn't exist in Zenodo", resourceType)
self$ERROR(errorMsg)
stop(errorMsg)
}
self$metadata$resource_type <- list(id = zen_resourcetype$id)
},
#' @description Set the upload type (mandatory). Deprecated since zen4R 1.0
#' @param uploadType record upload type among the following values: 'publication', 'poster',
#' 'presentation', 'dataset', 'image', 'video', 'software', 'lesson', 'physicalobject', 'other'
setUploadType = function(uploadType){
warnMsg = "Method 'setUploadType' is deprecated, please use 'setResourceType'"
self$WARN(warnMsg)
},
#' @description Set the publication type (mandatory if upload type is 'publication'). Deprecated since zen4R 1.0
#' @param publicationType record publication type among the following values: 'annotationcollection', 'book',
#' 'section', 'conferencepaper', 'datamanagementplan', 'article', 'patent', 'preprint', 'deliverable', 'milestone',
#' 'proposal', 'report', 'softwaredocumentation', 'taxonomictreatment', 'technicalnote', 'thesis', 'workingpaper',
#' 'other'
setPublicationType = function(publicationType){
warnMsg = "Method 'setPublicationType' is deprecated, please use 'setResourceType'"
self$WARN(warnMsg)
},
#' @description Set the image type (mandatory if image type is 'image'). Deprecated since zen4R 1.0
#' @param imageType record publication type among the following values: 'figure','plot',
#' 'drawing','diagram','photo', or 'other'
setImageType = function(imageType){
warnMsg = "Method 'setImageType' is deprecated, please use 'setImageType'"
self$WARN(warnMsg)
},
#' @description Set the publisher
#' @param publisher publisher object of class \code{character}
setPublisher = function(publisher){
self$metadata$publisher = publisher
},
#' @description Set the publication date. For more information on the accepted format,
#' please check https://inveniordm.docs.cern.ch/reference/metadata/#publication-date-1
#' @param publicationDate object of class \code{character}
setPublicationDate = function(publicationDate){
self$metadata$publication_date <- publicationDate
},
#' @description Set the embargo date.
#' @param embargoDate object of class \code{Date}
setEmbargoDate = function(embargoDate){
if(!is(embargoDate,"Date")){
stop("The embargo date should be a 'Date' object")
}
self$metadata$embargo_date <- as(embargoDate, "character")
},
#' @description Set the record title.
#' @param title object of class \code{character}
setTitle = function(title){
self$metadata$title <- title
},
#' @description Set the record description
#' @param description object of class \code{character}
setDescription = function(description){
self$metadata$description <- description
},
#' @description Set the access right.
#' @param accessRight record access right among the following values: 'open','embargoed', 'restricted','closed'
setAccessRight = function(accessRight){
accessRightValues <- c("open","embargoed","restricted","closed")
if(!(accessRight %in% accessRightValues)){
errorMsg <- sprintf("The access right should be among the values [%s",
paste(accessRightValues, collapse=","))
self$ERROR(errorMsg)
stop(errorMsg)
}
self$metadata$access_right <- accessRight
},
#' @description set the access conditions.
#' @param accessConditions object of class \code{character}
setAccessConditions = function(accessConditions){
self$metadata$access_conditions <- accessConditions
},
# PERSON OR ORG
#---------------------------------------------------------------------------
#' @description Add a person or organization for the record. For persons, the approach is to use the \code{firstname} and
#' \code{lastname} arguments, that by default will be concatenated for Zenodo as \code{lastname, firstname}.
#' For organizations, use the \code{name} argument.
#' @param firstname person first name
#' @param lastname person last name
#' @param name organization name
#' @param orcid person or organization ORCID (optional)
#' @param gnd person or organization GND (optional)
#' @param isni person or organization ISNI (optional)
#' @param ror person or organization ROR (optional)
#' @param role role, values among: ContactPerson, DataCollector, DataCurator, DataManager, Distributor, Editor, Funder,
#' HostingInstitution, Producer, ProjectLeader, ProjectManager, ProjectMember, RegistrationAgency, RegistrationAuthority,
#' RelatedPerson, Researcher, ResearchGroup, RightsHolder, Supervisor, Sponsor, WorkPackageLeader, Other
#' @param affiliations person or organization affiliations (optional)
#' @param sandbox Use the Zenodo sandbox infrastructure as basis to control available affiliations. Default is \code{FALSE}
#' @param type type of person or org (creators/contributors)
#' @return \code{TRUE} if added, \code{FALSE} otherwise
#'
#' @note Internal method. Prefer using \code{addCreator} or \code{addContributor}
#'
addPersonOrOrg = function(firstname = NULL, lastname = NULL, name = paste(lastname, firstname, sep = ", "),
orcid = NULL, gnd = NULL, isni = NULL, ror = NULL, role = NULL, affiliations = NULL, sandbox = FALSE,
type){
personOrOrg <- list(
person_or_org = list(
type = if(!is.null(firstname)&&!is.null(lastname)) "personal" else "organizational",
given_name = firstname,
family_name = lastname,
name = name,
identifiers = list()
),
role = NULL,
affiliations = list()
)
#identifiers
if(!is.null(orcid)) personOrOrg$person_or_org$identifiers[[length(personOrOrg$person_or_org$identifiers)+1]] = list(scheme = "orcid", identifier = orcid)
if(!is.null(gnd)) personOrOrg$person_or_org$identifiers[[length(personOrOrg$person_or_org$identifiers)+1]] = list(scheme = "gnd", identifier = gnd)
if(!is.null(isni)) personOrOrg$person_or_org$identifiers[[length(personOrOrg$person_or_org$identifiers)+1]] = list(scheme = "isni", identifier = isni)
if(!is.null(ror)) personOrOrg$person_or_org$identifiers[[length(personOrOrg$person_or_org$identifiers)+1]] = list(scheme = "ror", identifier = ror)
#role
if(!is.null(role)){
if(!(role %in% private$allowed_role_types)){
stop(sprintf("The role type should be one value among values [%s]",
paste(private$allowed_role_types, collapse=",")))
}
personOrOrg$role = role
}
#affiliations
if(!is.null(affiliations)) if(personOrOrg$person_or_org$type == "personal"){
zen = ZenodoManager$new(sandbox = sandbox)
affs = lapply(affiliations, function(affiliation){
zen_affiliation <- zen$getAffiliationById(affiliation)
if(is.null(zen_affiliation)){
warnMsg <- sprintf("Affiliation with id '%s' doesn't exist in Zenodo", affiliation)
self$WARN(errorMsg)
return(NULL)
}
return(list(id = zen_affiliation$id))
})
affs = affs[!sapply(affs,is.null)]
personOrOrg$affiliations = affs
}
if(is.null(self$metadata[[type]])) self$metadata[[type]] <- list()
self$metadata[[type]][[length(self$metadata[[type]])+1]] <- personOrOrg
},
#' @description Removes a person or organization by a property. The \code{by} parameter should be the name
#' of the person or organization property ('name', 'affiliation','orcid','gnd','isni','ror').
#' @param by property used as criterion to remove the person or organization
#' @param property property value used to remove the person or organization
#' @param type type of person or org (creators / contributors)
#' @return \code{TRUE} if removed, \code{FALSE} otherwise
#'
#' @note Internal method. Prefer using \code{removeCreator} or \code{removeContributor}
#'
removePersonOrOrg = function(by, property, type){
removed <- FALSE
for(i in 1:length(self$metadata[[type]])){
personOrOrg <- self$metadata[[type]][[i]]
personOrOrg_map = personOrOrg$person_or_org[names(personOrOrg$person_or_org)!="identifiers"]
if(!is.null(personOrOrg$person_or_org$identifiers)) for(identifier in personOrOrg$person_or_org$identifiers){
personOrOrg_map = c(personOrOrg_map, scheme = identifier$identifier)
names(personOrOrg_map)[names(personOrOrg_map)=="scheme"] = identifier$scheme
}
if(personOrOrg_map[[by]]==property){
self$metadata[[type]][[i]] <- NULL
removed <- TRUE
}
}
return(removed)
},
# CREATORS
#---------------------------------------------------------------------------
#' @description Add a creator for the record. For persons, the approach is to use the \code{firstname} and
#' \code{lastname} arguments, that by default will be concatenated for Zenodo as \code{lastname, firstname}.
#' For organizations, use the \code{name} argument.
#' @param firstname person first name
#' @param lastname person last name
#' @param name organization name
#' @param orcid creator ORCID (optional)
#' @param gnd creator GND (optional)
#' @param isni creator ISNI (optional)
#' @param ror creator ROR (optional)
#' @param role role, values among: ContactPerson, DataCollector, DataCurator, DataManager, Distributor, Editor, Funder,
#' HostingInstitution, Producer, ProjectLeader, ProjectManager, ProjectMember, RegistrationAgency, RegistrationAuthority,
#' RelatedPerson, Researcher, ResearchGroup, RightsHolder, Supervisor, Sponsor, WorkPackageLeader, Other
#' @param affiliations creator affiliations (optional)
#' @param sandbox Use the Zenodo sandbox infrastructure as basis to control available affiliations. Default is \code{FALSE}
#' @return \code{TRUE} if added, \code{FALSE} otherwise
addCreator = function(firstname = NULL, lastname = NULL, name = paste(lastname, firstname, sep = ", "),
orcid = NULL, gnd = NULL, isni = NULL, ror = NULL, role = NULL, affiliations = NULL, sandbox = FALSE){
self$addPersonOrOrg(firstname = firstname, lastname = lastname, name = name,
orcid = orcid, gnd = gnd, isni = isni, ror = ror, role = role, affiliations = affiliations, sandbox = sandbox,
type = "creators")
},
#' @description Removes a creator by name.
#' @param name creator name
#' @return \code{TRUE} if removed, \code{FALSE} otherwise
removeCreatorByName = function(name){
return(self$removePersonOrOrg(by = "name", name, type = "creators"))
},
#' @description Removes a creator by affiliation.
#' @param affiliation creator affiliation
#' @return \code{TRUE} if removed, \code{FALSE} otherwise
removeCreatorByAffiliation = function(affiliation){
return(self$removePersonOrOrg(by = "affiliation", affiliation, type = "creators"))
},
#' @description Removes a creator by ORCID.
#' @param orcid creator ORCID
#' @return \code{TRUE} if removed, \code{FALSE} otherwise
removeCreatorByORCID = function(orcid){
return(self$removePersonOrOrg(by = "orcid", orcid, type = "creators"))
},
#' @description Removes a creator by GND.
#' @param gnd creator GND
#' @return \code{TRUE} if removed, \code{FALSE} otherwise
removeCreatorByGND = function(gnd){
return(self$removePersonOrOrg(by = "gnd", gnd, type = "creators"))
},
#' @description Removes a creator by ISNI.
#' @param isni creator ISNI
#' @return \code{TRUE} if removed, \code{FALSE} otherwise
removeCreatorByISNI = function(isni){
return(self$removePersonOrOrg(by = "isni", isni, type = "creators"))
},
#' @description Removes a creator by ROR.
#' @param ror creator ROR
#' @return \code{TRUE} if removed, \code{FALSE} otherwise
removeCreatorByROR = function(ror){
return(self$removePersonOrOrg(by = "ror", ror, type = "creators"))
},
# CONTRIBUTORS
#---------------------------------------------------------------------------
#' @description Add a contributor for the record. For persons, the approach is to use the \code{firstname} and
#' \code{lastname} arguments, that by default will be concatenated for Zenodo as \code{lastname, firstname}.
#' For organizations, use the \code{name} argument.
#' @param firstname person first name
#' @param lastname person last name
#' @param name organization name
#' @param orcid contributor ORCID (optional)
#' @param gnd contributor GND (optional)
#' @param isni contributor ISNI (optional)
#' @param ror contributor ROR (optional)
#' @param role role, values among: ContactPerson, DataCollector, DataCurator, DataManager, Distributor, Editor, Funder,
#' HostingInstitution, Producer, ProjectLeader, ProjectManager, ProjectMember, RegistrationAgency, RegistrationAuthority,
#' RelatedPerson, Researcher, ResearchGroup, RightsHolder, Supervisor, Sponsor, WorkPackageLeader, Other
#' @param affiliations contributor affiliations (optional)
#' @param sandbox Use the Zenodo sandbox infrastructure as basis to control available affiliations. Default is \code{FALSE}
#' @return \code{TRUE} if added, \code{FALSE} otherwise
addContributor = function(firstname = NULL, lastname = NULL, name = paste(lastname, firstname, sep = ", "),
orcid = NULL, gnd = NULL, isni = NULL, ror = NULL, role = NULL, affiliations = NULL, sandbox = FALSE){
self$addPersonOrOrg(firstname = firstname, lastname = lastname, name = name,
orcid = orcid, gnd = gnd, isni = isni, ror = ror, role = role, affiliations = affiliations, sandbox = sandbox,
type = "contributors")
},
#' @description Removes a contributor by name.
#' @param name contributor name
#' @return \code{TRUE} if removed, \code{FALSE} otherwise
removeContributorByName = function(name){
return(self$removePersonOrOrg(by = "name", name, type = "contributors"))
},
#' @description Removes a contributor by affiliation.
#' @param affiliation contributor affiliation
#' @return \code{TRUE} if removed, \code{FALSE} otherwise
removeContributorByAffiliation = function(affiliation){
return(self$removePersonOrOrg(by = "affiliation", affiliation, type = "contributors"))
},
#' @description Removes a contributor by ORCID.
#' @param orcid contributor ORCID
#' @return \code{TRUE} if removed, \code{FALSE} otherwise
removeContributorByORCID = function(orcid){
return(self$removePersonOrOrg(by = "orcid", orcid, type = "contributors"))
},
#' @description Removes a contributor by GND.
#' @param gnd contributor GND
#' @return \code{TRUE} if removed, \code{FALSE} otherwise
removeContributorByGND = function(gnd){
return(self$removePersonOrOrg(by = "gnd", gnd, type = "contributors"))
},
#' @description Removes a contributor by ISNI.
#' @param isni contributor ISNI
#' @return \code{TRUE} if removed, \code{FALSE} otherwise
removeContributorByISNI = function(isni){
return(self$removePersonOrOrg(by = "isni", isni, type = "contributors"))
},
#' @description Removes a contributor by ROR.
#' @param ror contributor ROR
#' @return \code{TRUE} if removed, \code{FALSE} otherwise
removeContributorByROR = function(ror){
return(self$removePersonOrOrg(by = "ror", ror, type = "contributors"))
},
#' @description Set license. The license should be set with the Zenodo id of the license. If not
#' recognized by Zenodo, the function will return an error. The list of licenses can
#' fetched with the \code{ZenodoManager} and the function \code{$getLicenses()}.
#' @param licenseId a license Id
#' @param sandbox Use the Zenodo sandbox infrastructure as basis to control available licenses. Default is \code{FALSE}
setLicense = function(licenseId, sandbox = FALSE){
zen <- ZenodoManager$new(sandbox = sandbox)
zen_license <- zen$getLicenseById(licenseId)
if(!is.null(zen_license$status)){
errorMsg <- sprintf("License with id '%s' doesn't exist in Zenodo", licenseId)
self$ERROR(errorMsg)
stop(errorMsg)
}
self$metadata$license <- licenseId
},
#' @description Set record version.
#' @param version the record version to set
setVersion = function(version){
self$metadata$version <- version
},
#' @description Adds a language.
#' @param language ISO 639-2 or 639-3 code
addLanguage = function(language){
zenodo = ZenodoManager$new()
zen_language = zenodo$getLanguageById(language)
if(is.null(zen_language)){
errorMsg <- sprintf("Language with id '%s' doesn't exist in Zenodo", language)
self$ERROR(errorMsg)
stop(errorMsg)
}
self$metadata$languages[[length(self$metadata$languages)+1]] <- list(id = language)
},
#' @description Set the language
#' @param language ISO 639-2 or 639-3 code
setLanguage = function(language){
warnMsg = "Method 'setLanguage' is deprecated, please use 'addLanguage'"
self$WARN(warnMsg)
self$addLanguage(language)
},
#' @description Adds a related identifier with a given relation.
#' @param relation relation type among following values: isCitedBy, cites, isSupplementTo, isSupplementedBy,
#' isContinuedBy, continues, isDescribedBy, describes, hasMetadata, isMetadataFor, isNewVersionOf,
#' isPreviousVersionOf, isPartOf, hasPart, isReferencedBy, references, isDocumentedBy, documents,
#' isCompiledBy, compiles, isVariantFormOf, isOriginalFormof, isIdenticalTo, isAlternateIdentifier,
#' isReviewedBy, reviews, isDerivedFrom, isSourceOf, requires, isRequiredBy, isObsoletedBy, obsoletes
#' @param identifier resource identifier
#' @param resource_type optional resource type, value among possible publication types, image types, or upload
#' types (except 'publication' and 'image' for which a publication/image has to be specified). Default is \code{NULL}
addRelatedIdentifier = function(relation, identifier, resource_type = NULL){
if(!(relation %in% private$allowed_relations)){
stop(sprintf("Relation '%s' incorrect. Use a value among the following [%s]",
relation, paste(private$allowed_relations, collapse=",")))
}
added <- FALSE
if(is.null(self$metadata$related_identifiers)) self$metadata$related_identifiers <- list()
ids_df <- data.frame(relation = character(0), identifier = character(0), stringsAsFactors = FALSE)
if(length(self$metadata$related_identifiers)>0){
ids_df <- do.call("rbind", lapply(self$metadata$related_identifiers, function(x){
data.frame(relation = x$relation, identifier = x$identifier, stringsAsFactors = FALSE)
}))
}
if(nrow(ids_df[ids_df$relation == relation & ids_df$identifier == identifier,])==0){
new_rel <- list(relation = relation, identifier = identifier)
if(!is.null(resource_type)) {
allowed_resource_types <- c(private$allowed_upload_types, private$allowed_publication_types, private$allowed_image_types)
allowed_resource_types <- allowed_resource_types[!(allowed_resource_types %in% c("publication", "image"))]
if(!(resource_type %in% allowed_resource_types)){
stop(sprintf("Relation resource type '%s' incorrect. Use a value among the following [%s]",
relation, paste(allowed_resource_types, collapse=",")))
}
resource_type_prefix <- ""
if(resource_type %in% private$allowed_publication_types)resource_type_prefix = "publication-"
if(resource_type %in% private$allowed_image_types)resource_type_prefix = "image-"
new_rel$resource_type <- paste0(resource_type_prefix, resource_type)
}
self$metadata$related_identifiers[[length(self$metadata$related_identifiers)+1]] <- new_rel
added <- TRUE
}
return(added)
},
#' @description Removes a related identifier with a given relation.
#' @param relation relation type among following values: isCitedBy, cites, isSupplementTo, isSupplementedBy,
#' isContinuedBy, continues, isDescribedBy, describes, hasMetadata, isMetadataFor, isNewVersionOf,
#' isPreviousVersionOf, isPartOf, hasPart, isReferencedBy, references, isDocumentedBy, documents,
#' isCompiledBy, compiles, isVariantFormOf, isOriginalFormof, isIdenticalTo, isAlternateIdentifier,
#' isReviewedBy, reviews, isDerivedFrom, isSourceOf, requires, isRequiredBy, isObsoletedBy, obsoletes
#' @param identifier resource identifier
removeRelatedIdentifier = function(relation, identifier){
if(!(relation %in% private$allowed_relations)){
stop(sprintf("Relation '%s' incorrect. Use a value among the following [%s]",
relation, paste(private$allowed_relations, collapse=",")))
}
removed <- FALSE
if(!is.null(self$metadata$related_identifiers)){
for(i in 1:length(self$metadata$related_identifiers)){
related_id <- self$metadata$related_identifiers[[i]]
if(related_id$relation == relation & related_id$identifier == identifier){
self$metadata$related_identifiers[[i]] <- NULL
removed <- TRUE
break;
}
}
}
return(removed)
},
#' @description Set references
#' @param references a vector or list of references to set for the record
setReferences = function(references){
if(is.null(self$metadata$references)) self$metadata$references <- list()
for(reference in references){
self$addReference(reference)
}
},
#' @description Add a reference
#' @param reference the reference to add
#' @return \code{TRUE} if added, \code{FALSE} otherwise
addReference = function(reference){
added <- FALSE
if(is.null(self$metadata$references)) self$metadata$references <- list()
if(!(reference %in% self$metadata$references)){
self$metadata$references[[length(self$metadata$references)+1]] <- reference
added <- TRUE
}
return(added)
},
#' @description Remove a reference
#' @param reference the reference to remove
#' @return \code{TRUE} if removed, \code{FALSE} otherwise
removeReference = function(reference){
removed <- FALSE
if(!is.null(self$metadata$references)){
for(i in 1:length(self$metadata$references)){
ref <- self$metadata$references[[i]]
if(ref == reference){
self$metadata$references[[i]] <- NULL
removed <- TRUE
break;
}
}
}
return(removed)
},
#' @description Set keywords
#' @param keywords a vector or list of keywords to set for the record
setKeywords = function(keywords){
if(is.null(self$metadata$keywords)) self$metadata$keywords <- list()
for(keyword in keywords){
self$addKeyword(keyword)
}
},
#' @description Add a keyword
#' @param keyword the keyword to add
#' @return \code{TRUE} if added, \code{FALSE} otherwise
addKeyword = function(keyword){
added <- FALSE
if(is.null(self$metadata$keywords)) self$metadata$keywords <- list()
if(!(keyword %in% self$metadata$keywords)){
self$metadata$keywords[[length(self$metadata$keywords)+1]] <- keyword
added <- TRUE
}
return(added)
},
#' @description Remove a keyword
#' @param keyword the keyword to remove
#' @return \code{TRUE} if removed, \code{FALSE} otherwise
removeKeyword = function(keyword){
removed <- FALSE
if(!is.null(self$metadata$keywords)){
for(i in 1:length(self$metadata$keywords)){
kwd <- self$metadata$keywords[[i]]
if(kwd == keyword){
self$metadata$keywords[[i]] <- NULL
removed <- TRUE
break;
}
}
}
return(removed)
},
#' @description Adds a subject given a term and identifier
#' @param term subject term
#' @param identifier subject identifier
addSubject = function(term, identifier){
subject <- list(term = term, identifier = identifier)
if(is.null(self$metadata$subjects)) self$metadata$subjects <- list()
self$metadata$subjects[[length(self$metadata$subjects)+1]] <- subject
},
#' @description Removes subject(s) by a property. The \code{by} parameter should be the name
#' of the subject property ('term' or 'identifier').
#' @param by property used as criterion to remove subjects
#' @param property property value used to remove subjects
#' @return \code{TRUE} if at least one subject is removed, \code{FALSE} otherwise.
removeSubject = function(by, property){
removed <- FALSE
for(i in 1:length(self$metadata$subjects)){
subject <- self$metadata$subjects[[i]]
if(subject[[by]]==property){
self$metadata$subjects[[i]] <- NULL
removed <- TRUE
}
}
return(removed)
},
#' @description Removes subject(s) by term.
#' @param term the term to use to remove subject(s)
#' @return \code{TRUE} if at least one subject is removed, \code{FALSE} otherwise.
removeSubjectByTerm = function(term){
return(self$removeSubject(by = "term", property = term))
},
#' @description Removes subject(s) by identifier
#' @param identifier the identifier to use to remove subject(s)
#' @return \code{TRUE} if at least one subject is removed, \code{FALSE} otherwise.
removeSubjectByIdentifier = function(identifier){
return(self$removeSubject(by = "identifier", property = identifier))
},
#' @description Set notes. HTML is not allowed
#' @param notes object of class \code{character}
setNotes = function(notes){
self$metadata$notes <- notes
},
#' @description Set a vector of character strings identifying communities
#' @param communities a vector or list of communities. Values should among known communities. The list of communities can
#' fetched with the \code{ZenodoManager} and the function \code{$getCommunities()}. Each community should be set with
#' the Zenodo id of the community. If not recognized by Zenodo, the function will return an error.
#' @param sandbox Use the Zenodo sandbox infrastructure as basis to control available communities. Default is \code{FALSE}
setCommunities = function(communities, sandbox = FALSE){
if(is.null(self$metadata$communities)) self$metadata$communities <- list()
for(community in communities){
self$addCommunity(community, sandbox = sandbox)
}
},
#' @description Adds a community to the record metadata.
#' @param community community to add. The community should be set with the Zenodo id of the community.
#' If not recognized by Zenodo, the function will return an error. The list of communities can fetched
#' with the \code{ZenodoManager} and the function \code{$getCommunities()}.
#' @param sandbox Use the Zenodo sandbox infrastructure as basis to control available communities. Default is \code{FALSE}
#' @return \code{TRUE} if added, \code{FALSE} otherwise
addCommunity = function(community, sandbox = FALSE){
added <- FALSE
zen <- ZenodoManager$new(sandbox = sandbox)
if(is.null(self$metadata$communities)) self$metadata$communities <- list()
if(!(community %in% sapply(self$metadata$communities, function(x){x$identifier}))){
zen_community <- zen$getCommunityById(community)
if(is.null(zen_community)){
errorMsg <- sprintf("Community with id '%s' doesn't exist in Zenodo", community)
self$ERROR(errorMsg)
stop(errorMsg)
}
self$metadata$communities[[length(self$metadata$communities)+1]] <- list(identifier = community)
added <- TRUE
}
return(added)
},
#' @description Removes a community from the record metadata.
#' @param community community to remove. The community should be set with the Zenodo id of the community.
#' @return \code{TRUE} if removed, \code{FALSE} otherwise
removeCommunity = function(community){
removed <- FALSE
if(!is.null(self$metadata$communities)){
for(i in 1:length(self$metadata$communities)){
com <- self$metadata$communities[[i]]
if(com == community){
self$metadata$communities[[i]] <- NULL
removed <- TRUE
break;
}
}
}
return(removed)
},
#' @description Set a vector of character strings identifying grants
#' @param grants a vector or list of grants Values should among known grants The list of grants can
#' fetched with the \code{ZenodoManager} and the function \code{$getGrants()}. Each grant should be set with
#' the Zenodo id of the grant If not recognized by Zenodo, the function will raise a warning only.
#' @param sandbox Use the Zenodo sandbox infrastructure as basis to control available grants. Default is \code{FALSE}
setGrants = function(grants, sandbox = FALSE){
if(is.null(self$metadata$grants)) self$metadata$grants <- list()
for(grant in grants){
self$addGrant(grant, sandbox = sandbox)
}
},
#' @description Adds a grant to the record metadata.
#' @param grant grant to add. The grant should be set with the id of the grant. If not
#' recognized by Zenodo, the function will return an warning only. The list of grants can
#' fetched with the \code{ZenodoManager} and the function \code{$getGrants()}.
#' @param sandbox Use the Zenodo sandbox infrastructure as basis to control available grants. Default is \code{FALSE}
#' @return \code{TRUE} if added, \code{FALSE} otherwise
addGrant = function(grant, sandbox = FALSE){
added <- FALSE
zen <- ZenodoManager$new(sandbox = sandbox)
if(is.null(self$metadata$grants)) self$metadata$grants <- list()
if(!(grant %in% self$metadata$grants)){
if(regexpr("::", grant)>0){
zen_grant <- zen$getGrantById(grant)
if(is.null(zen_grant)){
warnMsg <- sprintf("Grant with id '%s' doesn't exist in Zenodo", grant)
self$WARN(warnMsg)
}
}
self$metadata$grants[[length(self$metadata$grants)+1]] <- list(id = grant)
added <- TRUE
}
return(added)
},
#' @description Removes a grant from the record metadata.
#' @param grant grant to remove. The grant should be set with the Zenodo id of the grant
#' @return \code{TRUE} if removed, \code{FALSE} otherwise
removeGrant = function(grant){
removed <- FALSE
if(!is.null(self$metadata$grants)){
for(i in 1:length(self$metadata$grants)){
grt <- self$metadata$grants[[i]]
if(grt == grant){
self$metadata$grants[[i]] <- NULL
removed <- TRUE
break;
}
}
}
return(removed)
},
#' @description Set Journal title to the record metadata
#' @param title a title, object of class \code{character}
setJournalTitle = function(title){
self$metadata$journal_title <- title
},
#' @description Set Journal volume to the record metadata
#' @param volume a volume
setJournalVolume = function(volume){
self$metadata$journal_volume <- volume
},
#' @description Set Journal issue to the record metadata
#' @param issue an issue
setJournalIssue = function(issue){
self$metadata$journal_issue <- issue
},
#' @description Set Journal pages to the record metadata
#' @param pages number of pages
setJournalPages = function(pages){
self$metadata$journal_pages <- pages
},
#' @description Set conference title to the record metadata
#' @param title conference title, object of class \code{character}
setConferenceTitle = function(title){
self$metadata$conference_title <- title
},
#' @description Set conference acronym to the record metadata
#' @param acronym conference acronym, object of class \code{character}
setConferenceAcronym = function(acronym){
self$metadata$conference_acronym <- acronym
},
#' @description Set conference dates to the record metadata
#' @param dates conference dates, object of class \code{character}
setConferenceDates = function(dates){
self$metadata$conference_dates <- dates
},
#' @description Set conference place to the record metadata
#' @param place conference place, object of class \code{character}
setConferencePlace = function(place){
self$metadata$conference_place <- place
},
#' @description Set conference url to the record metadata
#' @param url conference url, object of class \code{character}
setConferenceUrl = function(url){
self$metadata$conference_url <- url
},
#' @description Set conference session to the record metadata
#' @param session conference session, object of class \code{character}
setConferenceSession = function(session){
self$metadata$conference_session <- session
},
#' @description Set conference session part to the record metadata
#' @param part conference session part, object of class \code{character}
setConferenceSessionPart = function(part){
self$metadata$conference_session_part <- part
},
#' @description Set imprint publisher to the record metadata
#' @param publisher the publisher, object of class \code{character}
setImprintPublisher = function(publisher){
self$metadata$imprint_publisher <- publisher
},
#' @description Set imprint ISBN to the record metadata
#' @param isbn the ISBN, object of class \code{character}
setImprintISBN = function(isbn){
self$metadata$imprint_isbn <- isbn
},
#' @description Set imprint place to the record metadata
#' @param place the place, object of class \code{character}
setImprintPlace = function(place){
self$metadata$imprint_place <- place
},
#' @description Set title to which record is part of
#' @param title the title, object of class \code{character}
setPartofTitle = function(title){
self$metadata$partof_title <- title
},
#' @description Set pages to which record is part of
#' @param pages the pages, object of class \code{character}
setPartofPages = function(pages){
self$metadata$partof_pages <- pages
},
#' @description Set thesis university
#' @param university the university, object of class \code{character}
setThesisUniversity = function(university){
self$metadata_thesis_university <- university
},
#' @description Adds thesis supervisor
#' @param firstname supervisor first name
#' @param lastname supervisor last name
#' @param affiliation supervisor affiliation (optional)
#' @param orcid supervisor ORCID (optional)
#' @param gnd supervisor GND (optional)
addThesisSupervisor = function(firstname, lastname, affiliation = NULL, orcid = NULL, gnd = NULL){
supervisor <- list(name = paste(lastname, firstname, sep=", "))
if(!is.null(affiliation)) supervisor <- c(supervisor, affiliation = affiliation)
if(!is.null(orcid)) supervisor <- c(supervisor, orcid = orcid)
if(!is.null(gnd)) supervisor <- c(supervisor, gnd = gnd)
if(is.null(self$metadata$thesis_supervisors)) self$metadata$thesis_supervisors <- list()
self$metadata$thesis_supervisors[[length(self$metadata$thesis_supervisors)+1]] <- supervisor
},
#' @description Removes a thesis supervisor by a property. The \code{by} parameter should be the name
#' of the thesis supervisor property ('name' - in the form 'lastname, firstname', 'affiliation',
#' 'orcid' or 'gnd').
#' @param by property used as criterion to remove the thesis supervisor
#' @param property property value used to remove the thesis supervisor
#' @return \code{TRUE} if removed, \code{FALSE} otherwise
removeThesisSupervisor = function(by,property){
removed <- FALSE
for(i in 1:length(self$metadata$thesis_supervisors)){
supervisor <- self$metadata$thesis_supervisors[[i]]
if(supervisor[[by]]==property){
self$metadata$thesis_supervisors[[i]] <- NULL
removed <- TRUE
}
}
return(removed)
},
#' @description Removes a thesis supervisor by name.
#' @param name thesis supervisor name
#' @return \code{TRUE} if removed, \code{FALSE} otherwise
removeThesisSupervisorByName = function(name){
return(self$removeThesisSupervisor(by = "name", name))
},
#' @description Removes a thesis supervisor by affiliation
#' @param affiliation thesis supervisor affiliation
#' @return \code{TRUE} if removed, \code{FALSE} otherwise
removeThesisSupervisorByAffiliation = function(affiliation){
return(self$removeThesisSupervisor(by = "affiliation", affiliation))
},
#' @description Removes a thesis supervisor by ORCID
#' @param orcid thesis supervisor ORCID
#' @return \code{TRUE} if removed, \code{FALSE} otherwise
removeThesisSupervisorByORCID = function(orcid){
return(self$removeThesisSupervisor(by = "orcid", orcid))
},
#' @description Removes a thesis supervisor by GND
#' @param gnd thesis supervisor GND
#' @return \code{TRUE} if removed, \code{FALSE} otherwise
removeThesisSupervisorByGND = function(gnd){
return(self$removeThesisSupervisor(by = "gnd", gnd))
},
#' @description Adds a location to the record metadata.
#' @param place place (required)
#' @param description description
#' @param lat latitude
#' @param lon longitude
addLocation = function(place, description = NULL, lat = NULL, lon = NULL){
if(is.null(self$metadata$locations)) self$metadata$locations <- list()
self$metadata$locations[[length(self$metadata$locations)+1]] <- list(place = place, description = description, lat = lat, lon = lon)
},
#' @description Removes a grant from the record metadata.
#' @param place place (required)
#' @return \code{TRUE} if removed, \code{FALSE} otherwise
removeLocation = function(place){
removed <- FALSE
if(!is.null(self$metadata$locations)){
for(i in 1:length(self$metadata$locations)){
loc <- self$metadata$locations[[i]]
if(loc$place == place){
self$metadata$locations[[i]] <- NULL
removed <- TRUE
break;
}
}
}
return(removed)
},
#' @description Exports record to a file by format.
#' @param format the export format to use. Possibles values are: BibTeX, CSL, DataCite, DublinCore, DCAT,
#' JSON, JSON-LD, GeoJSON, MARCXML
#' @param filename the target filename (without extension)
#' @param append_format wether format name has to be appended to the filename. Default is \code{TRUE} (for
#' backward compatibility reasons). Set it to \code{FALSE} if you want to use only the \code{filename}.
#' @return the writen file name (with extension)
exportAs = function(format, filename, append_format = TRUE){
zenodo_url <- self$links$record_html
if(is.null(zenodo_url)) zenodo_url <- self$links$self_html
if(is.null(zenodo_url)){
stop("Ups, this record seems a draft, can't export metadata until it is published!")
}
metadata_export_url <- switch(format,
"BibTeX" = paste0(zenodo_url,"/export/bibtex"),
"CSL" = paste0(zenodo_url,"/export/csl"),
"DataCite" = paste0(zenodo_url,"/export/datacite-xml"),
"DublinCore" = paste0(zenodo_url,"/export/dublincore"),
"DCAT" = paste0(zenodo_url,"/export/dcat-ap"),
"JSON" = paste0(zenodo_url,"/export/json"),
"JSON-LD" = paste0(zenodo_url,"/export/json-ld"),
"GeoJSON" = paste0(zenodo_url,"/export/geojson"),
"MARCXML" = paste0(zenodo_url,"/export/xm"),
NULL
)
if(is.null(metadata_export_url)){
stop(sprintf("Unknown Zenodo metadata export format '%s'. Supported export formats are [%s]", format, paste(private$export_formats, collapse=",")))
}
fileext <- private$getExportFormatExtension(format)
destfile <- paste(paste0(filename, ifelse(append_format,paste0("_", format),"")), fileext, sep = ".")
req <- httr::GET(
url = metadata_export_url,
httr::write_disk(path = destfile, overwrite = TRUE)
)
return(destfile)
},
#' @description Exports record as BibTeX
#' @param filename the target filename (without extension)
#' @return the writen file name (with extension)
exportAsBibTeX = function(filename){
self$exportAs("BibTeX", filename)
},
#' @description Exports record as CSL
#' @param filename the target filename (without extension)
#' @return the writen file name (with extension)
exportAsCSL = function(filename){
self$exportAs("CSL", filename)
},
#' @description Exports record as DataCite
#' @param filename the target filename (without extension)
#' @return the writen file name (with extension)
exportAsDataCite = function(filename){
self$exportAs("DataCite", filename)
},
#' @description Exports record as DublinCore
#' @param filename the target filename (without extension)
#' @return the writen file name (with extension)
exportAsDublinCore = function(filename){
self$exportAs("DublinCore", filename)
},
#' @description Exports record as DCAT
#' @param filename the target filename (without extension)
#' @return the writen file name (with extension)
exportAsDCAT = function(filename){
self$exportAs("DCAT", filename)
},
#' @description Exports record as JSON
#' @param filename the target filename (without extension)
#' @return the writen file name (with extension)
exportAsJSON = function(filename){
self$exportAs("JSON", filename)
},
#' @description Exports record as JSONLD
#' @param filename the target filename (without extension)
exportAsJSONLD = function(filename){
self$exportAs("JSON-LD", filename)
},
#' @description Exports record as GeoJSON
#' @param filename the target filename (without extension)
#' @return the writen file name (with extension)
exportAsGeoJSON = function(filename){
self$exportAs("GeoJSON", filename)
},
#' @description Exports record as MARCXML
#' @param filename the target filename (without extension)
#' @return the writen file name (with extension)
exportAsMARCXML = function(filename){
self$exportAs("MARCXML", filename)
},
#' @description Exports record in all Zenodo record export formats. This function will
#' create one file per Zenodo metadata formats.
#' @param filename the target filename (without extension)
exportAsAllFormats = function(filename){
invisible(lapply(private$export_formats, self$exportAs, filename))
},
#' @description list files attached to the record
#' @param pretty whether a pretty output (\code{data.frame}) should be returned (default \code{TRUE}), otherwise
#' the raw list of files is returned.
#' @return the files, as \code{data.frame} or \code{list}
listFiles = function(pretty = TRUE){
if(!pretty) return(self$files)
outdf <- do.call("rbind", lapply(self$files, function(x){
return(
data.frame(
filename = x$filename,
filesize = x$filesize,
checksum = x$checksum,
download = x$download,
stringsAsFactors = FALSE
)
)
}))
return(outdf)
},
#' @description Downloads files attached to the record
#' @param path target download path (by default it will be the current working directory)
#' @param files (list of) file(s) to download. If not specified, by default all files will be downloaded.
#' @param parallel whether download has to be done in parallel using the chosen \code{parallel_handler}. Default is \code{FALSE}
#' @param parallel_handler The parallel handler to use eg. \code{mclapply}. To use a different parallel handler (such as eg
#' \code{parLapply} or \code{parSapply}), specify its function in \code{parallel_handler} argument. For cluster-based parallel
#' download, this is the way to proceed. In that case, the cluster should be created earlier by the user with \code{makeCluster}
#' and passed as \code{cl} argument. After downloading all files, the cluster will be stopped automatically.
#' @param cl an optional cluster for cluster-based parallel handlers
#' @param quiet (default is \code{FALSE}) can be set to suppress informative messages (not warnings).
#' @param overwrite (default is \code{TRUE}) can be set to FALSE to avoid re-downloading existing files.
#' @param timeout (default is 60s) see \code{download.file}.
#' @param ... arguments inherited from \code{parallel::mclapply} or the custom \code{parallel_handler}
#' can be added (eg. \code{mc.cores} for \code{mclapply})
#'
#' @note See examples in \code{\link{download_zenodo}} utility function.
#'
downloadFiles = function(path = ".", files = list(),
parallel = FALSE, parallel_handler = NULL, cl = NULL, quiet = FALSE, overwrite=TRUE, timeout=60, ...){
if(length(self$files)==0){
warnMsg = sprintf("No files to download for record '%s' (doi: '%s')", self$id, self$doi)
cli::cli_alert_warning(warnMsg)
self$WARN(warnMsg)
}else{
files.list <- self$files
if(!overwrite){
files.list <- files.list[
which(sapply(files.list, function(x){
!file.exists(file.path(path, x$filename))}))
]
}
if(length(files)>0) files.list <- files.list[sapply(files.list, function(x){x$filename %in% files})]
if(length(files.list)==0){
errMsg <- sprintf("No files available in record '%s' (doi: '%s') for file names [%s]",
self$id, self$doi, paste0(files, collapse=","))
cli::cli_alert_danger(errMsg)
self$ERROR(errMsg)
stop(errMsg)
}
for(file in files){
if(!file %in% sapply(files.list, function(x){x$filename})){
warnMsg = sprintf("No files available in record '%s' (doi: '%s') for file name '%s': ",
self$id, self$doi, file)
cli::cli_alert_warning(warnMsg)
self$WARN(warnMSg)
}
}
files_summary <- sprintf("Will download %s file%s from record '%s' (doi: '%s') - total size: %s",
length(files.list), ifelse(length(files.list)>1,"s",""), self$id, self$doi,
human_filesize(sum(sapply(files.list, function(x){x$filesize}))))
#download_file util
download_file <- function(file){
file$filename <- substring(file$filename, regexpr("/", file$filename)+1, nchar(file$filename))
if (!quiet){
infoMsg = sprintf("Downloading file '%s' - size: %s\n",
file$filename, human_filesize(file$filesize))
cli::cli_alert_info(infoMSg)
cat(paste("[zen4R][INFO]", infoMsg))
}
target_file <- file.path(path, file$filename)
timeout_cache <- getOption("timeout")
options(timeout = timeout)
download.file(url = file$download, destfile = target_file,
quiet = quiet, mode = "wb")
options(timeout = timeout_cache)
}
#check_integrity util
check_integrity <- function(file){
file$filename <- substring(file$filename, regexpr("/", file$filename)+1, nchar(file$filename))
target_file <-file.path(path, file$filename)
#check md5sum
target_file_md5sum <- tools::md5sum(target_file)
if(target_file_md5sum==file$checksum){
if (!quiet){
infoMsg = sprintf("File '%s': integrity verified (md5sum: %s)\n",
file$filename, file$checksum)
cli::cli_alert_info(infoMsg)
cat(paste("[zen4R][INFO]", infoMsg))
}
}else{
warnMsg <- sprintf("Download issue: md5sum (%s) of file '%s' does not match Zenodo archive md5sum (%s)\n",
target_file_md5sum, tools::file_path_as_absolute(target_file), file$checksum)
cli::cli_alert_warning(warnMsg)
cat(paste("[zen4R][WARN]", warnMsg))
warning(warnMsg)
}
}
if(parallel){
if (!quiet){
infoMsg = "Download in parallel mode"
cli::cli_alert_info(infoMsg)
self$INFO(infoMsg)
}
if (is.null(parallel_handler)) {
errMsg <- "No 'parallel_handler' specified"
cli::cli_alert_danger(errMsg)
self$ERROR(errMsg)
stop(errMsg)
}
if(!is.null(parallel_handler)){
if(!is.null(cl)){
if (!requireNamespace("parallel", quietly = TRUE)) {
errMsg <- "Package \"parallel\" needed for cluster-based parallel handler. Please install it."
cli::cli_alert_danger(errMsg)
self$ERROR(errMsg)
stop(errMsg)
}
if (!quiet){
infoMsg = "Using cluster-based parallel handler (cluster 'cl' argument specified)"
cli::cli_alert_info(infoMsg)
self$INFO(infoMsg)
cli::cli_alert_info(files_summary)
self$INFO(files_summary)
}
invisible(parallel_handler(cl, files.list, download_file, ...))
try(parallel::stopCluster(cl))
}else{
if (!quiet){
infoMsg = "Using non cluster-based (no cluster 'cl' argument specified)"
cli::cli_alert_info(infoMsg)
self$INFO(infoMsg)
cli::cli_alert_info(files_summary)
self$INFO(files_summary)
}
invisible(parallel_handler(files.list, download_file, ...))
}
}
}else{
if (!quiet){
infoMsg = "Download in sequential mode"
cli::cli_alert_info(infoMsg)
self$INFO(infoMsg)
cli::cli_alert_info(files_summary)
self$INFO(files_summary)
}
invisible(lapply(files.list, download_file))
}
if (!quiet){
infoMsg = sprintf("File%s downloaded at '%s'.\n",
ifelse(length(files.list)>1,"s",""), tools::file_path_as_absolute(path))
cli::cli_alert_info(infoMsg)
cat(paste("[zen4R][INFO]", infoMsg))
}
if (!quiet){
infoMsg = "Verifying file integrity..."
cli::cli_alert_info(infoMsg)
self$INFO(infoMsg)
}
invisible(lapply(files.list, check_integrity))
if (!quiet){
infoMsg = "End of download"
cli::cli_alert_success(infoMsg)
self$INFO(infoMsg)
}
}
},
#'@description Prints a \link{ZenodoRecord}
#'@param ... any other parameter. Not used
#'@param format format to use for printing. By default, \code{internal} uses an \pkg{zen4R} internal
#' printing method. Other methods available are those supported by Zenodo for record export, and can be used
#' only if the record has already been published (with a DOI). Attemps to print using a Zenodo export format
#' for a record will raise a warning message and revert to "internal" format
#'@param depth an internal depth parameter for indentation of print statements, in case of listing or recursive use of print
print = function(..., format = "internal", depth = 1){
if(format != "internal"){
zenodo_url <- self$links$record_html
if(is.null(zenodo_url)) zenodo_url <- self$links$latest_html
if(is.null(zenodo_url)){
warnMsg = sprintf("Can't print record as '%s' format: record is not published! Use 'internal' printing format ...", format)
self$WARN(warnMsg)
method <- "internal"
}
}
switch(format,
"internal" = {
cat(sprintf("<%s>", self$getClassName()))
fields <- rev(names(self))
fields <- fields[!sapply(fields, function(x){
(class(self[[x]])[1] %in% c("environment", "function")) ||
(x %in% c("verbose.info", "verbose.debug", "loggerType"))
})]
for(field in fields){
fieldObj <- self[[field]]
shift <- "...."
if(is(fieldObj, "list")){
if(length(fieldObj)>0){
cat(paste0("\n", paste(rep(shift, depth), collapse=""),"|-- ", field, ": "))
if(!is.null(names(fieldObj))){
#named list
for(fieldObjProp in names(fieldObj)){
item = fieldObj[[fieldObjProp]]
if(is(item, "list")){
if(length(item)>0){
cat(paste0("\n", paste(rep(shift, depth+1), collapse=""),"|-- ", fieldObjProp, ": "))
for(itemObj in names(item)){
cat(paste0("\n",paste(rep(shift, depth+2), collapse=""),"|-- ", itemObj, ": ", item[[itemObj]]))
}
}else{
item <- "<NULL>"
cat(paste0("\n",paste(rep(shift, depth+1), collapse=""),"|-- ", fieldObjProp, ": ", item))
}
}else{
cat(paste0("\n", paste(rep(shift, depth+1), collapse=""),"|-- ", fieldObjProp, ": ", item))
}
}
}else{
#unamed lists (eg. files)
for(i in 1:length(fieldObj)){
item = fieldObj[[i]]
cat(paste0("\n", paste(rep(shift, depth+1), collapse=""), i,"."))
for(itemObj in names(item)){
cat(paste0("\n", paste(rep(shift, depth+1), collapse=""),"|-- ", itemObj, ": ", item[[itemObj]]))
}
}
}
}else{
fieldObj <- "<NULL>"
cat(paste0("\n",paste(rep(shift, depth), collapse=""),"|-- ", field, ": ", fieldObj))
}
}else if(is(fieldObj, "data.frame")){
if(field == "stats"){
cat(paste0("\n",paste(rep(shift, depth), collapse=""),"|-- ", field, ":"))
download_cols = colnames(fieldObj)[regexpr("downloads", colnames(fieldObj))>0]
view_cols = colnames(fieldObj)[regexpr("views", colnames(fieldObj))>0]
volume_cols = colnames(fieldObj)[regexpr("volume", colnames(fieldObj))>0]
cols = c(download_cols, view_cols, volume_cols)
for(col in cols){
symbol = ""
if(regexpr("views", col)>0) symbol = "\U0001f441"
if(regexpr("downloads", col)>0) symbol = "\U2193"
if(regexpr("volume", col)>0) symbol = "\U25A0"
cat(paste0("\n",paste(rep(" ", depth), collapse="")," ", utf8::utf8_encode(symbol)," ", col, " = ", fieldObj[,col]))
}
}
}else{
if(is.null(fieldObj)) fieldObj <- "<NULL>"
cat(paste0("\n",paste(rep(shift, depth), collapse=""),"|-- ", field, ": ", fieldObj))
}
}
},
{
tmp <- tempfile()
export = self$exportAs(format = format, filename = tmp)
cat(suppressWarnings(paste(readLines(export),collapse="\n")))
unlink(tmp)
unlink(export)
}
)
invisible(self)
},
#'@description Maps to an \pkg{atom4R} \link{DCEntry}. Note: applies only to published records.
#'@return an object of class \code{DCEntry}
toDCEntry = function(){
tmp <- tempfile()
dcfile <- self$exportAsDublinCore(filename = tmp)
return(atom4R::DCEntry$new(xml = XML::xmlParse(dcfile)))
}
)
)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.