1 (******************************************************************************)
5 (* Claudio Sacerdoti Coen <sacerdot@cs.unibo.it> *)
8 (* This is the parser that reads the configuration file of helm *)
10 (******************************************************************************)
12 exception MalformedDir of string
14 (* this should be the only hard coded constant *)
18 Sys.getenv "HELM_CONFIGURATION_DIR"
20 Not_found -> "/projects/helm/V7/phd/local/etc/helm"
22 if prefix.[(String.length prefix) - 1] = '/' then
23 raise (MalformedDir prefix) ;
24 prefix ^ "/configuration.xml";;
31 print_endline ("WARNING: " ^ w) ;
32 (raise Warnings : unit)
38 prerr_endline ("Warning: configuration file not found, or incorrect: " ^
39 Pxp_types.string_of_exn e) ;
42 let module Y = Pxp_yacc in
44 let config = {Y.default_config with Y.warner = new warner} in
45 Some (Y.parse_document_entity config (Y.from_file filename) Y.default_spec)
47 | (Pxp_types.Error _) as e -> error e
48 | (Pxp_types.At _) as e -> error e
49 | (Pxp_types.Validation_error _) as e -> error e
50 | (Pxp_types.WF_error _) as e -> error e
51 | (Pxp_types.Namespace_error _) as e -> error e
52 | (Pxp_types.Character_not_supported) as e -> error e
55 exception Impossible;;
57 let vars = Hashtbl.create 14;;
59 (* resolve <value-of> tags and returns the string values of the variable tags *)
61 let module D = Pxp_document in
64 | he::tl when he#node_type = D.T_element "value-of" ->
65 (match he#attribute "var" with
66 Pxp_types.Value var -> Hashtbl.find vars var
67 | _ -> raise Impossible
69 | he::tl when he#node_type = D.T_data ->
71 | _ -> raise Impossible
74 (* we trust the xml file to be valid because of the validating xml parser *)
76 match xml_document () with
82 match n#node_type with
83 Pxp_document.T_element var ->
84 Hashtbl.add vars var (resolve (n#sub_nodes))
85 | _ -> raise Impossible
90 (* try to read a configuration variable, given its name into the
91 * configuration.xml file and its name into the shell environment.
92 * The shell variable, if present, has precedence over configuration.xml
94 let read_configuration_var_env xml_name env_name =
99 Not_found -> Hashtbl.find vars xml_name
102 Printf.printf "Sorry, cannot find variable `%s', please check your configuration\n" xml_name ;
106 let read_configuration_var xml_name =
108 Hashtbl.find vars xml_name
111 Printf.printf "Sorry, cannot find variable `%s', please check your configuration\n" xml_name ;
115 (* Zack: no longer used *)
116 (* let tmp_dir = read_configuration_var_env "tmp_dir" "HELM_TMP_DIR";; *)
117 let getter_url = read_configuration_var_env "getter_url" "HELM_GETTER_URL";;
118 let processor_url = read_configuration_var_env "processor_url" "HELM_PROCESSOR_URL";;
119 let annotations_dir = read_configuration_var_env "annotations_dir" "HELM_ANNOTATIONS_DIR"
120 let annotations_url = read_configuration_var_env "annotations_url" "HELM_ANNOTATIONS_URL"
122 let _ = Hashtbl.clear vars;;