]> matita.cs.unibo.it Git - helm.git/blob - helm/interface/configuration.ml
Requires and Provides now fixed
[helm.git] / helm / interface / configuration.ml
1 (******************************************************************************)
2 (*                                                                            *)
3 (*                               PROJECT HELM                                 *)
4 (*                                                                            *)
5 (*                Claudio Sacerdoti Coen <sacerdot@cs.unibo.it>               *)
6 (*                                 06/05/2000                                 *)
7 (*                                                                            *)
8 (* This is the parser that reads the configuration file of helm               *)
9 (*                                                                            *)
10 (******************************************************************************)
11
12 (* this should be the only hard coded constant *)
13 let filename =
14  let prefix =
15   try
16    Sys.getenv "HELM_CONFIGURATION_PREFIX"
17   with
18    Not_found -> ""
19  in
20   prefix ^ "/local/etc/helm/configuration.xml";;
21
22 exception Warnings;;
23
24 class warner =
25   object 
26     method warn w =
27       print_endline ("WARNING: " ^ w) ;
28       (raise Warnings : unit)
29   end
30 ;;
31
32 let xml_document () =
33  let module Y = Pxp_yacc in
34   try 
35    let config = {Y.default_config with Y.warner = new warner} in
36     Y.parse_document_entity config (Y.from_file filename) Y.default_spec
37   with
38    e ->
39      print_endline (Pxp_types.string_of_exn e) ;
40      raise e
41 ;;
42
43 exception Impossible;;
44
45 let vars = Hashtbl.create 14;;
46
47 (* resolve <value-of> tags and returns the string values of the variable tags *)
48 let rec resolve =
49  let module D = Pxp_document in
50   function
51      [] -> ""
52    | he::tl when he#node_type = D.T_element "value-of" ->
53       (match he#attribute "var" with
54           Pxp_types.Value var -> Hashtbl.find vars var
55         | _ -> raise Impossible
56       ) ^ resolve tl
57    | he::tl when he#node_type = D.T_data ->
58       he#data ^ resolve tl
59    | _ -> raise Impossible
60 ;;
61
62 (* we trust the xml file to be valid because of the validating xml parser *)
63 let _ =
64  List.iter
65   (function
66       n ->
67        match n#node_type with
68           Pxp_document.T_element var ->
69            Hashtbl.add vars var (resolve (n#sub_nodes))
70         | _ -> raise Impossible
71   )
72   ((xml_document ())#root#sub_nodes)
73 ;;
74
75 let helm_dir      = Hashtbl.find vars "helm_dir";;
76 let dtd_dir       = Hashtbl.find vars "dtd_dir";;
77 let servers_file  = Hashtbl.find vars "servers_file";;
78 let uris_dbm      = Hashtbl.find vars "uris_dbm";;
79 let dest          = Hashtbl.find vars "dest";;
80 let indexname     = Hashtbl.find vars "indexname";;
81 let tmpdir        = Hashtbl.find vars "tmpdir";;
82 let helm_dir      = Hashtbl.find vars "helm_dir";;
83 let getter_url    = Hashtbl.find vars "getter_url";;
84
85 let _ = Hashtbl.clear vars;;