[base] general read in function for includes

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))
         }
     }

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))