- added support for variable interpolation

- switched from Pcre to Str for regexps :-(

diff --git a/helm/ocaml/registry/.ocamlinit b/helm/ocaml/registry/.ocamlinit
index f5b6b883ae1da7acf68f02b8d8024d0e4b8efab3..49a371462c003f8726c27308b90ffbddc85291c5 100644 (file)
--- a/helm/ocaml/registry/.ocamlinit
+++ b/helm/ocaml/registry/.ocamlinit
@@ -1,5 +1,5 @@
 #use "topfind";;
-#require "pcre";;
+#require "str";;
 #require "netstring";;
 #require "pxp";;
 #load "registry.cma";;

diff --git a/helm/ocaml/registry/Makefile b/helm/ocaml/registry/Makefile
index a824659ebf90a59b8a692cbab9cd48c07efe1a7c..5ac7f60d406d01a80c85e49337dcf01914e73ade 100644 (file)
--- a/helm/ocaml/registry/Makefile
+++ b/helm/ocaml/registry/Makefile
@@ -1,6 +1,6 @@
 
 PACKAGE = registry
-REQUIRES = pcre netstring pxp
+REQUIRES = str netstring pxp
 INTERFACE_FILES = helm_registry.mli
 IMPLEMENTATION_FILES = helm_registry.ml
 

diff --git a/helm/ocaml/registry/helm_registry.ml b/helm/ocaml/registry/helm_registry.ml
index ec4182bcaa967c664615bfc10c0cbf709f198900..3977bcf06d47ffc45a5de2c9d298809e5f041883 100644 (file)
--- a/helm/ocaml/registry/helm_registry.ml
+++ b/helm/ocaml/registry/helm_registry.ml
@@ -31,6 +31,7 @@ let debug_print s =
 
 exception Malformed_key of string
 exception Key_not_found of string
+exception Cyclic_definition of string
 exception Type_error of string * string * string (* expected type, value, msg *)
 exception Parse_error of string * int * int * string  (* file, line, col, msg *)
 exception Invalid_value of (string * string) * string (* key, value, descr *)
@@ -56,10 +57,23 @@ 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 ^ "$")
+  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 valid_key_rex = Str.regexp ("^" ^ valid_key_rex_raw ^ "$")
+let interpolated_key_rex = Str.regexp ("\\$(" ^ valid_key_rex_raw ^ ")")
+let dot_rex = Str.regexp "\\."
+let spaces_rex = Str.regexp "[ \t\n\r]+"
+let heading_spaces_rex = Str.regexp "^[ \t\n\r]+"
 
   (* escapes for xml configuration file *)
 let (escape, unescape) =
@@ -68,7 +82,8 @@ let (escape, unescape) =
    Netencoding.Html.decode ~in_enc ~out_enc ~entity_base:`Xml ())
 
 let key_is_valid key =
-  if not (Pcre.pmatch ~rex:valid_key_rex key) then
+(*   if not (Pcre.pmatch ~rex:valid_key_rex key) then *)
+  if not (Str.string_match valid_key_rex key 0) then
     raise (Malformed_key key)
 
 let value_is_valid ~key ~value =
@@ -84,34 +99,52 @@ let set' registry ~key ~value =
   value_is_valid ~key ~value;
   Hashtbl.replace registry key value
 
-let env_var_of_key =
-  let dot_RE = Pcre.regexp "\\." in
-  fun key ->
-    Pcre.replace ~rex:dot_RE ~templ:"__" (String.uppercase key)
+let env_var_of_key key =
+(*   Pcre.replace ~rex:dot_rex ~templ:"__" (String.uppercase key) *)
+  Str.global_replace dot_rex "__" (String.uppercase key)
 
 let get key =
-  key_is_valid key;
-  let registry_value =
-    try
-      Some (Hashtbl.find registry key)
-    with Not_found -> None
-  in
-  let env_value =
-    try
-      Some (Sys.getenv (env_var_of_key key))
-    with Not_found -> None
+  let rec aux stack key =
+    key_is_valid key;
+    if List.mem key stack then begin
+      let msg = (String.concat " -> " (List.rev stack)) ^ " -> " ^ key in
+      raise (Cyclic_definition msg)
+    end;
+    let registry_value =  (* internal value *)
+      try
+        Some (Hashtbl.find registry key)
+      with Not_found -> None
+    in
+    let env_value = (* environment value *)
+      try
+        Some (Sys.getenv (env_var_of_key key))
+      with Not_found -> None
+    in
+    let value = (* resulting value *)
+      match (registry_value, env_value) with
+      | Some reg, Some env  -> env
+      | Some reg, None      -> reg
+      | None,     Some env  -> env
+      | None,     None      -> raise (Key_not_found key)
+    in
+    interpolate (key :: stack) value
+  and interpolate stack value =
+    Str.global_substitute interpolated_key_rex
+      (fun s ->
+        let matched = Str.matched_string s in
+          (* "$(var)" -> "var" *)
+        let key = String.sub matched 2 (String.length matched - 3) in
+        aux stack key)
+      value
   in
-  match (registry_value, env_value) with
-  | Some reg, Some env  -> env
-  | Some reg, None      -> reg
-  | None,     Some env  -> env
-  | None,     None      -> raise (Key_not_found key)
+  aux [] 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)
+  (* trailing blanks are removed per default by split *)
+(*   Pcre.split ~res:spaces_rex (Pcre.replace ~rex:heading_spaces_rex s) *)
+  Str.split spaces_rex (Str.global_replace heading_spaces_rex "" s)
 let string_of_string_list l = String.concat " " l
 
 let mk_get_set type_name (from_string: string -> 'a) (to_string: 'a -> string) =

diff --git a/helm/ocaml/registry/helm_registry.mli b/helm/ocaml/registry/helm_registry.mli
index 668525b86a13e49f034df503d782a0fba9915e34..1f84333fe2bed5426e2061b2688d9d8d52b43fdc 100644 (file)
--- a/helm/ocaml/registry/helm_registry.mli
+++ b/helm/ocaml/registry/helm_registry.mli
@@ -60,6 +60,12 @@
    * @param key looked up key *)
 exception Key_not_found of string
 
+  (** raised when a cyclic definitions is found, e.g. after
+   * Helm_registry.set "a" "$b"
+   * Helm_registry.set "b" "$a"
+   * @param msg brief description of the definition cycle *)
+exception Cyclic_definition of string
+
   (** raised when a looked up key doesn't have the required type
    * @param expected_type
    * @param value