X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fregistry%2Fhelm_registry.ml;h=3c0a9d68844f0af1db2ba8b7107debe7f8dc4976;hb=b5eb40eed8e03f2ac2059c3ec9ec5f078ae320af;hp=3977bcf06d47ffc45a5de2c9d298809e5f041883;hpb=60ea1e5cd7494c7453993dad5b819cd631770308;p=helm.git

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