[bugfix] found cause for random crashes, fixed export

R/export_gml.R

@@ -18,8 +18,7 @@ export_gml <- function(gml, path) {
 
   xml2::xml_add_child(gml_xml,
                       xml2::as_xml_document(
-                        to_node(gml$name)),
-                      .copy = FALSE)
+                        to_node(gml$name)))
 
   # If the points are in a tibble, coerce it to list for exporting
   points_list <- gml$points
@@ -47,8 +46,7 @@ export_gml <- function(gml, path) {
   xml2::xml_add_child(gml_xml,
                       xml2::as_xml_document(
                         to_node(points_list,
-                                "points", c("point"))),
-                      .copy = FALSE)
+                                "points", c("point"))))
 
   if(!is.null(gml$polylines)){
 
@@ -66,8 +64,7 @@ export_gml <- function(gml, path) {
                         xml2::as_xml_document(
                           to_node(polylines_with_ids,
                                   "polylines", c("name",
-                                                 "id"))),
-                        .copy = FALSE)
+                                                 "id"))))
   }
 
   if(!is.null(gml$surfaces)){
@@ -84,8 +81,7 @@ export_gml <- function(gml, path) {
                           to_node(surfaces_with_ids,
                                   "surfaces", c("name",
                                                 "id",
-                                                "element"))),
-                        .copy = FALSE)
+                                                "element"))))
   }
 
   xml2::write_xml(gml_xml, path, options = "format", encoding="ISO-8859-1")

R/export_prj.R

@@ -6,6 +6,12 @@
 #'@param ogs6_obj OGS6: Simulation object
 export_prj <- function(ogs6_obj) {
 
+    prj_xml <- xml2::xml_new_root(
+        .value = "OpenGeoSysProject",
+        .version = "1.0",
+        .encoding = "ISO-8859-1"
+    )
+
     meshes_node <- NULL
 
     #If there is a .gml defined, add "mesh" node, else add "meshes" node
@@ -16,17 +22,18 @@ export_prj <- function(ogs6_obj) {
         meshes_node <- to_node(basename(ogs6_obj$meshes[[1]]), "mesh")
     }
 
-    # First instantiate our big wrapper list
-    prj_node <- list(OpenGeoSysProject = list())
-
-    special_cases <- c("meshes",
+    special_cases <- c("vtus",
+                       "meshes",
                        "gml")
 
     #Handle special cases
-    prj_node[[1]] <- c(prj_node[[1]], list(meshes_node))
+    xml2::xml_add_child(prj_xml,
+                        xml2::as_xml_document(meshes_node))
 
     if(!is.null(ogs6_obj$geometry)){
-        prj_node[[1]] <- c(prj_node[[1]], list(to_node(ogs6_obj$geometry)))
+        xml2::xml_add_child(
+            prj_xml,
+            xml2::as_xml_document(to_node(ogs6_obj$geometry)))
     }
 
     #Get implemented classes
@@ -36,6 +43,8 @@ export_prj <- function(ogs6_obj) {
     for(i in seq_len(length(impl_classes))){
         param_name <- names(impl_classes)[[i]]
 
+        # cat("\nHandling param", param_name, "\n")
+
         #If parameter was a special case we already handled, skip
         if(param_name %in% special_cases){
             next
@@ -51,14 +60,20 @@ export_prj <- function(ogs6_obj) {
 
         to_node_call <- paste0("to_node(ogs6_obj$", param_name, ")")
         param_node <- eval(parse(text = to_node_call))
-        prj_node[[1]] <- c(prj_node[[1]], list(param_node))
+
+        xml2::xml_add_child(prj_xml,
+                            xml2::as_xml_document(param_node))
     }
 
     file <- paste0(ogs6_obj$sim_path, ogs6_obj$sim_name, ".prj")
 
-    prj_xml <- xml2::as_xml_document(prj_node)
+    cat("\nWriting XML to ", file, "\n")
+    xml2::write_xml(prj_xml,
+                    file,
+                    options = "format",
+                    encoding="ISO-8859-1")
 
-    xml2::write_xml(prj_xml, file, options = "format", encoding="ISO-8859-1")
+    cat("\nDone writing XML.\n")
 
-    return(invisible())
+    return(invisible(TRUE))
 }