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