]> matita.cs.unibo.it Git - helm.git/blob - helm/interface/configuration.ml.in
Main code clean-up.
[helm.git] / helm / interface / configuration.ml.in
1 (******************************************************************************)
2 (*                                                                            *)
3 (*                               PROJECT HELM                                 *)
4 (*                                                                            *)
5 (*                Claudio Sacerdoti Coen <sacerdot@cs.unibo.it>               *)
6 (*                                 28/12/2000                                 *)
7 (*                                                                            *)
8 (* This is the parser that reads the configuration file of helm               *)
9 (*                                                                            *)
10 (******************************************************************************)
11
12 exception MalformedDir of string
13
14 (* this should be the only hard coded constant *)
15 let filename =
16  let prefix =
17   try
18    Sys.getenv "HELM_CONFIGURATION_DIR"
19   with
20    Not_found -> "@HELM_CONFIGURATION_DIR@"
21  in
22   if prefix.[(String.length prefix) - 1] = '/' then
23    raise (MalformedDir prefix) ;
24   prefix ^ "/configuration.xml";;
25
26 exception Warnings;;
27
28 class warner =
29   object 
30     method warn w =
31       print_endline ("WARNING: " ^ w) ;
32       (raise Warnings : unit)
33   end
34 ;;
35
36 let xml_document () =
37  let module Y = Pxp_yacc in
38   try 
39    let config = {Y.default_config with Y.warner = new warner} in
40     Y.parse_document_entity config (Y.from_file filename) Y.default_spec
41   with
42    e ->
43      print_endline (Pxp_types.string_of_exn e) ;
44      raise e
45 ;;
46
47 exception Impossible;;
48
49 let vars = Hashtbl.create 14;;
50
51 (* resolve <value-of> tags and returns the string values of the variable tags *)
52 let rec resolve =
53  let module D = Pxp_document in
54   function
55      [] -> ""
56    | he::tl when he#node_type = D.T_element "value-of" ->
57       (match he#attribute "var" with
58           Pxp_types.Value var -> Hashtbl.find vars var
59         | _ -> raise Impossible
60       ) ^ resolve tl
61    | he::tl when he#node_type = D.T_data ->
62       he#data ^ resolve tl
63    | _ -> raise Impossible
64 ;;
65
66 (* we trust the xml file to be valid because of the validating xml parser *)
67 let _ =
68  List.iter
69   (function
70       n ->
71        match n#node_type with
72           Pxp_document.T_element var ->
73            Hashtbl.add vars var (resolve (n#sub_nodes))
74         | _ -> raise Impossible
75   )
76   ((xml_document ())#root#sub_nodes)
77 ;;
78
79 (* try to read a configuration variable, given its name into the
80  * configuration.xml file and its name into the shell environment.
81  * The shell variable, if present, has precedence over configuration.xml
82  *)
83 let read_configuration_var_env xml_name env_name =
84  try
85   try
86    Sys.getenv env_name
87   with
88    Not_found -> Hashtbl.find vars xml_name
89  with
90   Not_found ->
91    Printf.printf "Sorry, cannot find variable `%s', please check your configuration\n" xml_name ;
92    flush stdout ;
93    raise Not_found
94
95 let read_configuration_var xml_name =
96  try
97   Hashtbl.find vars xml_name
98  with
99   Not_found ->
100    Printf.printf "Sorry, cannot find variable `%s', please check your configuration\n" xml_name ;
101    flush stdout ;
102    raise Not_found
103
104 let helm_dir      = read_configuration_var     "helm_dir";;
105 let dtd_dir       = read_configuration_var     "dtd_dir";;
106 let style_dir     = read_configuration_var_env "style_dir" "HELM_STYLE_DIR";;
107 let servers_file  = read_configuration_var     "servers_file";;
108 let uris_dbm      = read_configuration_var     "uris_dbm";;
109 let dest          = read_configuration_var     "dest";;
110 let indexname     = read_configuration_var     "indexname";;
111 let tmp_dir       = read_configuration_var     "tmp_dir"
112 let helm_dir      = read_configuration_var     "helm_dir";;
113 let getter_url    = read_configuration_var_env "getter_url" "HELM_GETTER_URL";;
114 let processor_url = read_configuration_var_env "processor_url" "HELM_PROCESSOR_URL";;
115
116 let _ = Hashtbl.clear vars;;
117