- added "has" method

[helm.git] / helm / ocaml / registry / helm_registry.ml

diff --git a/helm/ocaml/registry/helm_registry.ml b/helm/ocaml/registry/helm_registry.ml
index 2b6461b5620bc0a0f4b35090f601eb3c40b26643..10639e0899d82a6daf702f8623bb2dec5743e931 100644 (file)
--- a/helm/ocaml/registry/helm_registry.ml
+++ b/helm/ocaml/registry/helm_registry.ml
@@ -29,6 +29,34 @@ let debug = false
 let debug_print s =
   if debug then prerr_endline ("Helm_registry debugging: " ^ s)
 
+  (** <helpers> *)
+
+let list_uniq l =
+  let rec aux last_element = function
+    | [] -> []
+    | hd :: tl ->
+        (match last_element with
+        | Some elt when elt = hd -> aux last_element tl
+        | _ -> hd :: aux (Some hd) tl)
+  in
+  aux None l
+
+let starts_with prefix =
+(*
+  let rex = Str.regexp (Str.quote prefix) in
+  fun s -> Str.string_match rex s 0
+*)
+  let prefix_len = String.length prefix in
+  fun s ->
+    try
+      String.sub s 0 prefix_len = prefix
+    with Invalid_argument _ -> false
+
+let hashtbl_keys tbl = Hashtbl.fold (fun k _ acc -> k :: acc) tbl []
+let hashtbl_pairs tbl = Hashtbl.fold (fun k v acc -> (k,v) :: acc) tbl []
+
+  (** </helpers> *)
+
 exception Malformed_key of string
 exception Key_not_found of string
 exception Cyclic_definition of string
@@ -81,7 +109,6 @@ 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 (Str.string_match valid_key_rex key 0) then
     raise (Malformed_key key)
 
@@ -101,7 +128,6 @@ let set' registry ~key ~value =
 let unset = Hashtbl.remove registry
 
 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 =
@@ -142,6 +168,8 @@ let get key =
 
 let set = set' registry
 
+let has key = Hashtbl.mem registry key
+
 let mk_get_set type_name (from_string: string -> 'a) (to_string: 'a -> string) =
   let getter key =
     let value = get key in
@@ -187,7 +215,8 @@ let save_to =
   let dot_RE = Str.regexp "\\." in
   let create_key_node key value = (* create a <key name="foo">value</key> *)
     let element =
-      create_element_node ~valcheck:false PxpHelmConf.pxp_spec dtd "key" ["name", key]
+      create_element_node ~valcheck:false PxpHelmConf.pxp_spec dtd
+        "key" ["name", key]
     in
     let data = create_data_node PxpHelmConf.pxp_spec dtd value in
     element#append_node data;
@@ -310,9 +339,45 @@ let load_from ?path fname =
   end else
     load_from_absolute fname
 
-let fold f init = Hashtbl.fold (fun k v acc -> f acc k v) registry init
-let iter f = fold (fun _ k v -> f k v) ()
-let to_list () = fold (fun acc k v -> (k, v) :: acc) []
+let fold ?prefix f init =
+  match prefix with
+  | None -> Hashtbl.fold (fun k v acc -> f acc k v) registry init
+  | Some s ->
+      let key_matches = starts_with (s ^ ".") in
+      let rec fold_filter acc = function
+        | [] -> acc
+        | (k,v) :: tl when key_matches k -> fold_filter (f acc k v) tl
+        | _ :: tl -> fold_filter acc tl
+      in
+      fold_filter init (hashtbl_pairs registry)
+
+let iter ?prefix f = fold ?prefix (fun _ k v -> f k v) ()
+let to_list ?prefix () = fold ?prefix (fun acc k v -> (k, v) :: acc) []
+
+let ls prefix =
+  let prefix = prefix ^ "." in
+  let prefix_len = String.length prefix in
+  let key_matches = starts_with prefix in
+  let matching_keys = (* collect matching keys' _postfixes_ *)
+    fold
+      (fun acc key _ ->
+        if key_matches key then
+          String.sub key prefix_len (String.length key - prefix_len) :: acc
+        else
+          acc)
+      []
+  in
+  let (sections, keys) =
+    List.fold_left
+      (fun (sections, keys) postfix ->
+        match Str.split dot_rex postfix with
+        | [key] -> (sections, key :: keys)
+        | hd_key :: _ ->  (* length > 1 => nested section found *)
+            (hd_key :: sections, keys)
+        | _ -> assert false)
+      ([], []) matching_keys
+  in
+  (list_uniq (List.sort Pervasives.compare sections), keys)
 
   (* DEBUGGING ONLY *)