From e11a5c012a54be4a84083f5695c2926baf02f0fc Mon Sep 17 00:00:00 2001
From: Johannes Boog <johannesboog@yahoo.de>
Date: Wed, 7 Dec 2022 22:55:50 +0100
Subject: [PATCH] [base] general read in function for includes
---
R/read_in_prj.R | 102 +++++++++++++++++++++++++++++++---------------
R/read_in_utils.R | 36 ++++++++++++++--
2 files changed, 102 insertions(+), 36 deletions(-)
diff --git a/R/read_in_prj.R b/R/read_in_prj.R
index 35b3e2a..467c994 100644
--- a/R/read_in_prj.R
+++ b/R/read_in_prj.R
@@ -11,19 +11,66 @@
#' <= \code{options("r2ogs6.max_lines_gml")}, the \code{.gml} will be read in.
#' Else, only the geometry reference will be saved.
#' @param read_in_vtu flag: Should \code{.vtu} file just be copied or read in
-#' too?
+#' @param read_includes flag: Should files referenced in \code{include}
+#' tages be read in?
#' @export
read_in_prj <- function(ogs6_obj,
prj_path,
read_in_gml,
- read_in_vtu = FALSE){
+ read_in_vtu = FALSE,
+ read_includes = FALSE){
assertthat::assert_that("OGS6" %in% class(ogs6_obj))
assertthat::assert_that(assertthat::is.string(prj_path))
assertthat::assert_that(assertthat::is.flag(read_in_vtu))
+ assertthat::assert_that(assertthat::is.flag(read_includes))
xml_doc <- validate_read_in_xml(prj_path)
prj_base_path <- dirname(prj_path)
+ prj_components <- ogs6_prj_top_level_classes()
+
+ # handle includes
+ incld_nds <- xml2::xml_find_all(xml_doc, ".//include")
+ for(i in seq_along(incld_nds)){
+
+ # get parent to have parent node name for include file
+ parent <- xml2::xml_parent(incld_nds[[i]])
+ parent_name <- xml2::xml_name(parent)
+
+ if(!(parent_name %in% c("OpenGeoSysProject", names(prj_components)))){
+ warning(
+ paste0("<include> can only be read from top level tags! ",
+ xml2::xml_name(incld_nds[[i]]), " will be skipped."))
+ next
+ }
+
+ # get filepath
+ incld_path <- xml2::xml_attr(incld_nds[[i]], attr = "file")
+ incld_path <- make_abs_path(incld_path, prj_base_path)
+
+ if(read_includes == TRUE){
+
+ # read and add along xml_doc childs
+ incld_xml <- validate_read_include(incld_path, parent_name)
+ childs <- xml2::xml_children(parent)
+ xml2::xml_add_sibling(childs, incld_xml, .where = "after")
+ xml2::xml_remove(incld_nds[[i]])
+
+ }else{
+
+ # make ogs6_obj$... call
+ if(parent_name == "OpenGeoSysProject") parent_name<-"include"
+
+ eval(parse(text =
+ paste0("ogs6_obj$", parent_name, "<- \'", incld_path, "\'")))
+
+ if(parent_name != "include"){
+ prj_components <-
+ prj_components[names(prj_components) != parent_name]
+ }
+ }
+ }
+
# Geometry reference
gml_ref_node <- xml2::xml_find_first(xml_doc, "/OpenGeoSysProject/geometry")
@@ -57,41 +104,30 @@ read_in_prj <- function(ogs6_obj,
"/OpenGeoSysProject/meshes/*")
}
- for(i in seq_along(vtu_ref_nodes)){
- vtu_ref <- xml2::xml_text(vtu_ref_nodes[[i]])
- vtu_ref <- stringr::str_trim(vtu_ref)
- vtu_ref <- stringr::str_remove_all(vtu_ref, "[\n]")
- vtu_path <- make_abs_path(vtu_ref, prj_base_path)
+ if(!is.null(vtu_ref_nodes) & length(vtu_ref_nodes) != 0){
- axisym_val <- xml2::xml_attr(vtu_ref_nodes[[i]], "axially_symmetric")
+ for(i in seq_along(vtu_ref_nodes)){
+ vtu_ref <- xml2::xml_text(vtu_ref_nodes[[i]])
+ vtu_ref <- stringr::str_trim(vtu_ref)
+ vtu_ref <- stringr::str_remove_all(vtu_ref, "[\n]")
+ vtu_path <- make_abs_path(vtu_ref, prj_base_path)
- if(!is.na(axisym_val) && axisym_val == "true"){
- axisym_val <- TRUE
- }else{
- axisym_val <- FALSE
- }
+ axisym_val <- xml2::xml_attr(vtu_ref_nodes[[i]], "axially_symmetric")
- # Read in .vtu file(s) or just save their path
- ogs6_obj$add_mesh(path = vtu_path,
- axisym = axisym_val,
- read_in_vtu = read_in_vtu)
- }
+ if(!is.na(axisym_val) && axisym_val == "true"){
+ axisym_val <- TRUE
+ }else{
+ axisym_val <- FALSE
+ }
- prj_components <- ogs6_prj_top_level_classes()
-
- # Read include file reference
- processes_include_node <-
- xml2::xml_find_first(xml_doc,
- "/OpenGeoSysProject/processes/include")
-
- if(!any(grepl("xml_missing", class(processes_include_node), fixed = TRUE))){
- file_reference <- xml2::xml_attrs(processes_include_node)[["file"]]
- file_reference <- make_abs_path(file_reference, prj_base_path)
-
- ogs6_obj$processes <- file_reference
- prj_components <- prj_components[names(prj_components) != "processes"]
+ # Read in .vtu file(s) or just save their path
+ ogs6_obj$add_mesh(path = vtu_path,
+ axisym = axisym_val,
+ read_in_vtu = read_in_vtu)
+ }
}
+
# Read python script references
python_script_node <-
xml2::xml_find_first(xml_doc,
@@ -114,12 +150,12 @@ read_in_prj <- function(ogs6_obj,
# Differentiate between wrapper lists and singular objects
if(class_tag_name != names(prj_components)[[i]]){
- read_in(ogs6_obj, prj_path, paste0("/OpenGeoSysProject/",
+ read_in(ogs6_obj, xml_doc, paste0("/OpenGeoSysProject/",
names(prj_components)[[i]],
"/",
class_tag_name))
}else{
- read_in(ogs6_obj, prj_path, paste0("/OpenGeoSysProject/",
+ read_in(ogs6_obj, xml_doc, paste0("/OpenGeoSysProject/",
class_tag_name))
}
}
diff --git a/R/read_in_utils.R b/R/read_in_utils.R
index 31941ea..530fd38 100644
--- a/R/read_in_utils.R
+++ b/R/read_in_utils.R
@@ -27,21 +27,51 @@ validate_read_in_xml <- function(path){
}
+#' validate_read_include
+#' @description Utility function, tries to parse the provided file as XML or
+#' reads in as string and converts to XML.
+#' @param path string: A file to be parsed.
+#' @param parent_name string: Name of the parent node that has to be added
+#' in case \code{path} is read in as string and converted to XML.
+#' @return The parsed file as class object of type \code{xml2::xml_document}).
+#' @noRd
+validate_read_include <- function(path, parent_name){
+
+ assertthat::assert_that(assertthat::is.string(path))
+
+ incld_xml <- tryCatch(
+ {
+ return(invisible(xml2::read_xml(path, encoding="ISO-8859-1")))
+ },
+ error = function(e){
+
+ incld_str <- suppressWarnings(readLines(path))
+ incld_str <- paste(c(paste0("<", parent_name, ">"), incld_str,
+ paste0("</", parent_name, ">")),
+ collapse = " ")
+ incld_xml <- xml2::read_xml(incld_str)
+ incld_xml <- xml2::xml_children(incld_xml)
+ return(invisible(incld_xml))
+ }
+ )
+}
+
#===== General read_in utility =====
#' read_in
#' @description Reads in elements from a file
#' @param ogs6_obj A OGS6 class object
-#' @param path string: Path to file XML elements should be read from
+#' @param xml_doc A xml_document class object.
#' @param xpath string: An XPath expression (should be absolute!)
#' @noRd
read_in <- function(ogs6_obj,
- path,
+ xml_doc,
xpath){
assertthat::assert_that("OGS6" %in% class(ogs6_obj))
- xml_doc <- validate_read_in_xml(path)
+ assertthat::assert_that("xml_document" %in% class(xml_doc))
+ #xml_doc <- validate_read_in_xml(path)
assertthat::assert_that(assertthat::is.string(xpath))
--
GitLab