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
*)
(** @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 *)
+<?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"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>