+(******************************************************************************)
+(* *)
+(* 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;;