R/make_eml.R

Defines functions make_eml

Documented in make_eml

#' Make EML metadata
#'
#' @description  
#'     Render the contents of metadata templates into EML, validate, and write
#'     to file.
#'     
#' @param path 
#'     (character) Path to the metadata template directory.
#' @param data.path
#'     (character) Path to the data directory.
#' @param eml.path
#'     (character) Path to the EML directory, where EML files are written.
#' @param dataset.title
#'     (character) Title of the dataset.
#' @param temporal.coverage
#'     (character) Beginning and ending dates of the dataset in the format 
#'     "YYYY-MM-DD" (e.g. 
#'     \code{temporal.coverage = c('2012-05-01', '2014-11-30')}).
#' @param geographic.description
#'     (character) Description of datasets geographic extent. Don't use this 
#'     argument if geographic coverage is supplied by geographic_coverage.txt.
#' @param geographic.coordinates
#'     (character) Coordinates of datasets geographic extent. Coordinates are
#'     listed in this order: North, East, South, West (e.g. 
#'     \code{geographic.coordinates = c('28.38', '-119.95', '28.38', '-119.95')}).
#'     Longitudes west of the prime meridian and latitudes south of the equator 
#'     are negative. Don't use this argument if geographic coverage is supplied
#'     by geographic_coverage.txt.
#' @param maintenance.description
#'     (character) A description of data collection status (e.g. "ongoing", 
#'     "complete"), communicating the frequency of updates.
#' @param data.table
#'     (character; optional) Table file name. If more than one, then supply 
#'     as a vector of character strings (e.g. 
#'     \code{data.table = c("nitrogen.csv", "decomp.csv")}).
#' @param data.table.name
#'     (character; optional) A short descriptive name for the table. Defaults
#'     to \code{data.table}. If more than one, then supply as a vector of 
#'     character strings in the same order as listed in \code{data.table}.
#' @param data.table.description
#'     (character; optional) Table description. If more than one, then supply 
#'     as a vector of character strings in the same order as listed in 
#'     \code{data.table}.
#' @param data.table.quote.character
#'     (character; optional) Quote character used in \code{data.table}. If 
#'     more than one, then supply as a vector of character strings in the same 
#'     order as listed in \code{data.table}. If the quote character is a quotation, 
#'     then enter \code{'"'}. If the quote character is an apostrophe, then 
#'     enter \code{"'"}. If wanting to include quote characters for some but 
#'     not all \code{data.table}, then use a "" for those that don't have a 
#'     quote character (e.g. \code{data.table.quote.character = 
#'     c("'", "")}).
#' @param data.table.url
#'     (character; optional) The publicly accessible URL from which 
#'     \code{data.table} can be downloaded. If more than one, then supply as 
#'     a vector of character strings in the same order as listed in 
#'     \code{data.table}. If wanting to include URLs for some but not all
#'     \code{data.table}, then use a "" for those that don't have a URL
#'     (e.g. \code{data.table.url = c("", "/url/to/decomp.csv")}).
#' @param other.entity
#'     (character; optional) Name of \code{other.entity}(s) in this 
#'     dataset. Use \code{other.entity} for all non-\code{data.table} files. 
#'     \code{other.entity}(s) should be stored at \code{data.path}. If more 
#'     than one, then supply as a vector of character strings (e.g. 
#'     \code{other.entity = c('ancillary_data.zip', 'quality_control.R')}).
#' @param other.entity.name
#'     (character; optional) A short descriptive name for the other.entity. 
#'     Defaults to \code{other.entity}. If more than one, then supply as a 
#'     vector of character strings in the same order as listed in 
#'     \code{other.entity}.
#' @param other.entity.description
#'     (character; optional) Description(s) of \code{other.entity}(s). If more 
#'     than one, then supply as a vector of descriptions in the same order as 
#'     listed in \code{other.entity}.
#' @param other.entity.url
#'     (character; optional) The publicly accessible URL from which 
#'     \code{other.entity} can be downloaded. If more than one, then supply as 
#'     a vector of character strings in the same order as listed in 
#'     \code{other.entity}. If wanting to include URLs for some but not all
#'     \code{other.entity}, then use a "" for those that don't have a URL
#'     (e.g. \code{other.entity.url = c("", "/url/to/quality_control.R")}).
#' @param provenance
#'     (character; optional) EDI Data Repository Data package ID(s) 
#'     corresponding to parent datasets from which this dataset was created 
#'     (e.g. \code{knb-lter-cap.46.3}).
#' @param user.id
#'     (character; optional) Repository user identifier. If more than one, 
#'     then enter as a vector of character strings (e.g. 
#'     \code{c("user_id_1", "user_id_2")}). \code{user.id} sets the 
#'     /eml/access/principal element for all \code{user.domain} except
#'     "KNB", "ADC", and if \code{user.domain = NULL}.
#' @param user.domain
#'     (character; optional) Repository domain associated with 
#'     \code{user.id}. Currently supported values are "EDI" 
#'     (Environmental Data Initiative), "LTER" (Long-Term Ecological Research 
#'     Network), "KNB" (The Knowledge Network for Biocomplexity), "ADC" (The 
#'     Arctic Data Center). If you'd like your system supported please contact
#'     maintainers of the EMLassemblyline R package. If using more than one 
#'     \code{user.domain}, then enter as a vector of character strings (e.g. 
#'     \code{c("user_domain_1", "user_domain_2")}) in the same order as 
#'     corresponding \code{user.id}. If \code{user.domain} is missing then a 
#'     default value "unknown" is assigned. \code{user.domain} sets the EML 
#'     header "system" attribute and for all \code{user.domain}, except "KNB" 
#'     and "ADC", sets the /eml/access/principal element attributes and values.
#' @param package.id
#'     (character; optional) Data package ID for the dataset described by this
#'     EML. Ask your data repository for a package ID. Missing \code{package.id}
#'     is assigned a UUID.
#' @param write.file
#'     (logical; optional) Whether to write the EML file.
#' @param return.obj
#'     (logical; optional) Whether to return the EML as an R object of class \code{EML object}. This EML object can be modified and written to file according to the \href{https://github.com/ropensci/EML}{EML R library}.
#' @param x
#'     (named list; optional) Alternative input to 
#'     \code{make_eml()}. Use \code{template_arguments()} 
#'     to create \code{x}.
#'     
#' @return 
#'     \itemize{
#'         \item{\strong{EML file} written to \code{eml.path}.}
#'         \item{\strong{EML object} when \code{return.obj = TRUE}.}
#'     }
#'     
#' @details 
#'     \code{make_eml()} reads the contents of metadata templates, 
#'     auto-extracts additional metadata from the data entities, appends value 
#'     added content (e.g. resolving keywords to controlled vocabularies), and 
#'     adds all the metadata content to locations in the EML schema according 
#'     with best practice recommendations of scientists, data managers, and 
#'     data repositories. The EML is then validated against the schema and 
#'     written to file.
#'     
#'     Character encodings in tabular metadata templates are converted to UTF-8 
#'     via \code{enc2utf8()}. Characters in TextType metadata templates are not
#'     yet converted. Note: This may lead to an inaccuracy and disconnect 
#'     between values in the data objects and what is reported in the EML (e.g.
#'     a categorical variable listed in the EML may not be the same as it's 
#'     corresponding value in the data object). For this reason it's important 
#'     to work with UTF-8 encoded data and metadata.
#'
#' @examples 
#' \dontrun{
#' 
#' # Set working directory
#' setwd("/Users/me/Documents/data_packages/pkg_260")
#' 
#' # For 2 tables and 2 other entities
#' make_eml(
#'   path = "./metadata_templates",
#'   data.path = "./data_objects",
#'   eml.path = "./eml",
#'   dataset.title = "Sphagnum and Vascular Plant Decomposition under Increasing Nitrogen Additions",
#'   temporal.coverage = c("2014-05-01", "2015-10-31"),
#'   maintenance.description = "Completed: No updates to these data are expected",
#'   data.table = c("decomp.csv", "nitrogen.csv"),
#'   data.table.description = c("Decomposition data", "Nitrogen data"),
#'   other.entity = c("ancillary_data.zip", "processing_and_analysis.R"),
#'   other.entity.description = c("Ancillary data", "Data processing and analysis script"),
#'   user.id = "myid",
#'   user.domain = "EDI",
#'   package.id = "edi.260.1")
#' }
#'
#' @export
#'
make_eml <- function(
  path,
  data.path = path,
  eml.path = path, 
  dataset.title = NULL,
  temporal.coverage = NULL,
  geographic.description = NULL, 
  geographic.coordinates = NULL, 
  maintenance.description = NULL, 
  data.table = NULL, 
  data.table.name = data.table,
  data.table.description = NULL, 
  data.table.quote.character = NULL, 
  data.table.url = NULL,
  other.entity = NULL,
  other.entity.name = other.entity,
  other.entity.description = NULL,
  other.entity.url = NULL,
  provenance = NULL,
  user.id = NULL,
  user.domain = NULL,
  package.id = NULL,
  write.file = TRUE,
  return.obj = FALSE,
  x = NULL
  ) {
  
  # Parameterize --------------------------------------------------------------
  
  # Get attributes of template files
  
  attr_tmp <- read_template_attributes()
  
  # Validate arguments --------------------------------------------------------
  
  # Validate path usage before passing arguments to validate_arguments().
  # When not using x, inputs are expected from path, data.path, and 
  # eml.path. When using x, only data.path is required unless write.file = TRUE
  # in which case eml.path is required.
  
  if (is.null(x) & missing(path)) {
    stop("Input argument 'path' is missing.")
  } else if (!is.null(x) & missing(path)) {
    path <- NULL
    if (missing(data.path)) {
      stop("Input argument 'data.path' is missing.")
    }
    if (isTRUE(write.file) & missing(eml.path)) {
      stop("Input argument 'write.file = TRUE' but 'eml.path' is missing.")
    } else if (!isTRUE(write.file) & missing(eml.path)) {
      eml.path <- NULL
    }
  }
  
  # Pass remaining arguments to validate_arguments()
  validate_arguments(
    fun.name = "make_eml",
    fun.args = as.list(environment()))
  
  # Handle deprecated arguments
  
  # FIXME: Remove October 2021
  if (!is.null(provenance)) {
    warning(
      paste0(
        "Argument 'provenance' is deprecated; please use ",
        "'template_provanence()' instead."),
      call. = F)
  }
  
  # Read templates and data ---------------------------------------------------
  # The reading function (template_arguments()) ignores empty templates located
  # at path, thereby simplifying logic required to populate EML nodes below.
  
  if (is.null(x)) {
    if (is.null(data.table) & is.null(other.entity)) {      
      x <- template_arguments(
        path = path,
        data.path = data.path)$x
    } else if (!is.null(data.table) & is.null(other.entity)) {
      table_names <- suppressWarnings(
        validate_file_names(
          path = data.path, 
          data.files = data.table))
      x <- template_arguments(
        path = path,
        data.path = data.path,
        data.table = table_names)$x
    } else if (!is.null(data.table) & !is.null(other.entity)) {
      table_names <- suppressWarnings(
        validate_file_names(
          path = data.path, 
          data.files = data.table))
      x <- template_arguments(
        path = path,
        data.path = data.path,
        data.table = table_names,
        other.entity = other.entity)$x
    } else if (is.null(data.table) & !is.null(other.entity)) {
      x <- template_arguments(
        path = path,
        data.path = data.path,
        other.entity = other.entity)$x
    }
    data_read_2_x <- TRUE
  }
  
  # Clean templates of extraneous NA values -----------------------------------
  # Users often add NAs to templates where EMLassemblyline expects "". This 
  # removes NAs from where they shouldn't be and replaces them with "". NOTE:
  # Any value listed in the missingValueCode field is interpreted "as is" when
  # attributes.txt templates are input as files. In contrast, when inputs are 
  # supplied by the argument "x" and when is.na() returns TRUE for values in
  # the missingValueCode field, these NAs are converted to "".
  # TODO: Move this process to validate_templates()
  
  for (k in names(x$template)) {
    if (is.data.frame(x$template[[k]]$content)) {
      for (m in names(x$template[[k]]$content)) {
        if (m == "missingValueCode") {
          if (!exists("data_read_2_x")) {
            x$template[[k]]$content[[m]][
              is.na(x$template[[k]]$content[[m]])] <- ""
          }
        } else {
          x$template[[k]]$content[[m]][
            is.na(x$template[[k]]$content[[m]])] <- ""
        }
      }
    }
  }

  # Validate templates --------------------------------------------------------
  
  x <- remove_empty_templates(x)
  x <- validate_templates("make_eml", x)
  
  # Modify templates ----------------------------------------------------------
  # Modification of some template content helps with downstream processes.
  # FIXME: Move this section to validate_templates()
  
  # catvars.txt:
  # - Remove incomplete cases
  # - Remove white space
  # FIXME: Ignore blank (i.e. "") categorical codes (implement this in 
  # the metadata quality check functions to be developed? See GitHub 
  # issue #46)
  
  use_i <- stringr::str_detect(
    names(x$template), 
    attr_tmp$regexpr[attr_tmp$template_name == "catvars"])
  if (any(use_i)) {
    for (i in which(use_i)) {
      use_i <- (x$template[[i]]$content$attributeName == "") |
        (x$template[[i]]$content$code == "") |
        (x$template[[i]]$content$definition == "")
      x$template[[i]]$content <- x$template[[i]]$content[!use_i, ]
      x$template[[i]]$content <- as.data.frame(
        lapply(
          x$template[[i]]$content,
          trimws), 
        stringsAsFactors = F)
    }
  }
  
  # custom_units.txt:
  # - Remove white space
  
  if (!is.null(x$template$custom_units.txt)) {
    x$template$custom_units.txt$content <- as.data.frame(
      lapply(
        x$template$custom_units.txt$content,
        trimws), 
      stringsAsFactors = F)
  }
  
  # keywords.txt: 
  # - Remove blank keywords to reduce errors when matching to controlled 
  # vocabularies
  
  x$template$keywords.txt$content <- x$template$keywords.txt$content[
    x$template$keywords.txt$content$keyword != "", ]
  
  # personnel.txt:
  # - Remove mistankenly entered white spaces
  
  x$template$personnel.txt$content <- as.data.frame(
    lapply(
      x$template$personnel.txt$content,
      trimws), 
    stringsAsFactors = F)
  
  # personnel.txt: 
  # - Set default project title and funding elements when none are provided 
  # - Combine projectTitle and fundingNumber into new "funding" field
  
  x$template$personnel.txt$content$projectTitle[
    x$template$personnel.txt$content$projectTitle == ""] <- 
    "No project title to report"
  x$template$personnel.txt$content$funding <- trimws(
    paste(
      x$template$personnel.txt$content$fundingAgency,
      x$template$personnel.txt$content$fundingNumber))
  x$template$personnel.txt$content$funding[
    x$template$personnel.txt$content$funding == ""] <- "No funding to report"
  
  # table_attributes.txt:
  # - Convert contents in the class field to a consistent case
  # - Set units in non-numeric classes to ""
  # - Ignore dateTimeFormatString when not classified as date
  # - Remove white space
  
  use_i <- stringr::str_detect(
    names(x$template), 
    attr_tmp$regexpr[attr_tmp$template_name == "attributes"])
  if (any(use_i)) {
    for (i in which(use_i)) {
      x$template[[i]]$content$class <- tolower(x$template[[i]]$content$class)
      x$template[[i]]$content$unit[
        x$template[[i]]$content$class != "numeric"] <- ""
      x$template[[i]]$content$dateTimeFormatString[
        x$template[[i]]$content$class != "date"] <- ""
      x$template[[i]]$content <- as.data.frame(
        lapply(
          x$template[[i]]$content,
          trimws), 
        stringsAsFactors = F)
    }
  }
  
  # taxonomic_coverage.txt
  # - Convert "" to NA as expected by taxonomyCleanr::make_taxonomicCoverage()
  # - Add unresolved names to the name_resolved field so they will be listed in 
  # the output EML (with a rank value of "unknown").
  
  if (!is.null(x$template$taxonomic_coverage.txt$content)) {
    x$template$taxonomic_coverage.txt$content[
      x$template$taxonomic_coverage.txt$content == "" ] <- NA_character_
    use_i <- is.na(x$template$taxonomic_coverage.txt$content$name_resolved)
    x$template$taxonomic_coverage.txt$content$name_resolved[use_i] <- 
      x$template$taxonomic_coverage.txt$content$name[use_i]
  }
  
  # Load helper funcitions ----------------------------------------------------
  
  # A function to set personnel roles: contact, creator, Principal 
  # investigator, associated party (other)
  
  set_person <- function(info_row, person_role) {
    
    if (person_role == "contact") {
      
      # If the contact only has givenName then the contact is an organization, 
      # otherwise it is a person.
      if ((x$template$personnel.txt$content[info_row, "givenName"] != "") & 
          (x$template$personnel.txt$content[info_row, "middleInitial"] == "") & 
          (x$template$personnel.txt$content[info_row, "surName"] == "")) {
        contact <- list(
          organizationName = x$template$personnel.txt$content[info_row,"organizationName"],
          positionName = stringr::str_to_title(x$template$personnel.txt$content[info_row,"givenName"]),
          electronicMailAddress = x$template$personnel.txt$content[info_row,"electronicMailAddress"])
        if (nchar(x$template$personnel.txt$content[info_row,"userId"]) == 19) {
          contact$userId <- list(
            directory = "https://orcid.org",
            paste0(
              "https://orcid.org/", 
              x$template$personnel.txt$content[info_row,"userId"]))
        }
      } else {
        contact <- list(
          individualName = list(
            givenName = list(
              x$template$personnel.txt$content[info_row,"givenName"],
              x$template$personnel.txt$content[info_row,"middleInitial"]),
            surName = x$template$personnel.txt$content[info_row,"surName"]),
          organizationName = x$template$personnel.txt$content[info_row,"organizationName"],
          electronicMailAddress = x$template$personnel.txt$content[info_row,"electronicMailAddress"])
        if (nchar(x$template$personnel.txt$content[info_row,"userId"]) == 19){
          contact$userId <- list(
            directory = 'https://orcid.org',
            paste0(
              "https://orcid.org/", 
              x$template$personnel.txt$content[info_row,"userId"]))
        }
        # FIXME Blank entries ('') result in closing tags when EML is written
        # to file. Need function to set all elements of value = '' to NULL.
        contact <- rapply(
          contact,
          function(x){
            if (x == ""){
              x <- NULL
            } else {
              x
            }
          },
          how = c("replace"))
      }
      contact
      
    } else if (person_role == "creator") {
      
      creator <- list(
        individualName = list(
          givenName = list(
            x$template$personnel.txt$content[info_row,"givenName"],
            x$template$personnel.txt$content[info_row,"middleInitial"]),
          surName = x$template$personnel.txt$content[info_row,"surName"]),
        organizationName = x$template$personnel.txt$content[info_row,"organizationName"],
        electronicMailAddress = x$template$personnel.txt$content[info_row,"electronicMailAddress"])
      if (nchar(x$template$personnel.txt$content[info_row,"userId"]) == 19){
        creator$userId <- list(
          directory = 'https://orcid.org',
          paste0(
            "https://orcid.org/", 
            x$template$personnel.txt$content[info_row,"userId"]))
      }
      # FIXME Blank entries ('') result in closing tags when EML is written
      # to file. Need function to set all elements of value = '' to NULL.
      creator <- rapply(
        creator,
        function(x){
          if (x == ""){
            x <- NULL
          } else {
            x
          }
        },
        how = c("replace"))
      creator
      
    } else if (person_role == "pi") {
      
      rp_personnel <- list(
        individualName = list(
          givenName = list(
            x$template$personnel.txt$content[info_row,"givenName"],
            x$template$personnel.txt$content[info_row,"middleInitial"]),
          surName = x$template$personnel.txt$content[info_row,"surName"]),
        organizationName = x$template$personnel.txt$content[info_row,"organizationName"],
        electronicMailAddress = x$template$personnel.txt$content[info_row,"electronicMailAddress"],
        role = 'Principal Investigator')
      if (nchar(x$template$personnel.txt$content[info_row,"userId"]) == 19){
        rp_personnel$userId <- list(
          directory = 'https://orcid.org',
          paste0(
            "https://orcid.org/", 
            x$template$personnel.txt$content[info_row,"userId"]))
      }
      # FIXME Blank entries ('') result in closing tags when EML is written
      # to file. Need function to set all elements of value = '' to NULL.
      rp_personnel <- rapply(
        rp_personnel,
        function(x){
          if (x == ""){
            x <- NULL
          } else {
            x
          }
        },
        how = c("replace"))
      rp_personnel
      
    } else if (person_role == "publisher") {
      
      rp_personnel <- list(
        individualName = list(
          givenName = list(
            x$template$personnel.txt$content[info_row,"givenName"],
            x$template$personnel.txt$content[info_row,"middleInitial"]),
          surName = x$template$personnel.txt$content[info_row,"surName"]),
        organizationName = x$template$personnel.txt$content[info_row,"organizationName"],
        electronicMailAddress = x$template$personnel.txt$content[info_row,"electronicMailAddress"])
      if (nchar(x$template$personnel.txt$content[info_row,"userId"]) == 19){
        rp_personnel$userId <- list(
          directory = 'https://orcid.org',
          paste0(
            "https://orcid.org/", 
            x$template$personnel.txt$content[info_row,"userId"]))
      }
      # FIXME Blank entries ('') result in closing tags when EML is written
      # to file. Need function to set all elements of value = '' to NULL.
      rp_personnel <- rapply(
        rp_personnel,
        function(x){
          if (x == ""){
            x <- NULL
          } else {
            x
          }
        },
        how = c("replace"))
      rp_personnel
      
    }else {
      
      # If givenName, middleName, and surName are blank then the 
      # associatedParty is an organization, otherwise the associatedParty 
      # is a person
      if ((x$template$personnel.txt$content[info_row, "givenName"] == "") & 
          (x$template$personnel.txt$content[info_row, "middleInitial"] == "") & 
          (x$template$personnel.txt$content[info_row, "surName"] == "")) {
        associated_party = list(
          organizationName = x$template$personnel.txt$content[info_row,"organizationName"],
          electronicMailAddress = x$template$personnel.txt$content[info_row,"electronicMailAddress"],
          role = x$template$personnel.txt$content[info_row,"role"])
        if (nchar(x$template$personnel.txt$content[info_row,"userId"]) == 19){
          associated_party$userId <- list(
            directory = 'https://orcid.org',
            paste0(
              "https://orcid.org/", 
              x$template$personnel.txt$content[info_row,"userId"]))
        }
        associated_party
      } else {
        associated_party <- list(
          individualName = list(
            givenName = list(
              x$template$personnel.txt$content[info_row,"givenName"],
              x$template$personnel.txt$content[info_row,"middleInitial"]
            ),
            surName = x$template$personnel.txt$content[info_row,"surName"]
          ),
          organizationName = x$template$personnel.txt$content[info_row,"organizationName"],
          electronicMailAddress = x$template$personnel.txt$content[info_row,"electronicMailAddress"],
          role = x$template$personnel.txt$content[info_row,"role"]
        )
        
        if (nchar(x$template$personnel.txt$content[info_row,"userId"]) == 19){
          associated_party$userId <- list(
            directory = 'https://orcid.org',
            paste0(
              "https://orcid.org/", 
              x$template$personnel.txt$content[info_row,"userId"]))
        }
        # FIXME Blank entries ('') result in closing tags when EML is written
        # to file. Need function to set all elements of value = '' to NULL.
        associated_party <- rapply(
          associated_party,
          function(x){
            if (x == ""){
              x <- NULL
            } else {
              x
            }
          },
          how = c("replace"))
        associated_party
      }
      
    }
    
  }
  
  # Create <eml> --------------------------------------------------------------
  
  message("Making EML ...")
  message("<eml>")
  
  # Set default package.id
  
  if (is.null(package.id)) {
    warning("Missing 'package.id', assigning a UUID", call. = FALSE)
    package.id <- uuid::UUIDgenerate()
  }
  
  # Define the EML system attribute from user.domain
  
  if (("edi" %in% tolower(user.domain)) | ("lter" %in% tolower(user.domain))) {
    sys <- "edi"
  } else if ("knb" %in% tolower(user.domain)) {
    sys <- "knb"
  } else if ("adc" %in% tolower(user.domain)) {
    sys <- "https://arcticdata.io"
  } else {
    sys <- "unknown"
  }
  
  # Construct EML header
  
  eml <- list(
    schemaLocation = "https://eml.ecoinformatics.org/eml-2.2.0/eml.xsd https://eml.ecoinformatics.org/eml-2.2.0/eml.xsd",
    packageId = package.id,
    system = sys)
  
  # Create <access> -----------------------------------------------------------
  # Create the access node for systems/repositories (i.e. user.domain) that 
  # use it, and if a user.id is specified.
  
  if ((eml$system != "knb") & 
      (eml$system != "https://arcticdata.io") &
      (!is.null(user.id))) {
    
    message("  <access>")
    
    # Set access attributes
    
    if (eml$system == "edi") {
      auth_sys <- "https://pasta.edirepository.org/authentication"
    } else {
      auth_sys <- "unknown"
    }
    
    eml$access <- list(
      scope = "document",
      order = "allowFirst",
      authSystem = auth_sys,
      allow = list())
    
    # Extrapolate user.id and user.domain if unequal lengths.
    
    if (!is.null(user.id) & !is.null(user.domain)) {
      if (length(user.id) != length(user.domain)) {
        user.id <- data.frame(
          user.id, user.domain, stringsAsFactors = FALSE)$user.id
        user.domain <- data.frame(
          user.id, user.domain, stringsAsFactors = FALSE)$user.domain
        warning(
          "The number of 'user.id' and 'user.domain' inputs differ. ",
          "Extrapolating to make equal:\nuser.id = ", 
          paste(user.id, collapse = ", "), "\nuser.domain = ", 
          paste(user.domain, collapse = ", "), call. = FALSE)
      }
    }
    
    # Set permissions to "all" for the principal and "read" for public
    
    r <- lapply(
      seq_along(user.id),
      function(k) {
        if (auth_sys == "https://pasta.edirepository.org/authentication") {
          if (tolower(user.domain[k]) == "lter") {
            principal <- paste0(
              "uid=", user.id[k], ",o=", user.domain[k], ",dc=ecoinformatics,dc=org")
          } else if (tolower(user.domain[k]) == "edi") {
            principal <- paste0(
              "uid=", user.id[k], ",o=", user.domain[k], ",dc=edirepository,dc=org")
          }
        } else {
          principal <- user.id[k]
        }
        permission <- "all"
        list(principal = principal, permission = permission)
      })
    r[[length(r)+1]] <- list(principal = "public", permission = "read")
    eml$access$allow <- r
    
  }

  # Create <dataset> ----------------------------------------------------------
  # Initialize the dataset list to which sub-nodes will be added
  
  message("  <dataset>")
  dataset <- list()
  
  # Create <title> ------------------------------------------------------------
  
  if (!is.null(dataset.title)) {
    message("    <title>")
    eml$dataset$title <- dataset.title
  }
  
  # Create <creator> ----------------------------------------------------------

  if (!is.null(x$template$personnel.txt)) {
    eml$dataset$creator <- lapply(
      which(tolower(x$template$personnel.txt$content$role) == "creator"),
      function(k) {
        message("    <creator>")
        set_person(info_row = k, person_role = "creator")
      })
  }

  # Create <associatedParty> --------------------------------------------------
  
  if (!is.null(x$template$personnel.txt)) {
    eml$dataset$associatedParty <- lapply(
      which(
        stringr::str_detect(
          tolower(x$template$personnel.txt$content$role),
          "[^pi|^creator|^contact]")),
      function(k) {
        message("    <associatedParty>")
        set_person(info_row = k, person_role = "")
      })
  }
  
  # Create <pubDate> ----------------------------------------------------------
  
  message("    <pubDate>")
  eml$dataset$pubDate <- format(Sys.time(), "%Y-%m-%d")

  # Create <abstract> ---------------------------------------------------------
  
  if (any(stringr::str_detect(names(x$template), 'abstract'))) {
    message("    <abstract>")
    eml$dataset$abstract <- x$template[[
      names(x$template)[stringr::str_detect(names(x$template), 'abstract')]
      ]]$content
  }
  
  # Create <keywordSet> -------------------------------------------------------
  # Try resolving keywords without a listed thesaurus to the LTER Controlled 
  # Vocabulary, then create a separate keywordSet for each thesaurus + keyword
  # group.
  
  if (!is.null(x$template$keywords.txt)) {
    
    use_i <- x$template$keywords.txt$content$keywordThesaurus == ""
    if (any(use_i)) {
      r <- try(
        vocab_resolve_terms(
          x = x$template$keywords.txt$content$keyword[use_i],
          cv = "lter"),
        silent = T)
      if (is.data.frame(r)) {
        x$template$keywords.txt$content[
          match(
            r[r$controlled_vocabulary != "", ]$term, 
            x$template$keywords.txt$content$keyword), ] <- 
          r[r$controlled_vocabulary != "", ]
      }
    }
    
    eml$dataset$keywordSet <- lapply(
      unique(x$template$keywords.txt$content$keywordThesaurus),
      function(k) {
        message("    <keywordSet>")
        if (k == "") {
          list(
            keyword = as.list(
              x$template$keywords.txt$content$keyword[
                x$template$keywords.txt$content$keywordThesaurus == k]))
        } else {
          list(
            keyword = as.list(
              x$template$keywords.txt$content$keyword[
                x$template$keywords.txt$content$keywordThesaurus == k]),
            keywordThesaurus = unique(
              x$template$keywords.txt$content$keywordThesaurus[
                x$template$keywords.txt$content$keywordThesaurus == k]))
        }
      })
    
  }

  # Create <additionalInfo> ---------------------------------------------------
  
  if (any(stringr::str_detect(names(x$template), "additional_info"))) {
    message('    <additionalInfo>')
    eml$dataset$additionalInfo <- x$template[[
      names(x$template)[
        stringr::str_detect(names(x$template), "additional_info")]]]$content
  }

  # Create <intellectualRights> -----------------------------------------------

  if (!is.null(stringr::str_detect(names(x$template), "intellectual_rights"))) {
    message("    <intellectualRights>")
    eml$dataset$intellectualRights <- x$template$intellectual_rights.txt$content
  }

  # Create <coverage> ---------------------------------------------------------
  
  message('    <coverage>')
  
  eml$dataset$coverage <- list()
  
  # Create <geographicCoverage> -----------------------------------------------
  
  # Check for multiple geographic coverage inputs.
  # FIXME: On May 1, 2020 remove support for bounding_boxes.txt
  if (is.null(geographic.coordinates) & !any(stringr::str_detect(
    names(x$template), 
    "geographic_coverage.txt|bounding_boxes.txt"))) {
    
    warning("Geographic coverage is recommended.", call. = FALSE)
    
  } else {

    if (!is.null(x$template$geographic_coverage.txt)) {
      # Create the geographicCoverage node
      o <- x$template$geographic_coverage.txt$content
      eml$dataset$coverage$geographicCoverage <- lapply(
        seq_len(nrow(o)),
        function(k) {
          message('        <geographicCoverage>')
          list(
            geographicDescription = o$geographicDescription[k],
            boundingCoordinates = list(
              westBoundingCoordinate = o$westBoundingCoordinate[k],
              eastBoundingCoordinate = o$eastBoundingCoordinate[k],
              northBoundingCoordinate = o$northBoundingCoordinate[k],
              southBoundingCoordinate = o$southBoundingCoordinate[k]))
        })
    }
  }

  # Create <temporalCoverage> -------------------------------------------------
  
  if (!is.null(temporal.coverage)) {
    message("        <temporalCoverage>")
    eml$dataset$coverage$temporalCoverage <- list(
      rangeOfDates = list(
        beginDate = list(calendarDate = temporal.coverage[1]),
        endDate = list(calendarDate = temporal.coverage[2])))
  }
  
  # Create <taxonomicCoverage> ------------------------------------------------
  # Two sources of taxonomic coverage are supported: 
  #
  # 1.) The taxonomicCoverage EML node as an .xml file, which is read and 
  # inserted into the emld list object that make_eml() creates.
  #
  # 2.) The taxonomic_coverage.txt template listing taxa and authorities. 
  # Attempts are made to get the full hierarchy of taxonomic rank values for 
  # each taxa and render to EML.
  # FIXME: Create methods for adding taxonomic authorities. Only ITIS is 
  # currently supported.
  # FIXME: Allow taxonomic hierarchies to be supplied as a table (i.e. align
  # taxonomic_coverage.txt with the taxonomicCoverage option of 
  # EML::set_coverage()).
  
  if (!is.null(x$template$taxonomicCoverage.xml)) {
    message("        <taxonomicCoverage>")
    eml$dataset$coverage$taxonomicCoverage <- 
      x$template$taxonomicCoverage.xml$content
  } else if (!is.null(x$template$taxonomic_coverage.txt)) {
    message("        <taxonomicCoverage>")
    tc <- try(
      suppressMessages(
        taxonomyCleanr::make_taxonomicCoverage(
          taxa.clean = x$template$taxonomic_coverage.txt$content$name_resolved,
          authority = x$template$taxonomic_coverage.txt$content$authority_system,
          authority.id = x$template$taxonomic_coverage.txt$content$authority_id,
          rank = x$template$taxonomic_coverage.txt$content$rank,
          write.file = F)),
      silent = T)
    if (class(tc) != "try-error") {
      eml$dataset$coverage$taxonomicCoverage$taxonomicClassification <- tc$taxonomicClassification
    }
  }
  
  # Create <maintenance> ------------------------------------------------------
  
  if (!is.null(maintenance.description)) {
    message("    <maintenance>")
    eml$dataset$maintenance$description <- maintenance.description
  }
  
  # Create <contact> ----------------------------------------------------------
  
  if (!is.null(x$template$personnel.txt)) {
    eml$dataset$contact <- lapply(
      which(tolower(x$template$personnel.txt$content$role) == "contact"),
      function(k) {
        message("    <contact>")
        set_person(info_row = k, person_role = "contact")
      })
  }
  
  # Create <publisher> --------------------------------------------------------
  
  eml$dataset$publisher <- lapply(
    which(tolower(x$template$personnel.txt$content$role) == "publisher"),
    function(k) {
      message("    <publisher>")
      set_person(info_row = k, person_role = "publisher")
    })
  
  # Create <methods> ----------------------------------------------------------
  
  if (any(stringr::str_detect(names(x$template), "methods"))) {
    message("    <methods>")
    eml$dataset$methods$methodStep <- list(
      x$template[[
        names(x$template)[stringr::str_detect(names(x$template), "methods")]
        ]]$content$methodStep)
  }
  
  # Create <methodStep> (provenance) ------------------------------------------
  # Get provenance metadata from supported systems (repositories) and external 
  # sources (everything else), then combine as a list of methodStep.
  
  # TODO: Support provenance metadata models used by other EML based 
  # repositories.
  
  if (!is.null(x$template$provenance.txt$content)) {
    
    # Identify internal sources
    internal_sources <- x$template$provenance.txt$content[
      x$template$provenance.txt$content$dataPackageID != "", ]
    
    # Parse internal sources
    if (nrow(internal_sources) != 0) {
      data_package_identifiers <- unique(internal_sources$dataPackageID)
      o <- lapply(
        data_package_identifiers,
        function(k) {
          message("      <methodStep> (provenance metadata)")
          r <- httr::GET(
            paste0(
              url_env("production"),
              ".lternet.edu/package/provenance/eml/",
              stringr::str_replace_all(k, '\\.', '/')))
          if (r$status_code == 200) {
            prov <- httr::content(r, encoding = 'UTF-8')
            # Remove IDs from creator and contact to preempt ID + reference
            # errors
            xml2::xml_set_attr(
              xml2::xml_find_all(prov, './/dataSource/creator'),
              'id', NULL)
            xml2::xml_set_attr(
              xml2::xml_find_all(prov, './/dataSource/contact'),
              'id', NULL)
            # Write .xml to tempdir() and read back in as an emld list object
            # to be added to the dataset emld list under construction here
            xml2::write_xml(prov, paste0(tempdir(), "/provenance_metadata.xml"))
            prov <- EML::read_eml(paste0(tempdir(), "/provenance_metadata.xml"))
            prov$`@context` <- NULL
            prov$`@type` <- NULL
            eml$dataset$methods$methodStep[[
              length(eml$dataset$methods$methodStep)+1]] <<- prov
            suppressMessages(file.remove(paste0(tempdir(), "/provenance_metadata.xml")))
          } else {
            message("Unable to get provenance metadata.")
          }
        })
    }
    
    # Identify external sources
    external_sources <- x$template$provenance.txt$content[
      x$template$provenance.txt$content$dataPackageID == "", ]
    
    # Parse external sources.
    # FIXME: Some elements require an explicit NULL value to prevent them from 
    # being displayed in the returned EML as closing tags (i.e. </tag>). This 
    # is an issue in the EML R package. Is there a more concise way of handling
    # this issue than implemented here?

    if (nrow(external_sources) != 0) {
      source_titles <- unique(external_sources$title)
      provenance <- lapply(
        source_titles,
        function(title) {
          message("      <methodStep> (provenance metadata)")
          d <- x$template$provenance.txt$content[
            x$template$provenance.txt$content$title == title, ]
          # Initialize onlineDescription
          online_description <- d$onlineDescription[1]
          if (online_description == "") {
            online_description <- NULL
          }
          # Initialize provenance node

          out <- list(
            dataSource = list(
              title = title,
              creator = NULL,
              distribution = list(
                online = list(
                  onlineDescription = online_description,
                  url = d[1, "url"])),
              contact = NULL),
            description = "This provenance metadata does not contain entity specific information.")
          for (i in 1:nrow(d)) {
            # Initialize individualName
            if (trimws(d$middleInitial[i]) != "") {
              individual_name <- list(
                givenName = list(trimws(d$givenName[i]), trimws(d$middleInitial[i])),
                surName = d$surName[i])
            } else {
              individual_name <- list(
                givenName = list(trimws(d$givenName[i])),
                surName = d$surName[i])
            }
            if (individual_name$givenName[[1]] == "" &
                individual_name$surName == "") {
              individual_name <- NULL
            }
            # Initialize organizationName
            organization_name <- d$organizationName[i]
            if (organization_name == "") {
              organization_name <- NULL
            }
            # Initialize electronicMailAddress
            email <- d$email[i]
            if (email == "") {
              email <- NULL
            }
            # Add creator
            if (d$role[i] == "creator") {
              out$dataSource$creator[[length(out$dataSource$creator) + 1]] <- 
                list(
                  individualName = individual_name,
                  organizationName = organization_name,
                  electronicMailAddress = email)
            }
            # Add contact
            if (d$role[i] == "contact") {
              out$dataSource$contact[[length(out$dataSource$contact) + 1]] <- 
                list(
                  individualName = individual_name,
                  organizationName = organization_name,
                  electronicMailAddress = email)
            }
          }
          out
        })
      # Add to eml
      eml$dataset$methods$methodStep <- c(eml$dataset$methods$methodStep, provenance)
    }

  }

  # Create <project> ----------------------------------------------------------
  # The project metadata corresponding to the first "pi" listed in 
  # personnel.txt will become the primary project. Project metadata listed 
  # under supbsequent "pi" will become related projects in the order they are 
  # listed.
  
  if (!is.null(x$template$personnel.txt)) {
    use_i <- tolower(x$template$personnel.txt$content$role) == "pi"
    if (any(use_i)){
      invisible(
        lapply(
          which(use_i),
          function(k) {
            if (k == min(which(use_i))) {
              message("    <project>")
              eml$dataset$project <<- list(
                title = x$template$personnel.txt$content$projectTitle[k],
                personnel = set_person(info_row = k, person_role = "pi"),
                funding = x$template$personnel.txt$content$funding[k])
            } else {
              message("      <relatedProject>")
              eml$dataset$project$relatedProject[[
                length(eml$dataset$project$relatedProject)+1]] <<- list(
                  title = x$template$personnel.txt$content$projectTitle[k],
                  personnel = set_person(info_row = k, person_role = "pi"),
                  funding = x$template$personnel.txt$content$funding[k])
            }
          }))
    }
  }

  # Create <dataTable> --------------------------------------------------------
  
  if (!is.null(x$data.table)) {
    
    eml$dataset$dataTable <- lapply(
      names(x$data.table),
      function(k) {
        
        # Get corresponding table_attributes.txt
        tbl_attr <- x$template[[
          paste0("attributes_", tools::file_path_sans_ext(k), ".txt")]]$content
        
        # Break if no table_attributes.txt
        if (is.null(tbl_attr)) {
          return()
        }
        
        message(paste0("    <dataTable> (", k, ")"))
        
        # Add attributes.txt contents to the data frame input expected by 
        # EML::set_attributes().
        # FIXME: Order of attributes listed in the template may not be match 
        # the order listed in the table so ... reorder attributes according
        # to the data table listing.
        
        attributes <- data.frame(
          attributeName = tbl_attr$attributeName,
          formatString = tbl_attr$dateTimeFormatString,
          unit = tbl_attr$unit,
          numberType = "",
          definition = "",
          attributeDefinition = tbl_attr$attributeDefinition,
          columnClasses = tbl_attr$class,
          minimum = NA,
          maximum = NA,
          missingValueCode = tbl_attr$missingValueCode,
          missingValueCodeExplanation = tbl_attr$missingValueCodeExplanation,
          stringsAsFactors = F)
        
        # Update missingValueCode - NA must be "NA" otherwise it will not be 
        # listed in the EML
        
        attributes$missingValueCode[is.na(attributes$missingValueCode)] <- "NA"
        
        # Update non-numeric attributes - categorical and character classes must 
        # have a numberType of "character" and their attributeDefinition must be 
        # listed under "defintion. date and categorical classes must be listed as 
        # "Date" and "factor" respectively
        
        use_i <- (attributes$columnClasses == "categorical") | 
          (attributes$columnClasses == "character")
        attributes$numberType[use_i] <- "character"
        attributes$definition[use_i] <- attributes$attributeDefinition[use_i]
        attributes$columnClasses[
          attributes$columnClasses == "date"] <- "Date"
        attributes$columnClasses[
          attributes$columnClasses == "categorical"] <- "factor"
        
        # Update numeric attributes - Remove NA and missingValueCode for 
        # calculations. Get minimum and maximum values. Infer numberType
        
        for (i in which(tbl_attr$class == "numeric")) {
          a <- x$data.table[[k]]$content[[tbl_attr$attributeName[i]]][
            !is.na(x$data.table[[k]]$content[[tbl_attr$attributeName[i]]])]
          a <- a[a != tbl_attr$missingValueCode[i]]
          a <- as.numeric(a)
          if (all(is.na(a))) {
            attributes$minimum[i] <- NA
            attributes$maximum[i] <- NA
          } else {
            attributes$minimum[i] <- min(a, na.rm = T)
            attributes$maximum[i] <- max(a, na.rm = T)
          }
          is_integer <-function(x, tol = .Machine$double.eps^0.5) {
            abs(x - round(x)) < tol
          }
          if (any(!is_integer(a))) {
            attributes$numberType[i] <- "real"
          } else if (!any(a < 1)) {
            attributes$numberType[i] <- "natural"
          } else if (any(a < 0)) {
            attributes$numberType[i] <- "integer"
          } else {
            attributes$numberType[i] <- "whole"
          }
          # FIXME: Calculate precision for numeric attributes. Alternatively
          # this should be added to the attributes template so precision can
          # be manually defined by the metadata creator.
        }
        
        # Create attributeList
        
        if (paste0("catvars_", tools::file_path_sans_ext(k), ".txt") %in% 
            names(x$template)) {
          attributeList <- suppressWarnings(
            EML::set_attributes(
              attributes[ , c(
                "attributeName", 
                "formatString",
                "unit",
                "numberType",
                "definition",
                "attributeDefinition",
                "minimum",
                "maximum",
                "missingValueCode",
                "missingValueCodeExplanation")],
              factors = x$template[[
                paste0(
                  "catvars_", 
                  tools::file_path_sans_ext(k), 
                  ".txt")]]$content,
              col_classes = attributes$columnClasses))
        } else {
          attributeList <- suppressWarnings(
            EML::set_attributes(
              attributes[ , c(
                'attributeName', 
                'formatString',
                'unit',
                'numberType',
                'definition',
                'attributeDefinition',
                'minimum',
                'maximum',
                'missingValueCode',
                'missingValueCodeExplanation')],
              col_classes = attributes$columnClasses))
        }
        
        # Set physical
        # FIXME: Auto-detect numHeaderLines
        physical <- suppressMessages(
          EML::set_physical(
            paste0(data.path, "/", k),
            numHeaderLines = "1",
            recordDelimiter = get_eol(
              path = data.path,
              file.name = k),
            attributeOrientation = "column",
            url = "placeholder"))
        
        if (!is.null(data.table.quote.character)) {
          # data.table.quote.character isn't required for each data table, but 
          # must have a non-NULL entry if other data tables have a quote 
          # character. A "" or NA indicates to skip assignment.
          quote_character <- data.table.quote.character[
            which(k == names(x$data.table))]
          if ((quote_character == "") | is.na(quote_character)) {
            physical$dataFormat$textFormat$simpleDelimited$quoteCharacter <- 
              NULL
          } else {
            physical$dataFormat$textFormat$simpleDelimited$quoteCharacter <- 
              quote_character
          }
        }
        
        if (!is.null(data.table.url)) {
          # data.table.url isn't required for each data table, but must have a 
          # non-NULL entry in the data.table.url if other data tables have a 
          # URL. A "" or NA indicates to skip URL assignment.
          url <- data.table.url[which(k == names(x$data.table))]
          if ((url == "") | is.na(url)) {
            physical$distribution <- list()
          } else {
            physical$distribution$online$url <- url
          }
        } else {
          physical$distribution <- list()
        }
        
        fdlim <- detect_delimeter(
          path = data.path,
          data.files = k,
          os = detect_os())
        if (fdlim == "\t") {
          fdlim <- "\\t" # requires escape char to be written, otherwise is blank
        }
        physical$dataFormat$textFormat$simpleDelimited$fieldDelimiter <- fdlim
        
        # Create dataTable
        
        data_table <- list(
          entityName = data.table.name[which(k == names(x$data.table))],
          entityDescription = data.table.description[which(k == names(x$data.table))],
          physical = physical,
          attributeList = attributeList,
          numberOfRecords = as.character(nrow(x$data.table[[k]]$content)))
        
        # FIXME: EML v2.0.0 handles absense of missingValue codes differently
        # than EML v 1.0.3. This fixes the issue here, though it may be better
        # to implement the fix in EML v2.0.0.
        for (j in seq_along(data_table$attributeList$attribute)){
          if (data_table$attributeList$attribute[[j]]$missingValueCode$code == ''){
            data_table$attributeList$attribute[[j]]$missingValueCode$code <- NA_character_
            data_table$attributeList$attribute[[j]]$missingValueCode$codeExplanation <- NA_character_
          }
        }
        
        data_table

      }
    )
  }
  
  # Create <otherEntity> ------------------------------------------------------
  
  if (!is.null(x$other.entity)) {
    eml$dataset$otherEntity <- lapply(
      names(x$other.entity),
      function(k) {
        message(paste0("    <otherEntity> (", k, ")"))
        # Set physical
        # FIXME: Some sub-routine in EML::set_physical() doesn't like the .zip 
        # file extension, so we suppress the warning here so users aren't 
        # uneccessarily burdened by it. Not a great solution since helpful 
        # warnings will be lost.
        physical <- suppressWarnings(
          suppressMessages(
            EML::set_physical(
              paste0(data.path, "/", k))))
        physical$dataFormat$textFormat <- NULL
        physical$dataFormat$externallyDefinedFormat$formatName <- mime::guess_type(
          file = k, unknown = "Unknown", empty = "Unknown")
        if (!is.null(other.entity.url)) {
          # other.entity.url isn't required for each data table, but must have a 
          # non-NULL entry in the other.entity.url if other data tables have a 
          # URL. A "" or NA indicates to skip URL assignment.
          url <- other.entity.url[which(k == names(x$other.entity))]
          if ((url == "") | is.na(url)) {
            physical$distribution <- list()
          } else {
            physical$distribution$online$url <- url
          }
        } else {
          physical$distribution <- list()
        }
        # Create otherEntity
        list(
          entityName = other.entity.name[
            which(k == names(x$other.entity))],
          entityDescription = other.entity.description[
            which(k == names(x$other.entity))],
          physical = physical,
          entityType = "unknown")
      })
  }
  
  # Create <additionalMetadata> -----------------------------------------------
  if (!is.null(x$template$custom_units.txt)) {
    message("  <additionalMetadata>")
    eml$additionalMetadata[[
      length(eml$dataset$additionalMetadata)+1]]$metadata$unitList <- EML::set_unitList(
        x$template$custom_units.txt$content)
  }

  message("  <additionalMetadata>")
  eml$additionalMetadata[[
    length(eml$additionalMetadata)+1]] <- EML::eml$additionalMetadata(
      metadata = list(emlEditor = list(
        "app" = "EMLassemblyline",
        "release" = read.dcf(system.file("DESCRIPTION", package = "EMLassemblyline"))[[3]])))
  
  # Create <annotations> ------------------------------------------------------

  if (any(stringr::str_detect(names(x$template), "annotations.txt"))) {
    message("  <annotations>")
    eml <- suppressMessages(
      annotate_eml(
        annotations = x$template$annotations.txt$content,
        eml.in = eml))
  }
  
  # Write EML -----------------------------------------------------------------
  
  message("</eml>")
  if (isTRUE(write.file)) {
    message(paste0("Writing EML (", package.id, ".xml)"))
    emld::eml_version("eml-2.2.0")
    EML::write_eml(eml, paste0(eml.path, "/", package.id, ".xml"))
    # Fix TextType nodes - EML::set_TextType() and EML::set_methods() replace
    # special XML characters &, <, >, with their encoded representations. These
    # characters are encoded a second time by EML::write_eml() resulting in 
    # replacement of "&" by "&amp;" resulting in "&amp;gt;" etc. The below code
    # block patches this issue.
    txt <- readLines(paste0(eml.path, "/", package.id, ".xml"), encoding = "UTF-8")
    invisible(
      lapply(
        seq_along(txt),
        function(x) {
          txt[x] <<- stringr::str_replace_all(txt[x], "&amp;gt;", "&gt;")
          txt[x] <<- stringr::str_replace_all(txt[x], "&amp;lt;", "&lt;")
          txt[x] <<- stringr::str_replace_all(txt[x], "&amp;amp;", "&amp;")
        }))
    writeLines(txt, paste0(eml.path, "/", package.id, ".xml"), useBytes = T)
    
    if ("methods.md" %in% names(x$template)) {
      fix_methods(eml = paste0(eml.path, "/", package.id, ".xml"))
      eml <- EML::read_eml(paste0(eml.path, "/", package.id, ".xml"))
    }
  }
  
  # Validate EML --------------------------------------------------------------

  message("Validating EML")
  r <- EML::eml_validate(eml)
  if (isTRUE(r)) {
    message("  Validation passed :)")
  } else {
    message("  Validation failed :(")
  }
  message("Done.")
  
  if (isTRUE(return.obj)) {
    eml
  }
  
}
EDIorg/emlAssemblyLine documentation built on Nov. 4, 2022, 11:59 p.m.