From b5eb40eed8e03f2ac2059c3ec9ec5f078ae320af Mon Sep 17 00:00:00 2001 From: Stefano Zacchiroli 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 @@ + - one -two -three - me too - a b c d_e_f - fine"ok +
+ file:///home/zack/miohelm/objects + file:///home/zack/miohelm/objects +
+
+ remote + http://localhost:58081 +
+
+ /public/helm_library + $(triciclo.basedir)/constanttype + $(triciclo.basedir)/environment + $(triciclo.basedir)/innertypes + $(triciclo.basedir)/currentproof + $(triciclo.basedir)/currentprooftype +
+
+ http://localhost:58080/ +
-- 2.39.2