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 () ->
* - 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
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
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
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