diff --git a/R/read_in_gml.R b/R/read_in_gml.R
index 402be93d785b923ae16e60bdb4337ecd8f4868f5..0fa4c409c53b3b47b9f77cba251b2c0345b17bbd 100644
--- a/R/read_in_gml.R
+++ b/R/read_in_gml.R
@@ -1,26 +1,6 @@
#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))
diff --git a/R/read_in_prj.R b/R/read_in_prj.R
index c4de63691fc57d67972adcc35bb047a41b439e4f..4cfd603be4ad1e4a20cc1123eefc5dac55f1ff67 100644
--- a/R/read_in_prj.R
+++ b/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{
diff --git a/R/read_in_utils.R b/R/read_in_utils.R
index c0e541162d8b365fbd97efb543746a6e7a798338..e11a62d41a50479281ad2cf5bcba502e596b1bb3 100644
--- a/R/read_in_utils.R
+++ b/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