From b5eb40eed8e03f2ac2059c3ec9ec5f078ae320af Mon Sep 17 00:00:00 2001
From: Stefano Zacchiroli <zack@upsilon.cc>
Date: Mon, 16 Feb 2004 16:43:27 +0000
Subject: [PATCH] - more structured configuration file - commented out save_to
 since it's not yet implemented for the new XML format

---
 helm/ocaml/registry/.ocamlinit        |  2 +-
 helm/ocaml/registry/helm_registry.ml  | 61 ++++++++++++++++++++-------
 helm/ocaml/registry/helm_registry.mli | 14 ++++--
 helm/ocaml/registry/tests/sample.conf | 13 ------
 helm/ocaml/registry/tests/sample.xml  | 26 +++++++++---
 5 files changed, 76 insertions(+), 40 deletions(-)
 delete mode 100644 helm/ocaml/registry/tests/sample.conf

diff --git a/helm/ocaml/registry/.ocamlinit b/helm/ocaml/registry/.ocamlinit
index 49a371462..c5d8a80ef 100644
--- a/helm/ocaml/registry/.ocamlinit
+++ b/helm/ocaml/registry/.ocamlinit
@@ -1,6 +1,6 @@
 #use "topfind";;
+#thread;;
 #require "str";;
 #require "netstring";;
 #require "pxp";;
 #load "registry.cma";;
-open Helm_registry;;
diff --git a/helm/ocaml/registry/helm_registry.ml b/helm/ocaml/registry/helm_registry.ml
index 3977bcf06..3c0a9d688 100644
--- a/helm/ocaml/registry/helm_registry.ml
+++ b/helm/ocaml/registry/helm_registry.ml
@@ -38,6 +38,9 @@ exception Invalid_value of (string * string) * string (* key, value, descr *)
 
 type validator_id = int
 
+  (* root XML tag: used by save_to, ignored by load_from *)
+let root_tag = "helm_registry"
+
 let get_next_validator_id =
   let next_id = ref 0 in
   fun () ->
@@ -57,15 +60,6 @@ let restore_registry backup =
    * - no sequences of '_' longer than 1 are permitted
    * - no uppercase letter are permitted
    *)
-(*
-let valid_step_rex_raw = "[a-z0-9]+(_[a-z0-9]+)*"
-let valid_key_rex_raw =
-  sprintf "^%s(\\.%s)*$" valid_step_rex_raw valid_step_rex_raw
-let valid_key_rex = Pcre.regexp valid_key_rex_raw
-let dot_rex = Pcre.regexp "\\."
-let spaces_rex = Pcre.regexp "\\s+"
-let heading_spaces_rex = Pcre.regexp "^\\s+"
-*)
 let valid_step_rex_raw = "[a-z0-9]+\\(_[a-z0-9]+\\)*"
 let valid_key_rex_raw =
   sprintf "%s\(\\.%s\)*" valid_step_rex_raw valid_step_rex_raw
@@ -164,6 +158,14 @@ let (get_float, set_float) = mk_get_set "float" float_of_string string_of_float
 let (get_string_list, set_string_list) =
   mk_get_set "string list" string_list_of_string string_of_string_list
 
+(*
+let save_to =
+  let dtd = new dtd default_config.warner `Enc_utf8 in
+  let rec create_key node sections key value =
+    match sections with
+    | [] -> create_element_node ~valcheck:false default_spec dtd
+*)
+
 let save_to fname =
   debug_print ("Saving configuration to " ^ fname);
   let oc = open_out fname in
@@ -189,22 +191,26 @@ open Pxp_document
 open Pxp_types
 open Pxp_yacc
 
-let load_from =
+let load_from_absolute =
   let config = default_config in
   let entry = `Entry_document [ `Extend_dtd_fully; `Parse_xml_decl ] in
+  let fold_key key_stack key = String.concat "." key_stack ^ "." ^ key in
   fun fname ->
     debug_print ("Loading configuration from " ^ fname);
     let document =
       parse_wfdocument_entity config (from_file fname) default_spec
     in
-    let fill_registry () =
-      document#root#iter_nodes (fun n ->
+    let rec aux key_stack node =
+      node#iter_nodes (fun n ->
         try
           (match n#node_type with
-          | T_element "value" ->
-              let key = n#required_string_attribute "key" in
+          | T_element "section" ->
+              let section = n#required_string_attribute "name" in
+              aux (key_stack @ [section]) n
+          | T_element "key" ->
+              let key = n#required_string_attribute "name" in
               let value = n#data in
-              set ~key ~value
+              set ~key:(fold_key key_stack key) ~value
           | _ -> ())
         with exn ->
           let (fname, line, pos) = n#position in
@@ -214,11 +220,34 @@ let load_from =
     let backup = backup_registry () in
     Hashtbl.clear registry;
     try
-      fill_registry ()
+      aux [] document#root
     with exn ->
       restore_registry backup;
       raise exn
 
+let load_from ?path fname =
+  if Filename.is_relative fname then begin
+    let no_file_found = ref true in
+    let path =
+      match path with
+      | Some path -> path (* path given as argument *)
+      | None -> [ Sys.getcwd () ] (* no path given, try with cwd *)
+    in
+    List.iter
+      (fun dir ->
+        let conffile = dir ^ "/" ^ fname in
+        if Sys.file_exists conffile then begin
+          no_file_found := false;
+          load_from_absolute conffile
+        end)
+       path;
+    if !no_file_found then
+      failwith (sprintf
+        "Helm_registry.init: no configuration file named %s in [ %s ]"
+        fname (String.concat "; " path))
+  end else
+    load_from_absolute fname
+
   (* DEBUGGING ONLY *)
 
 let dump () = Hashtbl.iter (fun k v -> printf "%s = %s\n" k v) registry
diff --git a/helm/ocaml/registry/helm_registry.mli b/helm/ocaml/registry/helm_registry.mli
index 1f84333fe..76c5d6f16 100644
--- a/helm/ocaml/registry/helm_registry.mli
+++ b/helm/ocaml/registry/helm_registry.mli
@@ -139,10 +139,16 @@ val add_validator:
  *)
 
   (** @param fname file to which save current configuration *)
-val save_to: string -> unit
-
-  (** @param fname file from which load new configuration *)
-val load_from: string -> unit
+(* val save_to: string -> unit *)
+
+  (** @param fname file from which load new configuration. If it's an absolute
+   * file name "path" argument is ignored.
+   * Otherwise given file name is looked up in each directory member of the
+   * given path. Each matching file is loaded overriding previous settings. If
+   * no path is given a default path composed of just the current working
+   * directory is used.
+   *)
+val load_from: ?path:string list -> string -> unit
 
 (*
 (* DEBUGGING *)
diff --git a/helm/ocaml/registry/tests/sample.conf b/helm/ocaml/registry/tests/sample.conf
deleted file mode 100644
index 01cc5e004..000000000
--- a/helm/ocaml/registry/tests/sample.conf
+++ /dev/null
@@ -1,13 +0,0 @@
-### OLD TEXT BASED CONFIGURATION FILE
-### LOOK IN sample.xml FOR NEWER FORMAT
-
-# comment
-hi.how.doing = "one\ntwo\nthree"
-
-fine.thanks = "me too"
-padded.list = " a b c d_e_f   "
-
-# other
-# comment
-and.you = "fine\"ok"
-
diff --git a/helm/ocaml/registry/tests/sample.xml b/helm/ocaml/registry/tests/sample.xml
index 56d4f2848..ac29f3373 100644
--- a/helm/ocaml/registry/tests/sample.xml
+++ b/helm/ocaml/registry/tests/sample.xml
@@ -1,8 +1,22 @@
+<?xml version="1.0" encoding="utf-8"?>
 <helm_registry>
-  <value key="hi.how.doing">one
-two
-three</value>
-  <value key="fine.thanks">me too</value>
-  <value key="padded.list"> a b c d_e_f   </value>
-  <value key="and.you">fine&quot;ok</value>
+  <section name="annotations">
+    <key name="dir">file:///home/zack/miohelm/objects</key>
+    <key name="url">file:///home/zack/miohelm/objects</key>
+  </section>
+  <section name="getter">
+    <key name="mode">remote</key>
+    <key name="url">http://localhost:58081</key>
+  </section>
+  <section name="triciclo">
+    <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>
 </helm_registry>
-- 
2.39.2