helm/ocaml/getter/configuration.ml

   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 -> "/projects/helm/V7/phd/local/etc/helm"
  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 error e =
  38   prerr_endline ("Warning: configuration file not found, or incorrect: " ^
  39    Pxp_types.string_of_exn e) ;
  40   None
  41  in
  42  let module Y = Pxp_yacc in
  43   try
  44    let config = {Y.default_config with Y.warner = new warner} in
  45     Some (Y.parse_document_entity config (Y.from_file filename) Y.default_spec)
  46   with
  47    | (Pxp_types.Error _) as e -> error e
  48    | (Pxp_types.At _) as e -> error e
  49    | (Pxp_types.Validation_error _) as e -> error e
  50    | (Pxp_types.WF_error _) as e -> error e
  51    | (Pxp_types.Namespace_error _) as e -> error e
  52    | (Pxp_types.Character_not_supported) as e -> error e
  53 ;;
  54
  55 exception Impossible;;
  56
  57 let vars = Hashtbl.create 14;;
  58
  59 (* resolve <value-of> tags and returns the string values of the variable tags *)
  60 let rec resolve =
  61  let module D = Pxp_document in
  62   function
  63      [] -> ""
  64    | he::tl when he#node_type = D.T_element "value-of" ->
  65       (match he#attribute "var" with
  66           Pxp_types.Value var -> Hashtbl.find vars var
  67         | _ -> raise Impossible
  68       ) ^ resolve tl
  69    | he::tl when he#node_type = D.T_data ->
  70       he#data ^ resolve tl
  71    | _ -> raise Impossible
  72 ;;
  73
  74 (* we trust the xml file to be valid because of the validating xml parser *)
  75 let _ =
  76  match xml_document () with
  77     None -> ()
  78   | Some d ->
  79      List.iter
  80       (function
  81           n ->
  82            match n#node_type with
  83               Pxp_document.T_element var ->
  84                Hashtbl.add vars var (resolve (n#sub_nodes))
  85             | _ -> raise Impossible
  86       )
  87       (d#root#sub_nodes)
  88 ;;
  89
  90 (* try to read a configuration variable, given its name into the
  91  * configuration.xml file and its name into the shell environment.
  92  * The shell variable, if present, has precedence over configuration.xml
  93  *)
  94 let read_configuration_var_env xml_name env_name =
  95  try
  96   try
  97    Sys.getenv env_name
  98   with
  99    Not_found -> Hashtbl.find vars xml_name
 100  with
 101   Not_found ->
 102    Printf.printf "Sorry, cannot find variable `%s', please check your configuration\n" xml_name ;
 103    flush stdout ;
 104    raise Not_found
 105
 106 let read_configuration_var xml_name =
 107  try
 108   Hashtbl.find vars xml_name
 109  with
 110   Not_found ->
 111    Printf.printf "Sorry, cannot find variable `%s', please check your configuration\n" xml_name ;
 112    flush stdout ;
 113    raise Not_found
 114
 115 (* Zack: no longer used *)
 116 (* let tmp_dir       = read_configuration_var_env "tmp_dir" "HELM_TMP_DIR";; *)
 117 let getter_url    = read_configuration_var_env "getter_url" "HELM_GETTER_URL";;
 118 let processor_url = read_configuration_var_env "processor_url" "HELM_PROCESSOR_URL";;
 119 let annotations_dir = read_configuration_var_env "annotations_dir" "HELM_ANNOTATIONS_DIR"
 120 let annotations_url = read_configuration_var_env "annotations_url" "HELM_ANNOTATIONS_URL"
 121
 122 let _ = Hashtbl.clear vars;;