(*
- * 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
* 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
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"
| "gz" -> Enc_gzipped
| mode -> failwith ("Invalid cache mode: " ^ mode)
-let reload () =
- reload_servers ()
+let reload () = reload_servers ()
let env_to_string () =
sprintf
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 ()