From cdc2c0c2ba2831239dcaad706bba8c73ab27723f Mon Sep 17 00:00:00 2001 From: Stefano Zacchiroli Date: Tue, 27 Jan 2004 11:48:55 +0000 Subject: [PATCH] helm registry --- first release --- helm/ocaml/registry/.cvsignore | 6 + helm/ocaml/registry/.depend | 2 + helm/ocaml/registry/Makefile | 8 ++ helm/ocaml/registry/helm_registry.ml | 160 ++++++++++++++++++++++++++ helm/ocaml/registry/helm_registry.mli | 120 +++++++++++++++++++ helm/ocaml/registry/tests/sample.conf | 11 ++ 6 files changed, 307 insertions(+) create mode 100644 helm/ocaml/registry/.cvsignore create mode 100644 helm/ocaml/registry/.depend create mode 100644 helm/ocaml/registry/Makefile create mode 100644 helm/ocaml/registry/helm_registry.ml create mode 100644 helm/ocaml/registry/helm_registry.mli create mode 100644 helm/ocaml/registry/tests/sample.conf diff --git a/helm/ocaml/registry/.cvsignore b/helm/ocaml/registry/.cvsignore new file mode 100644 index 000000000..fbe20a217 --- /dev/null +++ b/helm/ocaml/registry/.cvsignore @@ -0,0 +1,6 @@ +*.a +*.cma +*.cmi +*.cmo +*.cmxa +*.o diff --git a/helm/ocaml/registry/.depend b/helm/ocaml/registry/.depend new file mode 100644 index 000000000..cf4f36b68 --- /dev/null +++ b/helm/ocaml/registry/.depend @@ -0,0 +1,2 @@ +helm_registry.cmo: helm_registry.cmi +helm_registry.cmx: helm_registry.cmi diff --git a/helm/ocaml/registry/Makefile b/helm/ocaml/registry/Makefile new file mode 100644 index 000000000..a2fdf6eca --- /dev/null +++ b/helm/ocaml/registry/Makefile @@ -0,0 +1,8 @@ + +PACKAGE = registry +REQUIRES = pcre +INTERFACE_FILES = helm_registry.mli +IMPLEMENTATION_FILES = helm_registry.ml + +include ../Makefile.common + diff --git a/helm/ocaml/registry/helm_registry.ml b/helm/ocaml/registry/helm_registry.ml new file mode 100644 index 000000000..30df896d6 --- /dev/null +++ b/helm/ocaml/registry/helm_registry.ml @@ -0,0 +1,160 @@ +(* Copyright (C) 2004, HELM Team. + * + * This file is part of HELM, an Hypertextual, Electronic + * Library of Mathematics, developed at the Computer Science + * Department, University of Bologna, Italy. + * + * HELM is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * HELM is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with HELM; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, + * MA 02111-1307, USA. + * + * For details, see the HELM World-Wide-Web page, + * http://helm.cs.unibo.it/ + *) + +open Printf + +exception Malformed_key of string +exception Key_not_found of string +exception Type_error of string * string * string (* expected type, value, msg *) +exception Parse_error of string * int (* file, lineno *) +exception Invalid_value of (string * string) * string (* key, value, descr *) + +exception Unescape_failure + +type validator_id = int + +let get_next_validator_id = + let next_id = ref 0 in + fun () -> + incr next_id; + !next_id + +let magic_size = 127 +let validators = Hashtbl.create magic_size +let registry = Hashtbl.create magic_size + +let backup_registry () = Hashtbl.copy registry +let restore_registry backup = + Hashtbl.clear registry; + Hashtbl.iter (fun key value -> Hashtbl.replace registry key value) backup + +let valid_key_rex_raw = "\\w+(\\.\\w+)*" +let config_line_raw = sprintf "\\s*(%s)\\s*=\\s*\"(.*)\"\\s*" valid_key_rex_raw +let comment_rex = Pcre.regexp "^\\s*(#|$)" +let valid_key_rex = Pcre.regexp ("^" ^ valid_key_rex_raw ^ "$") +let config_line_rex = Pcre.regexp ("^" ^ config_line_raw ^ "$") + +let is_comment s = Pcre.pmatch ~rex:comment_rex s + +let escape = String.escaped +let unescape = + let lexer = lazy (Genlex.make_lexer []) in + fun s -> + let tok_stream = Lazy.force lexer (Stream.of_string ("\"" ^ s ^ "\"")) in + match Stream.peek tok_stream with + | Some (Genlex.String s) -> s + | _ -> raise Unescape_failure + +let key_is_valid key = + if not (Pcre.pmatch ~rex:valid_key_rex key) then + raise (Malformed_key key) + +let value_is_valid ~key ~value = + List.iter + (fun (validator, descr) -> + if not (validator value) then + raise (Invalid_value ((key, value), descr))) + (Hashtbl.find_all validators key) + +let set' registry ~key ~value = + key_is_valid key; + value_is_valid ~key ~value; + Hashtbl.replace registry key value + +let get key = + key_is_valid key; + try + Hashtbl.find registry key + with Not_found -> raise (Key_not_found key) + +let set = set' registry + +let string_list_of_string s = + (* trailing blanks are removed per default by Pcre.split *) + Pcre.split ~pat:"\\s+" (Pcre.replace ~pat:"^\\s+" s) +let string_of_string_list l = String.concat " " l + +let mk_get_set type_name (from_string: string -> 'a) (to_string: 'a -> string) = + let getter key = + let value = get key in + try + from_string value + with exn -> + raise (Type_error (type_name, value, Printexc.to_string exn)) + in + let setter ~key ~value = set ~key ~value:(to_string value) in + (getter, setter) + +let (get_int, set_int) = mk_get_set "int" int_of_string string_of_int +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 fname = + let oc = open_out fname in + try + Hashtbl.iter + (fun key value -> + output_string oc (sprintf "%s = \"%s\"" key (escape value))) + registry; + close_out oc + with e -> + close_out oc; + raise e + +let load_from fname = + let backup = backup_registry () in + Hashtbl.clear registry; + let ic = open_in fname in + let lineno = ref 0 in + try + while true do + incr lineno; + let line = input_line ic in + if not (is_comment line) then + let subs = Pcre.extract ~rex:config_line_rex line in + let (key, value) = (subs.(1), unescape subs.(3)) in + set ~key ~value + done + with + | End_of_file -> close_in ic + | Malformed_key _ | Unescape_failure | Not_found -> + restore_registry backup; + raise (Parse_error (fname, !lineno)) + | e -> + close_in ic; + restore_registry backup; + raise e + +let add_validator ~key ~validator ~descr = + let id = get_next_validator_id () in + Hashtbl.add validators key (validator, descr); + id + +(* + (* DEBUGGING *) +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 new file mode 100644 index 000000000..02c0df76b --- /dev/null +++ b/helm/ocaml/registry/helm_registry.mli @@ -0,0 +1,120 @@ +(* Copyright (C) 2004, HELM Team. + * + * This file is part of HELM, an Hypertextual, Electronic + * Library of Mathematics, developed at the Computer Science + * Department, University of Bologna, Italy. + * + * HELM is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * HELM is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with HELM; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, + * MA 02111-1307, USA. + * + * For details, see the HELM World-Wide-Web page, + * http://helm.cs.unibo.it/ + *) + +(** Configuration repository for HELM applications. + * + * key ::= path + * path ::= component ( '.' component )* + * component ::= ( alpha | num | '_' )+ + * + * Suggested usage .: + * e.g. gTopLevel.prooffile, http_getter.port, ... + * + * Configuration file example: + * + * gTopLevel.prooffile = "/home/zack/prooffile" + * http_getter.port = "58080" + *) + + (** raised when a looked up key can't be found + * @param key looked up key *) +exception Key_not_found of string + + (** raised when a looked up key doesn't have the required type + * @param expected_type + * @param value + * @param msg *) +exception Type_error of string * string * string + + (** raised when a malformed key is encountered + * @param key malformed key *) +exception Malformed_key of string + + (** raised when an error is encountered while parsing a configuration file + * @param fname file name + * @param lno line number *) +exception Parse_error of string * int + + (** raised when a given pair fails validity test(s) + * @param pair pair + * @param descr description of the failed test *) +exception Invalid_value of (string * string) * string + +(** {2 Generic untyped interface} + * Using the functions below this module could be used as a repository of + * key/value pairs *) + +val get: string -> string +val set: key:string -> value:string -> unit + +(** {2 Typed interface} + * Three basic types are supported: strings, int and strings list. Strings + * correspond literally to what is written inside double quotes; int to the + * parsing of an integer number from ; strings list to the splitting at blanks + * of it (heading and trailing blanks are removed before splitting) *) + +val get_int: string -> int +val get_float: string -> float +val get_string_list: string -> string list + +val set_int: key:string -> value:int -> unit +val set_float: key:string -> value:float -> unit +val set_string_list: key:string -> value:string list -> unit + +(** {2 Validators} + * Each key may have zero or more associated validators, that are predicates + * "this value is valid for this key". Each time a value is set, all validators + * associated to the corresponding key are executed, if at least one of them + * fails, Invalid_value exception will be raised *) + +type validator_id + + (** register a new validator for a given key + * @param key key to which validator applies + * @param validator a function applying to a value returning true if that + * value is valid, false otherwise + * @param descr validator description, for the final user when a validation + * attempt fails + * @return validator_id should be used to remove the validator later on *) +val add_validator: + key:string -> validator:(string -> bool) -> descr:string -> + validator_id +(* val remove_validator: validator_id -> unit *) + +(** {2 Persistent configuration} + * Validators aren't saved. load_from/save_to sequences don't preserve comments + *) + + (** @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 + +(* +(* DEBUGGING *) +val dump: unit -> unit +*) + diff --git a/helm/ocaml/registry/tests/sample.conf b/helm/ocaml/registry/tests/sample.conf new file mode 100644 index 000000000..7f1c4ed0e --- /dev/null +++ b/helm/ocaml/registry/tests/sample.conf @@ -0,0 +1,11 @@ + +# 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" + -- 2.39.2