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