HELM OCaml libraries with findlib support.

[helm.git] / helm / ocaml / getter / configuration.ml

diff --git a/helm/ocaml/getter/configuration.ml b/helm/ocaml/getter/configuration.ml
new file mode 100644 (file)
index 0000000..2c7ead3
--- /dev/null
+++ b/helm/ocaml/getter/configuration.ml
@@ -0,0 +1,118 @@
+(******************************************************************************)
+(*                                                                            *)
+(*                               PROJECT HELM                                 *)
+(*                                                                            *)
+(*                Claudio Sacerdoti Coen <sacerdot@cs.unibo.it>               *)
+(*                                 28/12/2000                                 *)
+(*                                                                            *)
+(* This is the parser that reads the configuration file of helm               *)
+(*                                                                            *)
+(******************************************************************************)
+
+exception MalformedDir of string
+
+(* this should be the only hard coded constant *)
+let filename =
+ let prefix =
+  try
+   Sys.getenv "HELM_CONFIGURATION_DIR"
+  with
+   Not_found -> "/projects/helm/V7/phd/local/etc/helm"
+ in
+  if prefix.[(String.length prefix) - 1] = '/' then
+   raise (MalformedDir prefix) ;
+  prefix ^ "/configuration.xml";;
+
+exception Warnings;;
+
+class warner =
+  object 
+    method warn w =
+      print_endline ("WARNING: " ^ w) ;
+      (raise Warnings : unit)
+  end
+;;
+
+let xml_document () =
+ let module Y = Pxp_yacc in
+  try 
+   let config = {Y.default_config with Y.warner = new warner} in
+    Y.parse_document_entity config (Y.from_file filename) Y.default_spec
+  with
+   e ->
+     print_endline (Pxp_types.string_of_exn e) ;
+     raise e
+;;
+
+exception Impossible;;
+
+let vars = Hashtbl.create 14;;
+
+(* resolve <value-of> tags and returns the string values of the variable tags *)
+let rec resolve =
+ let module D = Pxp_document in
+  function
+     [] -> ""
+   | he::tl when he#node_type = D.T_element "value-of" ->
+      (match he#attribute "var" with
+          Pxp_types.Value var -> Hashtbl.find vars var
+        | _ -> raise Impossible
+      ) ^ resolve tl
+   | he::tl when he#node_type = D.T_data ->
+      he#data ^ resolve tl
+   | _ -> raise Impossible
+;;
+
+(* we trust the xml file to be valid because of the validating xml parser *)
+let _ =
+ List.iter
+  (function
+      n ->
+       match n#node_type with
+          Pxp_document.T_element var ->
+           Hashtbl.add vars var (resolve (n#sub_nodes))
+        | _ -> raise Impossible
+  )
+  ((xml_document ())#root#sub_nodes)
+;;
+
+(* try to read a configuration variable, given its name into the
+ * configuration.xml file and its name into the shell environment.
+ * The shell variable, if present, has precedence over configuration.xml
+ *)
+let read_configuration_var_env xml_name env_name =
+ try
+  try
+   Sys.getenv env_name
+  with
+   Not_found -> Hashtbl.find vars xml_name
+ with
+  Not_found ->
+   Printf.printf "Sorry, cannot find variable `%s', please check your configuration\n" xml_name ;
+   flush stdout ;
+   raise Not_found
+
+let read_configuration_var xml_name =
+ try
+  Hashtbl.find vars xml_name
+ with
+  Not_found ->
+   Printf.printf "Sorry, cannot find variable `%s', please check your configuration\n" xml_name ;
+   flush stdout ;
+   raise Not_found
+
+let helm_dir      = read_configuration_var     "helm_dir";;
+let dtd_dir       = read_configuration_var     "dtd_dir";;
+let style_dir     = read_configuration_var_env "style_dir" "HELM_STYLE_DIR";;
+let servers_file  = read_configuration_var     "servers_file";;
+let uris_dbm      = read_configuration_var     "uris_dbm";;
+let dest          = read_configuration_var     "dest";;
+let indexname     = read_configuration_var     "indexname";;
+let tmp_dir       = read_configuration_var     "tmp_dir"
+let helm_dir      = read_configuration_var     "helm_dir";;
+let getter_url    = read_configuration_var_env "getter_url" "HELM_GETTER_URL";;
+let processor_url = read_configuration_var_env "processor_url" "HELM_PROCESSOR_URL";;
+let annotations_dir = read_configuration_var_env "annotations_dir" "HELM_ANNOTATIONS_DIR"
+let annotations_url = read_configuration_var_env "annotations_url" "HELM_ANNOTATIONS_URL"
+
+let _ = Hashtbl.clear vars;;