X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fhttp_getter%2Fhttp_getter_env.ml;h=a7ab80f24ef81c14a1dc01cd88ebd17d628caeba;hb=3f81a72dbdc7f2ffb17cc1ecd4e6a39270891c77;hp=70696c5965f33dee94ced3c6a6a40721f0fee3e2;hpb=820fd1d8c05fcf75c12f635903728cb17abd4576;p=helm.git diff --git a/helm/http_getter/http_getter_env.ml b/helm/http_getter/http_getter_env.ml index 70696c596..a7ab80f24 100644 --- a/helm/http_getter/http_getter_env.ml +++ b/helm/http_getter/http_getter_env.ml @@ -1,5 +1,7 @@ (* - * Copyright (C) 2003, HELM Team. + * Copyright (C) 2003-2004: + * Stefano Zacchiroli + * for the HELM Team http://helm.cs.unibo.it/ * * This file is part of HELM, an Hypertextual, Electronic * Library of Mathematics, developed at the Computer Science @@ -21,14 +23,17 @@ * MA 02111-1307, USA. * * For details, see the HELM World-Wide-Web page, - * http://cs.unibo.it/helm/. + * http://helm.cs.unibo.it/ *) -open Http_getter_types;; -open Printf;; -open Pxp_document;; -open Pxp_types;; -open Pxp_yacc;; +open Printf +open Pxp_document +open Pxp_types +open Pxp_yacc + +open Http_getter_types + +let version = Http_getter_const.version type setting_src = | Environment (* read setting from environment variables *) @@ -42,7 +47,7 @@ let (conf_file, conf_dir) = let conf_dir = Pcre.replace ~pat:"/$" (Sys.getenv "HELM_CONFIGURATION_DIR") in - (conf_dir ^ "/configuration.xml", conf_dir) + (conf_dir ^ "/" ^ Http_getter_const.conffile, conf_dir) with Not_found -> failwith "HELM_CONFIGURATION_DIR undefined" let safe_getenv ?(from = Both) var = @@ -73,17 +78,36 @@ let safe_getenv ?(from = Both) var = | v -> return_value var v))) let servers_file = safe_getenv "HTTP_GETTER_SERVERS_FILE" -let servers = - let cons hd tl = hd @ [ tl ] in - Http_getter_misc.fold_file cons [] servers_file -let xml_dbm = safe_getenv "HTTP_GETTER_XML_DBM" +let load_servers () = + let pos = ref (-1) in + List.rev (Http_getter_misc.fold_file + (fun line servers -> + if Http_getter_misc.is_blank_line line then + servers + else + (incr pos; (!pos, line) :: servers)) + [] + servers_file) + +let _servers = ref (load_servers ()) +let servers () = !_servers + +let save_servers () = + let oc = open_out servers_file in + List.iter (fun (_,server) -> output_string oc (server ^ "\n")) (servers ()); + close_out oc +let reload_servers () = _servers := load_servers () + +let cic_dbm = safe_getenv "HTTP_GETTER_CIC_DBM" +let nuprl_dbm = safe_getenv "HTTP_GETTER_NUPRL_DBM" let rdf_dbm = safe_getenv "HTTP_GETTER_RDF_DBM" let xsl_dbm = safe_getenv "HTTP_GETTER_XSL_DBM" let xml_index = safe_getenv "HTTP_GETTER_XML_INDEXNAME" let rdf_index = safe_getenv "HTTP_GETTER_RDF_INDEXNAME" let xsl_index = safe_getenv "HTTP_GETTER_XSL_INDEXNAME" -let xml_dir = safe_getenv "HTTP_GETTER_XML_DIR" +let cic_dir = safe_getenv "HTTP_GETTER_CIC_DIR" +let nuprl_dir = safe_getenv "HTTP_GETTER_NUPRL_DIR" let rdf_dir = safe_getenv "HTTP_GETTER_RDF_DIR" let dtd_dir = safe_getenv "HTTP_GETTER_DTD_DIR" @@ -110,15 +134,21 @@ let cache_mode = | "gz" -> Enc_gzipped | mode -> failwith ("Invalid cache mode: " ^ mode) -let dump_env () = - printf -"xml_dbm:\t%s +let reload () = reload_servers () + +let env_to_string () = + sprintf +"HTTP Getter %s (the OCaml one!) + +cic_dbm:\t%s +nuprl_dbm:\t%s rdf_dbm:\t%s xsl_dbm:\t%s xml_index:\t%s rdf_index:\t%s xsl_index:\t%s -xml_dir:\t%s +cic_dir:\t%s +nuprl_dir:\t%s rdf_dir:\t%s dtd_dir:\t%s servers_file:\t%s @@ -132,10 +162,32 @@ conf_dir:\t%s servers: \t%s " - xml_dbm rdf_dbm xsl_dbm xml_index rdf_index xsl_index - xml_dir rdf_dir dtd_dir servers_file host port - my_own_url dtd_base_url + version cic_dbm nuprl_dbm rdf_dbm xsl_dbm xml_index rdf_index xsl_index + cic_dir nuprl_dir rdf_dir dtd_dir servers_file host port my_own_url + dtd_base_url (match cache_mode with Enc_normal -> "Normal" | Enc_gzipped -> "GZipped") - conf_file conf_dir (String.concat "\n\t" servers); - flush stdout + conf_file conf_dir + (String.concat "\n\t" (* (position * server) list *) + (List.map (fun (pos, server) -> sprintf "%3d: %s" pos server) + (servers ()))) + +let add_server ?position url = + (match position with + | None -> + _servers := !_servers @ [-1, url]; + | Some p when p > 0 -> + let rec add_after pos = function + | [] -> [-1, url] + | hd :: tl when p = 1 -> hd :: (-1, url) :: tl + | hd :: tl (* when p > 1 *) -> hd :: (add_after (pos - 1) tl) + in + _servers := add_after p !_servers + | Some _ -> assert false); + save_servers (); + reload_servers () + +let remove_server position = + _servers := List.remove_assoc position !_servers; + save_servers (); + reload_servers ()