Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
#===== build_redux_doc =====
#'build_redux_doc
#'@description Builds an XML document based on the findings of analyse_xml.
#' Calls recursive function `build_redux_tree` internally.
#'@param path string: See ?analyse_xml
#'@param pattern string: See ?analyse_xml
#'@param xpath string: See ?analyse_xml
#'@param export_path string: Path to export the XML document to
build_redux_doc <- function(path,
pattern,
xpath,
export_path){
if(missing(benchmark_path)){
benchmark_path <- unlist(options("r2ogs6.default_benchmark_path"))
}
assertthat::assert_that(assertthat::is.string(benchmark_path))
# Default to
if(missing(pattern) && missing(xpath)){
pattern <- "\\.prj$"
xpath <- "/OpenGeoSysProject"
}
assertthat::assert_that(assertthat::is.string(pattern))
assertthat::assert_that(assertthat::is.string(xpath))
assertthat::assert_that(assertthat::is.string(export_path))
redux_node <- build_redux_tree(path = benchmark_path,
pattern = pattern,
xpath = xpath,
required = TRUE)
redux_doc <- xml2::as_xml_document(redux_node)
xml2::write_xml(redux_doc, export_path)
return(invisible())
}
#===== build_redux_tree =====
#'build_redux_tree
#'@description Builds an XML tree based on the findings of analyse_xml.
#' This is a recursive function. Handle with care.
#'@param path string: See ?analyse_xml
#'@param pattern string: See ?analyse_xml
#'@param xpath string: See ?analyse_xml
#'@param required flag: Recursion utility
build_redux_tree <- function(path,
pattern,
xpath,
required){
analysis_results <- analyse_xml(path = path,
pattern = pattern,
xpath = xpath,
print_findings = FALSE)
xpath <- analysis_results[["xpath"]]
children <- names(analysis_results[["children"]])
attr_names <- names(analysis_results[["attributes"]])
# Create a redux base node
redux_node <- list(structure(list()))
names(redux_node) <- get_tag_from_xpath(xpath)
attributes(redux_node[[1]])$required <- required
if(length(attr_names) > 0){
attr_names_str <- paste(attr_names, collapse = " ")
attributes(redux_node[[1]])$attr_names <- attr_names_str
}
# Recursion stops here
if(length(children) == 0){
attributes(redux_node[[1]])$read_content_as <- "string"
return(invisible(redux_node))
}
redux_node_attrs <- c(list(read_content_as = "list"),
attributes(redux_node[[1]]))
for(i in seq_len(length(children))){
new_xpath <- paste0(xpath, "/", children[[i]])
required <- analysis_results[["children"]][[i]]
child_redux_node <-
build_redux_tree(path = path,
pattern = pattern,
xpath = new_xpath,
required = required)
redux_node[[1]] <- c(redux_node[[1]],
list(child_redux_node))
}
# Needed because attributes get lost when adding to redux_node[[1]]
attributes(redux_node[[1]]) <- redux_node_attrs
return(invisible(redux_node))
}