Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
5 changes: 1 addition & 4 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -40,21 +40,18 @@ export(mdq_run)
export(new_uuid)
export(object_exists)
export(parse_resource_map)
export(pid_to_eml_datatable)
export(pid_to_eml_other_entity)
export(pid_to_eml_entity)
export(pid_to_eml_physical)
export(publish_object)
export(publish_update)
export(remove_public_read)
export(set_abstract)
export(set_access)
export(set_file_name)
export(set_other_entities)
export(set_public_read)
export(set_rights_and_access)
export(set_rights_holder)
export(show_indexing_status)
export(sysmeta_to_eml_other_entity)
export(sysmeta_to_eml_physical)
export(update_object)
export(update_resource_map)
Expand Down
236 changes: 85 additions & 151 deletions R/eml.R
Original file line number Diff line number Diff line change
Expand Up @@ -3,102 +3,107 @@
#' Helpers for creating EML.


#' Create EML otherEntity objects for a set of PIDs
#'
#' Note this is a wrapper around sysmeta_to_other_entity which handles the task of
#' creating the EML otherEntity.
#' Create EML entity from a DataONE pid
#'
#' @param mn (MNode) Member Node where the PID is associated with an object.
#' @param pids (character) The PID of the object to create the sub-tree for.
#' @param pid (character) The PID of the object to create the sub-tree for.
#' @param entityType (character) What kind of objects to create from the input. Either "dataTable",
#' "spatialRaster", "spatialVector", "storedProcedure", "view", "otherEntity".
#' @param ... (optional) Additional arguments to be passed to \code{new(entityType, ...)}. See example
#'
#' @return (list of otherEntity) The otherEntity object(s)
#' @return (list) The entity object
#' @export
#'
#' @examples
#' \dontrun{
#' # Generate EML otherEntity objects for all the data in a package
#' pkg <- get_package(mn, pid)
#' pid_to_other_entity(mn, pkg$data)
#' #Generate EML otherEntity
#' pid_to_eml_entity(mn,
#' pid,
#' entityType = "otherEntity",
#' entityName = "Entity Name",
#' entityDescription = "Description about entity")
#'
#' }
pid_to_eml_other_entity <- function(mn, pids) {
pid_to_eml_entity <- function(mn,
pid,
entityType = "otherEntity",
...) {

stopifnot(is(mn, "MNode"))
stopifnot(is.character(pids),
all(nchar(pids)) > 0)
stopifnot(is.character(pid),
nchar(pid) > 0)

sysmeta <- lapply(pids, function(pid) { getSystemMetadata(mn, pid) })
sysmeta_to_eml_other_entity(sysmeta)
stopifnot(entityType %in% c("dataTable",
"spatialRaster",
"spatialVector",
"storedProcedure",
"view",
"otherEntity"))

systmeta <- getSystemMetadata(mn, pid)
physical <- sysmeta_to_eml_physical(systmeta)

# Create entity
entity <- new(entityType,
physical = pid_to_eml_physical(mn, pid),
...)

# Set entity slots
if (length(slot(entity, "id")) == 0) {
entity@id <- new("xml_attribute", systmeta@identifier)
}

if (length(slot(entity, "scope")) == 0) {
entity@scope <- new("xml_attribute", "document")
}

if (length(slot(entity, "entityName")) == 0) {

if (!is.na(systmeta@fileName)) {
entity@entityName <- new("entityName", systmeta@fileName)
}
}

if (entityType == "otherEntity" && length(slot(entity, "entityType")) == 0) {
entity@entityType <- "Other"
}

return(entity)
}


#' Create an EML code\code{dataTable} object for a given PID.
#' This function is deprecated. See \link{pid_to_eml_entity}.
#'
#' This function generates an \code{attributeList} and \code{physical} and constructs a \code{dataTable}.
#' @param mn (MNode) Member Node where the PID is associated with an object.
#' @param pids (character) The PID of the object to create the sub-tree for.
#'
pid_to_eml_other_entity <- function(mn, pids) {
.Deprecated(new = "pid_to_eml_entity",
package = "arcticdtautils",
old = "pid_to_eml_other_entity")
}


#' This function is deprecated. See \link{pid_to_eml_entity}.
#'
#' @param mn (MNode) Member Node where the PID is associated with an object.
#' @param pid (character) The PID of the object to create the \code{dataTable} for.
#' @param attributes (data.frame) Optional data frame of attributes. Follows the convention in \link[EML]{set_attributes}.
#' @param factors (data.frame) Optional data frame of enumerated attribute values (factors). Follows the convention in \link[EML]{set_attributes}.
#' @param name (character) Optional field to specify \code{entityName}, otherwise will be extracted from system metadata.
#' @param description (character) Optional field to specify \code{entityDescription}, otherwise will match name.
#' @param validateAttributes (logical) If set to FALSE or if attributes are not passed into the function, attribute validation test will not run.
#'
#' @return (dataTable) The \code{dataTable} object
#' @export
#' @param validateAttributes (logical) If set to FALSE or if attributes are not passed into the function, attribute validatio
#'
#' @examples
#' \dontrun{
#' # Generate a dataTable for a given pid
#' attributes <- create_dummy_attributes_dataframe(10)
#' name <- "1234.csv"
#' description <- "A description of this entity."
#' dataTable <- pid_to_eml_datatable(mn, pid, attributes, name=name, description=description)
#' }
pid_to_eml_datatable <- function(mn,
pid,
attributes = NULL,
factors = NULL,
name = NULL,
description = NULL,
validateAttributes = TRUE) {
stopifnot(is(mn, "MNode"))
stopifnot(is.character(pid),
nchar(pid) > 0)

dataTable <- new("dataTable", physical = pid_to_eml_physical(mn, pid))

if(!is.null(attributes)) {
stopifnot(is.data.frame(attributes))

if (is.null(factors)) {
attributes <- set_attributes(attributes)
} else {
stopifnot(is.data.frame(factors))
attributes <- set_attributes(attributes, factors)
}

if (validateAttributes == TRUE) {
stopifnot(eml_validate_attributes(attributes))
}

dataTable@attributeList <- attributes
}

if (is.null(name)) {
name <- getSystemMetadata(mn, pid)@fileName

if (is.na(name)) {
stop(call. = FALSE,
"'Name' must either be specified in the function call or must exist in the system metadata.")
}
}

dataTable@entityName <- name

if (!is.null(description)) {
dataTable@entityDescription <- description
}

dataTable
.Deprecated(new = "pid_to_eml_entity",
package = "arcticdtautils",
old = "pid_to_eml_other_entity")
}


Expand Down Expand Up @@ -128,45 +133,14 @@ pid_to_eml_physical <- function(mn, pids) {
sysmeta_to_eml_physical(sysmeta)
}

#' Create an EML otherEntity for the given object from the System Metadata
#' This function is deprecated. See \link{pid_to_eml_entity}.
#'
#' @param sysmeta (SystemMetadata) One or more System Metadata objects
#'
#' @return (list of otherEntity) The otherEntity object(s)
#' @export
#'
#' @examples
#' \dontrun{
#' # Generate EML otherEntity objects for all the data in a package
#' pkg <- get_package(mn, pid)
#' sm <- lapply(pkg$data, function(pid) { getSystemMetadata(mn, pid) })
#' sysmeta_to_other_entity(sm)
#'}
sysmeta_to_eml_other_entity <- function(sysmeta) {
work <- function(x) {
other_entity <- new("otherEntity")
other_entity@id <- new("xml_attribute", x@identifier)
other_entity@scope <- new("xml_attribute", "document")

if (is.na(x@fileName)) {
other_entity@entityName <- new("entityName", "NA")
}
else {
other_entity@entityName <- new("entityName", x@fileName)
}

other_entity@entityType <- "Other"

phys <- sysmeta_to_eml_physical(x)
other_entity@physical <- new("ListOfphysical", phys)

other_entity
}


if (!is(sysmeta, "list")) sysmeta <- list(sysmeta)

lapply(sysmeta, work)
.Deprecated(new = "pid_to_eml_entity",
package = "arcticdtautils",
old = "sysmeta_to_other_entity")
}


Expand Down Expand Up @@ -236,56 +210,16 @@ sysmeta_to_eml_physical <- function(sysmeta) {
lapply(sysmeta, work)
}

#' Creates and sets EML otherEntity elements to an existing EML document,
#' replacing any existing otherEntities
#'
#' This function is slow because it needs get the System Metadata for each
#' element of `pids` in order to get the fileName, checksum, etc.
#' This function is deprecated. See \link{pid_to_eml_entity}.
#'
#' @param mn (MNode) The Member Node the objects exist on.
#' @param path (character) The location on disk of the EML file.
#' @param pids (character) One or more PIDs for the objects.
#'
#' @return (character) The path to the updated EML file.
#' @export
#'
#' @examples
#' \dontrun{
#' mn <- MNode(...) # Set up a connection to an MN
#' eml_path <- "/path/to/your/eml.xml"
#' set_other_entities(mn, eml_path, "a_data_pid")
#' }
set_other_entities <- function(mn, path, pids) {
stopifnot(is(mn, "MNode"))
stopifnot(file.exists(path))
stopifnot(all(is.character(pids)),
all(nchar(pids) > 0))

if (length(pids) == 0) {
message("Skipped adding EML otherEntity elements because no pids were specified.")
return(path)
}

# Get the metadata document from the MN and load it as an EML document
doc <- EML::read_eml(path)
stopifnot(is(doc, "eml"))

message("Setting EML otherEntity elements. This can take a while if there are lots of PIDs...")

# Generate otherEntity elements
other_entities <- pid_to_eml_other_entity(mn, pids)

# Concatenate the existing and new otherEntity elements and put back in the
# EML
if (length(other_entities) > 0) {
doc@dataset@otherEntity <- new("ListOfotherEntity", other_entities)
}

# Write the modified document back to disk and stop
EML::write_eml(doc, path)
stopifnot(EML::eml_validate(path) == TRUE)

path
.Deprecated(new = "pid_to_eml_entity",
package = "arcticdtautils",
old = "set_other_entities")
}

#' Get the Metacat docid for the given identifier
Expand Down Expand Up @@ -603,10 +537,10 @@ eml_individual_name <- function(given_names=NULL, sur_name) {
stopifnot(all(sapply(given_names, is.character)))
stopifnot(all(lengths(given_names) > 0))

givens <- lapply(given_names, function(given_name) {
x <- new("givenName")
x@.Data <- given_name
x
givens <- lapply(given_names, function(given_name) {
x <- new("givenName")
x@.Data <- given_name
x
})

indiv_name@givenName <- new("ListOfgivenName", givens)
Expand Down Expand Up @@ -660,7 +594,7 @@ eml_project <- function(title,
# Title
titles <- lapply(title, function(x) { as(x, "title") })
project@title <- as(titles, "ListOftitle")

# Personnel
if(!all(sapply(personnelList, function(x) { is(x, "personnel") }))) {
stop(call. = FALSE,
Expand Down
18 changes: 3 additions & 15 deletions man/pid_to_eml_datatable.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Loading