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;;