From 67e223f6d9a8a08a855885bbbedf18c3dcd192cd Mon Sep 17 00:00:00 2001
From: Stefano Zacchiroli <zack@upsilon.cc>
Date: Tue, 6 Sep 2005 09:06:38 +0000
Subject: [PATCH] added <include href="foo/bar/baz.xml" /> support

---
 helm/ocaml/registry/helm_registry.ml         | 20 ++++++++++++--------
 helm/ocaml/registry/tests/sample.xml         | 18 +++---------------
 helm/ocaml/registry/tests/sample_include.xml | 15 +++++++++++++++
 3 files changed, 30 insertions(+), 23 deletions(-)
 create mode 100644 helm/ocaml/registry/tests/sample_include.xml

diff --git a/helm/ocaml/registry/helm_registry.ml b/helm/ocaml/registry/helm_registry.ml
index 8ee95ca30..09582eafe 100644
--- a/helm/ocaml/registry/helm_registry.ml
+++ b/helm/ocaml/registry/helm_registry.ml
@@ -25,7 +25,7 @@
 
 open Printf
 
-let debug = false
+let debug = true
 let debug_print s =
   if debug then prerr_endline ("Helm_registry debugging: " ^ s)
 
@@ -262,17 +262,21 @@ let save_to registry fname =
   Xml.pp_to_outchan token_stream oc;
   close_out oc
 
-let load_from_absolute registry fname =
-  let path = ref [] in      (* <section> elements entered so far *)
+let rec load_from_absolute ?path registry fname =
+  let _path = ref (match path with None -> [] | Some p -> p)in
+    (* <section> elements entered so far *)
   let in_key = ref false in (* have we entered a <key> element? *)
   let cdata = ref "" in     (* collected cdata (inside <key> *)
-  let push_path name = path := name :: !path in
-  let pop_path () = path := List.tl !path in
+  let push_path name = _path := name :: !_path in
+  let pop_path () = _path := List.tl !_path in
   let start_element tag attrs =
     match tag, attrs with
     | "section", ["name", name] -> push_path name
     | "key", ["name", name] -> in_key := true; push_path name
     | "helm_registry", _ -> ()
+    | "include", ["href", fname] ->
+        debug_print ("including file " ^ fname);
+        load_from_absolute ~path:!_path registry fname
     | tag, _ ->
         raise (Parse_error (fname, ~-1, ~-1,
           (sprintf "unexpected element <%s> or wrong attribute set" tag)))
@@ -281,12 +285,12 @@ let load_from_absolute registry fname =
     match tag with
     | "section" -> pop_path ()
     | "key" ->
-        let key = String.concat "." (List.rev !path) in
+        let key = String.concat "." (List.rev !_path) in
         set registry ~key ~value:!cdata;
         cdata := "";
         in_key := false;
         pop_path ()
-    | "helm_registry" -> ()
+    | "include" | "helm_registry" -> ()
     | _ -> assert false
   in
   let character_data text =
@@ -300,7 +304,7 @@ let load_from_absolute registry fname =
   } in
   let xml_parser = XmlPushParser.create_parser callbacks in
   let backup = backup_registry registry in
-  Hashtbl.clear registry;
+  if path = None then Hashtbl.clear registry;
   try
     XmlPushParser.parse xml_parser (`File fname)
   with exn ->
diff --git a/helm/ocaml/registry/tests/sample.xml b/helm/ocaml/registry/tests/sample.xml
index 33e1c6589..a72546bf7 100644
--- a/helm/ocaml/registry/tests/sample.xml
+++ b/helm/ocaml/registry/tests/sample.xml
@@ -8,6 +8,9 @@
     <key name="mode">remote</key>
     <key name="url">http://localhost:58081</key>
   </section>
+  <section name="triciclo">
+    <include href="sample_include.xml" />
+  </section>
   <section name="types">
     <key name="string">debian</key>
     <key name="int">1</key>
@@ -19,21 +22,6 @@
     <key name="int_list">19</key>
     <key name="int_float_pair">19 23.2</key>
   </section>
-  <section name="triciclo">
-    <section name="foo1">
-      <key name="bar2">aaa</key>
-      <key name="bar3">bbb</key>
-    </section>
-    <section name="foo2">
-      <key name="bar1">quux</key>
-    </section>
-    <key name="basedir">/public/helm_library</key>
-    <key name="constant_type_file">$(triciclo.basedir)/constanttype</key>
-    <key name="environment_file">$(triciclo.basedir)/environment</key>
-    <key name="inner_types_file">$(triciclo.basedir)/innertypes</key>
-    <key name="proof_file">$(triciclo.basedir)/currentproof</key>
-    <key name="proof_file_type">$(triciclo.basedir)/currentprooftype</key>
-  </section>
   <section name="uwobo">
     <key name="url">http://localhost:58080/</key>
   </section>
diff --git a/helm/ocaml/registry/tests/sample_include.xml b/helm/ocaml/registry/tests/sample_include.xml
new file mode 100644
index 000000000..8a6851998
--- /dev/null
+++ b/helm/ocaml/registry/tests/sample_include.xml
@@ -0,0 +1,15 @@
+<helm_registry>
+  <section name="foo1">
+    <key name="bar2">aaa</key>
+    <key name="bar3">bbb</key>
+  </section>
+  <section name="foo2">
+    <key name="bar1">quux</key>
+  </section>
+  <key name="basedir">/public/helm_library</key>
+  <key name="constant_type_file">$(triciclo.basedir)/constanttype</key>
+  <key name="environment_file">$(triciclo.basedir)/environment</key>
+  <key name="inner_types_file">$(triciclo.basedir)/innertypes</key>
+  <key name="proof_file">$(triciclo.basedir)/currentproof</key>
+  <key name="proof_file_type">$(triciclo.basedir)/currentprooftype</key>
+</helm_registry>
-- 
2.39.2