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 = "/home/cadet/sacerdot/local/etc/helm/configuration.xml";;
  14
  15 exception Warnings;;
  16
  17 class warner =
  18   object
  19     method warn w =
  20       print_endline ("WARNING: " ^ w) ;
  21       (raise Warnings : unit)
  22   end
  23 ;;
  24
  25 let xml_document () =
  26  let module Y = Pxp_yacc in
  27   try
  28    let config = {Y.default_config with Y.warner = new warner} in
  29     Y.parse_document_entity config (Y.from_file filename) Y.default_spec
  30   with
  31    e ->
  32      print_endline (Pxp_types.string_of_exn e) ;
  33      raise e
  34 ;;
  35
  36 exception Impossible;;
  37
  38 let vars = Hashtbl.create 14;;
  39
  40 (* resolve <value-of> tags and returns the string values of the variable tags *)
  41 let rec resolve =
  42  let module D = Pxp_document in
  43   function
  44      [] -> ""
  45    | he::tl when he#node_type = D.T_element "value-of" ->
  46       (match he#attribute "var" with
  47           Pxp_types.Value var -> Hashtbl.find vars var
  48         | _ -> raise Impossible
  49       ) ^ resolve tl
  50    | he::tl when he#node_type = D.T_data ->
  51       he#data ^ resolve tl
  52    | _ -> raise Impossible
  53 ;;
  54
  55 (* we trust the xml file to be valid because of the validating xml parser *)
  56 let _ =
  57  List.iter
  58   (function
  59       n ->
  60        match n#node_type with
  61           Pxp_document.T_element var ->
  62            Hashtbl.add vars var (resolve (n#sub_nodes))
  63         | _ -> raise Impossible
  64   )
  65   ((xml_document ())#root#sub_nodes)
  66 ;;
  67
  68 let helm_dir      = Hashtbl.find vars "helm_dir";;
  69 let dtd_dir       = Hashtbl.find vars "dtd_dir";;
  70 let servers_file  = Hashtbl.find vars "servers_file";;
  71 let uris_dbm      = Hashtbl.find vars "uris_dbm";;
  72 let dest          = Hashtbl.find vars "dest";;
  73 let indexname     = Hashtbl.find vars "indexname";;
  74 let tmpdir        = Hashtbl.find vars "tmpdir";;
  75 let helm_dir      = Hashtbl.find vars "helm_dir";;
  76 let getter_url    = Hashtbl.find vars "getter_url";;
  77
  78 let _ = Hashtbl.clear vars;;