split into two major parts:

[helm.git] / helm / http_getter / http_getter_env.ml

diff --git a/helm/http_getter/http_getter_env.ml b/helm/http_getter/http_getter_env.ml
index 54269279535eaf0828818a2770672d0fa24375d4..a7ab80f24ef81c14a1dc01cd88ebd17d628caeba 100644 (file)
--- a/helm/http_getter/http_getter_env.ml
+++ b/helm/http_getter/http_getter_env.ml
@@ -1,9 +1,10 @@
 (*
- * Copyright (C) 2003:
+ * Copyright (C) 2003-2004:
  *    Stefano Zacchiroli <zack@cs.unibo.it>
  *    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
+ *  This file is part of HELM, an Hypertextual, Electronic
+ *  Library of Mathematics, developed at the Computer Science
  *  Department, University of Bologna, Italy.
  *
  *  HELM is free software; you can redistribute it and/or
@@ -25,11 +26,12 @@
  *  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
 
@@ -77,18 +79,25 @@ let safe_getenv ?(from = Both) var =
 
 let servers_file = safe_getenv "HTTP_GETTER_SERVERS_FILE"
 
-  (* TODO BUG HERE: is commented lines are included in the servers file the
-  server index (used for example by the remove_server method) gets out of sync!
-  *)
-let parse_servers () =
+let load_servers () =
+  let pos = ref (-1) in
   List.rev (Http_getter_misc.fold_file
-    (fun servers line ->
-      if Http_getter_misc.is_blank_line line then servers else line::servers)
+    (fun line servers ->
+      if Http_getter_misc.is_blank_line line then
+        servers
+      else
+        (incr pos; (!pos, line) :: servers))
     []
     servers_file)
-;;
-let servers = ref (parse_servers ())
-let reload_servers () = servers := parse_servers ()
+
+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"
@@ -125,8 +134,7 @@ let cache_mode =
   | "gz" -> Enc_gzipped
   | mode -> failwith ("Invalid cache mode: " ^ mode)
 
-let reload () =
-  reload_servers ()
+let reload () = reload_servers ()
 
 let env_to_string () =
   sprintf
@@ -159,19 +167,27 @@ servers:
     dtd_base_url
     (match cache_mode with Enc_normal -> "Normal" | Enc_gzipped -> "GZipped")
     conf_file conf_dir
-    (String.concat "\n\t" (* servers list prepended with server number *)
-      (List.map
-        (let idx = ref ~-1 in
-        fun server -> incr idx; sprintf "%3d: %s" !idx server)
-        !servers))
+    (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
-  | Some p -> Http_getter_misc.add_line ~fname:servers_file ~position:p url
-  | None -> Http_getter_misc.add_line ~fname:servers_file url);
+  | 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 =
-  Http_getter_misc.remove_line ~fname:servers_file position;
+  _servers := List.remove_assoc position !_servers;
+  save_servers ();
   reload_servers ()