[base] Changed read_in_*.R to fit new .vtu and .gml class definition

R/read_in_gml.R

 #Functions to read in data from a .gml file to an OGS6 object
 
 
-#'read_in_gml
-#'@description Wrapper function to read in a whole .gml file
-#'@param gml_path The path to the geometry file that should be read in
-#'@export
-read_in_gml <- function(gml_path) {
-
-    xml_doc <- validate_read_in_xml(gml_path)
-
-    name <- xml2::xml_text(xml2::xml_find_first(xml_doc, "//name"))
-    points <- read_in_points(xml_doc)
-    polylines <- read_in_polylines(xml_doc)
-    surfaces <- read_in_surfaces(xml_doc)
-
-    return(invisible(r2ogs6_gml(name,
-                                points,
-                                polylines,
-                                surfaces)))
-}
-
-
 #'read_in_points
 #'@description Reads points from a .gml file
 #'@param xml_doc A parsed XML document (of class 'xml2::xml_document')
@@ -46,8 +26,7 @@ read_in_points <- function(xml_doc) {
                                         x = as.double(attrs[["x"]]),
                                         y = as.double(attrs[["y"]]),
                                         z = as.double(attrs[["z"]]),
-                                        name = point_name,
-                                        )
+                                        name = point_name)
     }
 
     return(invisible(points_tibble))

R/read_in_prj.R

@@ -5,19 +5,21 @@
 #'@description Wrapper function to read in a whole .prj file
 #'@param ogs6_obj OGS6: Simulation object
 #'@param prj_path string: Path to the project file that should be read in
+#'@param read_in_gml flag: Optional: Should .gml file just be copied or read in
+#' too? If this parameter is missing and the .gml file contains <= the
+#' number of lines in `options("r2ogs6.max_lines_gml")`, the .gml will be read
+#' in. Else, only the geometry reference will be saved.
 #'@param read_in_vtu flag: Should .vtu file just be copied or read in too?
-#'@param read_in_gml flag: Should .gml file just be copied or read in too?
 #'@export
 read_in_prj <- function(ogs6_obj,
                         prj_path,
-                        read_in_vtu = FALSE,
-                        read_in_gml = TRUE){
+                        read_in_gml,
+                        read_in_vtu = FALSE){
 
     assertthat::assert_that("OGS6" %in% class(ogs6_obj))
     xml_doc <- validate_read_in_xml(prj_path)
 
     assertthat::assert_that(assertthat::is.flag(read_in_vtu))
-    assertthat::assert_that(assertthat::is.flag(read_in_gml))
 
     # Geometry reference
     gml_ref_node <- xml2::xml_find_first(xml_doc, "/OpenGeoSysProject/geometry")
@@ -29,8 +31,17 @@ read_in_prj <- function(ogs6_obj,
         gml_path <- paste0(dirname(prj_path), "/",
                            xml2::xml_text(gml_ref_node))
 
+        # If read_in_gml isn't supplied, check number of lines in .gml file
+        # since string concatenation is slow
+        if(missing(read_in_gml)){
+            read_in_gml <- (length(readLines(gml_path)) <=
+                                unlist(options("r2ogs6.max_lines_gml")))
+        }
+
+        assertthat::assert_that(assertthat::is.flag(read_in_gml))
+
         if(read_in_gml){
-            ogs6_obj$add_gml(read_in_gml(gml_path))
+            ogs6_obj$add_gml(OGS6_gml$new(gml_path))
         }else{
             ogs6_obj$add_gml(gml_path)
         }
@@ -43,6 +54,7 @@ read_in_prj <- function(ogs6_obj,
 
     for(i in seq_along(vtu_ref_nodes)){
         vtu_ref <- xml2::xml_text(vtu_ref_nodes[[i]])
+
         vtu_path <- paste0(dirname(prj_path), "/", vtu_ref)
 
         # Read in .vtu file(s) or just save their path
@@ -50,16 +62,36 @@ read_in_prj <- function(ogs6_obj,
                          read_in_vtu = read_in_vtu)
     }
 
-    impl_classes <- get_implemented_classes()
+    prj_components <- addable_prj_components()
+
+    # 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"]]
+
+        if(grepl("^\\.\\.", file_reference)){
+            file_reference <- gsub("^\\.\\.", "", file_reference)
+            file_reference <- paste0(dirname(dirname(prj_path)), file_reference)
+        }else{
+            file_reference <- paste0(dirname(prj_path), "/", file_reference)
+        }
+
+        ogs6_obj$processes <- file_reference
+        prj_components <- prj_components[names(prj_components) != "processes"]
+    }
+
 
-    for(i in seq_len(length(impl_classes))){
+    for(i in seq_len(length(prj_components))){
 
-        class_tag_name <- get_class_tag_name(impl_classes[[i]])
+        class_tag_name <- get_class_tag_name(prj_components[[i]])
 
         # Differentiate between wrapper lists and singular objects
-        if(class_tag_name != names(impl_classes)[[i]]){
+        if(class_tag_name != names(prj_components)[[i]]){
             read_in(ogs6_obj, prj_path, paste0("/OpenGeoSysProject/",
-                                               names(impl_classes)[[i]],
+                                               names(prj_components)[[i]],
                                                "/",
                                                class_tag_name))
         }else{

R/read_in_utils.R

@@ -183,21 +183,20 @@ node_to_r2ogs6_class_object <- function(xml_node,
 #'@description Returns representation of an XML node. This is a recursive
 #' function.
 #'ASSUMPTIONS:
-#'1) Leaf nodes will have EITHER a value OR attributes (and will not be missing
-#' both, e.g. '<a/>').
-#'2) Leaf nodes will never be r2ogs6_* objects
-#'3) If there are multiple occurrences of r2ogs6_* class (and subclass)
+#'1) Leaf nodes will never be r2ogs6_* objects
+#'2) If there are multiple occurrences of r2ogs6_* class (and subclass)
 #' elements on the same level, they have a wrapper node as their parent
 #' (e.g. <processes>, <properties>) which  will contain ONLY elements of this
 #' type
-#'4) Wrapper nodes are represented as lists
-#'5) Parent nodes whose children have no children are represented as lists
+#'3) Wrapper nodes are represented as lists
+#'4) Parent nodes whose children have no children are represented as lists
 #'@param xml_node xml2::xml_node: XML node
-#'@param xpath_expr string: XPath expression (for subclass differentiation)
+#'@param xpath_expr string: Optional: XPath expression (for subclass
+#' differentiation)
 #'@param subclasses_names character: Optional: Names of `r2ogs6` subclasses
 #' (`r2ogs6` classes without a OGS6$add method)
 node_to_object <- function(xml_node,
-                           xpath_expr,
+                           xpath_expr = "",
                            subclasses_names = character()){
 
     assertthat::assert_that("xml_node" %in% class(xml_node))
@@ -207,11 +206,22 @@ node_to_object <- function(xml_node,
 
     #Node is leaf
     if(length(xml2::xml_children(xml_node)) == 0){
-        if(xml2::xml_text(xml_node) != ""){
+
+        xml_text_clean <-
+            stringr::str_remove_all(xml2::xml_text(xml_node),
+                                    "[\n|[:space:]]")
+
+        if(xml_text_clean != "" &&
+           length(xml2::xml_attrs(xml_node)) != 0){
+            return(invisible(c(xml2::xml_attrs(xml_node),
+                               xml_text = xml2::xml_text(xml_node))))
+        }
+
+        if(xml_text_clean != ""){
             return(invisible(xml2::xml_text(xml_node)))
-        }else{
-            return(invisible(xml2::xml_attrs(xml_node)))
         }
+
+        return(invisible(xml2::xml_attrs(xml_node)))
     }
 
     #Node is represented by subclass