http_getter.cmi: http_getter_types.cmo
clientHTTP.cmo: clientHTTP.cmi
clientHTTP.cmx: clientHTTP.cmi
-http_getter_debugger.cmo: http_getter_debugger.cmi
-http_getter_debugger.cmx: http_getter_debugger.cmi
-http_getter_misc.cmo: http_getter_debugger.cmi http_getter_misc.cmi
-http_getter_misc.cmx: http_getter_debugger.cmx http_getter_misc.cmi
+http_getter_logger.cmo: http_getter_logger.cmi
+http_getter_logger.cmx: http_getter_logger.cmi
+http_getter_misc.cmo: http_getter_misc.cmi
+http_getter_misc.cmx: http_getter_misc.cmi
http_getter_const.cmo: http_getter_const.cmi
http_getter_const.cmx: http_getter_const.cmi
http_getter_env.cmo: http_getter_const.cmi http_getter_misc.cmi \
http_getter_types.cmx http_getter_common.cmi
http_getter_map.cmo: http_getter_map.cmi
http_getter_map.cmx: http_getter_map.cmi
-http_getter_cache.cmo: http_getter_common.cmi http_getter_debugger.cmi \
- http_getter_env.cmi http_getter_misc.cmi http_getter_types.cmo \
- http_getter_cache.cmi
-http_getter_cache.cmx: http_getter_common.cmx http_getter_debugger.cmx \
- http_getter_env.cmx http_getter_misc.cmx http_getter_types.cmx \
- http_getter_cache.cmi
+http_getter_cache.cmo: http_getter_common.cmi http_getter_env.cmi \
+ http_getter_misc.cmi http_getter_types.cmo http_getter_cache.cmi
+http_getter_cache.cmx: http_getter_common.cmx http_getter_env.cmx \
+ http_getter_misc.cmx http_getter_types.cmx http_getter_cache.cmi
http_getter.cmo: clientHTTP.cmi http_getter_cache.cmi http_getter_common.cmi \
- http_getter_const.cmi http_getter_debugger.cmi http_getter_env.cmi \
- http_getter_map.cmi http_getter_misc.cmi http_getter_types.cmo \
- http_getter.cmi
+ http_getter_const.cmi http_getter_env.cmi http_getter_map.cmi \
+ http_getter_misc.cmi http_getter_types.cmo http_getter.cmi
http_getter.cmx: clientHTTP.cmx http_getter_cache.cmx http_getter_common.cmx \
- http_getter_const.cmx http_getter_debugger.cmx http_getter_env.cmx \
- http_getter_map.cmx http_getter_misc.cmx http_getter_types.cmx \
- http_getter.cmi
+ http_getter_const.cmx http_getter_env.cmx http_getter_map.cmx \
+ http_getter_misc.cmx http_getter_types.cmx http_getter.cmi
INTERFACE_FILES = \
clientHTTP.mli \
- http_getter_debugger.mli \
+ http_getter_logger.mli \
http_getter_misc.mli \
http_getter_const.mli \
http_getter_env.mli \
open Http_getter_common
open Http_getter_misc
-open Http_getter_debugger
open Http_getter_types
exception Not_implemented of string
| uri -> raise (Unresolvable_URI uri)
let update_from_server logger server_url = (* use global maps *)
- debug_print ("Updating information from " ^ server_url);
+ Http_getter_logger.log ("Updating information from " ^ server_url);
let xml_url_of_uri = function
(* TODO missing sanity checks on server_url, e.g. it can contains $1 *)
| uri when (Pcre.pmatch ~rex:heading_cic_RE uri) ->
http_get (server_url ^ "/" ^ (Lazy.force Http_getter_env.xsl_index)))
in
if (xml_index = None && rdf_index = None && xsl_index = None) then
- debug_print (sprintf "Warning: useless server %s" server_url);
+ Http_getter_logger.log (sprintf "Warning: useless server %s" server_url);
(match xml_index with
| Some xml_index ->
logger (`T "- Updating XML db ...");
logger (`T "All done");
logger `BR
| None -> ());
- debug_print "done with this server"
+ Http_getter_logger.log "done with this server"
let update_from_all_servers logger () = (* use global maps *)
clear_maps ();
clients, uwobo (java implementation, not yet tested with the OCaml one)
starts looping sending output to one of the client *)
-open Http_getter_common;;
-open Http_getter_debugger;;
-open Http_getter_misc;;
-open Http_getter_types;;
-open Printf;;
+open Http_getter_common
+open Http_getter_misc
+open Http_getter_types
+open Printf
(* expose ThreadSafe.threadSafe methods *)
class threadSafe =
let fill_cache () =
threadSafe#doWriter (lazy(
if not (is_in_cache basename) then begin (* cache MISS *)
- debug_print "Cache MISS :-(";
+ Http_getter_logger.log ~level:2 "Cache MISS :-(";
mkdir ~parents:true (Filename.dirname downloadname);
match (resource_type, Lazy.force Http_getter_env.cache_mode) with
| `Normal, `Normal | `Gzipped, `Gzipped ->
res
));
end else begin
- debug_print "Cache HIT :-)";
+ Http_getter_logger.log ~level:2 "Cache HIT :-)";
None
end
)) in
(* resource in cache is already in the required format *)
(match enc with
| `Normal ->
- debug_print "No format mangling required (encoding = normal)";
+ Http_getter_logger.log ~level:2
+ "No format mangling required (encoding = normal)";
return_file ~via_http ~fname:basename ~contype ~patch_fun outchan
| `Gzipped ->
- debug_print "No format mangling required (encoding = gzipped)";
+ Http_getter_logger.log ~level:2
+ "No format mangling required (encoding = gzipped)";
return_file
~via_http ~fname:(basename ^ ".gz") ~contype ~contenc:"x-gzip"
~patch_fun ~gunzip:true
| `Normal, `Gzipped | `Gzipped, `Normal ->
(match tmp_short_circuit with
| None -> (* no short circuit possible, use cache *)
- debug_print "No short circuit available, use cache";
+ Http_getter_logger.log ~level:2
+ "No short circuit available, use cache";
let tmp = tempfile () in
finally (fun () -> Sys.remove tmp) (lazy (
(match enc with
outchan)
))
| Some (fname, `Normal) -> (* short circuit available, use it! *)
- debug_print "Using short circuit (encoding = normal)";
+ Http_getter_logger.log ~level:2
+ "Using short circuit (encoding = normal)";
finally (fun () -> Sys.remove fname) (lazy (
return_file ~via_http ~fname ~contype ~patch_fun outchan
))
| Some (fname, `Gzipped) -> (* short circuit available, use it! *)
- debug_print "Using short circuit (encoding = gzipped)";
+ Http_getter_logger.log ~level:2
+ "Using short circuit (encoding = gzipped)";
finally (fun () -> Sys.remove fname) (lazy (
return_file ~via_http ~fname ~contype ~contenc:"x-gzip" ~patch_fun
~gunzip:true outchan
+++ /dev/null
-(*
- * 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
- * Department, University of Bologna, Italy.
- *
- * HELM is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License
- * as published by the Free Software Foundation; either version 2
- * of the License, or (at your option) any later version.
- *
- * HELM is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with HELM; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
- * MA 02111-1307, USA.
- *
- * For details, see the HELM World-Wide-Web page,
- * http://helm.cs.unibo.it/
- *)
-
-let debug = ref true
-
-(* invariant: if logfile is set, then logchan is set too *)
-let logfile = ref None
-let logchan = ref None
-
-let set_logfile f =
- (match !logchan with None -> () | Some oc -> close_out oc);
- match f with
- | Some f ->
- logfile := Some f;
- logchan := Some (open_out f)
- | None ->
- logfile := None;
- logchan := None
-
-let get_logfile () = !logfile
-
-let close_logfile () = set_logfile None
-
-let debug_print s =
- let msg = "[HTTP-Getter] " ^ s in
- if !debug then
- match (!logfile, !logchan) with
- | None, _ -> prerr_endline msg
- | Some fname, Some oc ->
- output_string oc msg;
- flush oc
- | Some _, None -> assert false
-
+++ /dev/null
-(*
- * 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
- * Department, University of Bologna, Italy.
- *
- * HELM is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License
- * as published by the Free Software Foundation; either version 2
- * of the License, or (at your option) any later version.
- *
- * HELM is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with HELM; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
- * MA 02111-1307, USA.
- *
- * For details, see the HELM World-Wide-Web page,
- * http://helm.cs.unibo.it/
- *)
-
-(** {2 Debugger and logger} *)
-
- (** enable/disable debugging messages *)
-val debug: bool ref
-
- (** output a debugging message *)
-val debug_print: string -> unit
-
- (** if set to Some fname, fname will be used as a logfile, otherwise stderr
- * will be used *)
-val get_logfile: unit -> string option
-val set_logfile: string option -> unit
-val close_logfile: unit -> unit
-
cache_mode:\t%s
servers:
\t%s
+log_file:\t%s
+log_level:\t%d
"
version (Lazy.force cic_dbm) (Lazy.force nuprl_dbm) (Lazy.force rdf_dbm)
(Lazy.force xsl_dbm) (Lazy.force xml_index)
(String.concat "\n\t" (* (position * server) list *)
(List.map (fun (pos, server) -> sprintf "%3d: %s" pos server)
(servers ())))
+ (match Http_getter_logger.get_log_file () with None -> "None" | Some f -> f)
+ (Http_getter_logger.get_log_level ())
let add_server ?position url =
let new_servers =
--- /dev/null
+(*
+ * 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
+ * Department, University of Bologna, Italy.
+ *
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+let log_level = ref 1
+let get_log_level () = !log_level
+let set_log_level l = log_level := l
+
+(* invariant: if logfile is set, then logchan is set too *)
+let logfile = ref None
+let logchan = ref None
+
+let set_log_file f =
+ (match !logchan with None -> () | Some oc -> close_out oc);
+ match f with
+ | Some f ->
+ logfile := Some f;
+ logchan := Some (open_out f)
+ | None ->
+ logfile := None;
+ logchan := None
+
+let get_log_file () = !logfile
+
+let close_log_file () = set_log_file None
+
+let log ?(level = 1) s =
+ if level <= !log_level then
+ let msg = "[HTTP-Getter] " ^ s in
+ match (!logfile, !logchan) with
+ | None, _ -> prerr_endline msg
+ | Some fname, Some oc ->
+ output_string oc msg;
+ flush oc
+ | Some _, None -> assert false
+
--- /dev/null
+(*
+ * 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
+ * Department, University of Bologna, Italy.
+ *
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+(** {2 Debugger and logger} *)
+
+ (** log level
+ * 0 -> logging disabled
+ * 1 -> standard logging
+ * >=2 -> verbose logging
+ * default is 1 *)
+val get_log_level: unit -> int
+val set_log_level: int -> unit
+
+ (** log a message through the logger with a given log level
+ * level defaults to 1, higher level denotes more verbose messages which are
+ * ignored with the default log_level *)
+val log: ?level: int -> string -> unit
+
+ (** if set to Some fname, fname will be used as a logfile, otherwise stderr
+ * will be used *)
+val get_log_file: unit -> string option
+val set_log_file: string option -> unit
+val close_log_file: unit -> unit
+
open Printf
-open Http_getter_debugger
-
let trailing_dot_gz_RE = Pcre.regexp "\\.gz$" (* for g{,un}zip *)
let url_RE = Pcre.regexp "^([\\w.-]+)(:(\\d+))?(/.*)?$"
let http_scheme_RE = Pcre.regexp ~flags:[`CASELESS] "^http://"
close_in ic; close_out oc
let wget ?output url =
- debug_print
+ Http_getter_logger.log
(sprintf "wgetting %s (output: %s)" url
(match output with None -> "default" | Some f -> f));
match url with
let gzip ?(keep = false) ?output fname =
let output = match output with None -> fname ^ ".gz" | Some fname -> fname in
- debug_print (sprintf "gzipping %s (keep: %b, output: %s)" fname keep output);
+ Http_getter_logger.log ~level:3
+ (sprintf "gzipping %s (keep: %b, output: %s)" fname keep output);
let (ic, oc) = (open_in fname, Gzip.open_out output) in
let buf = String.create bufsiz in
(try
"Http_getter_misc.gunzip: unable to determine output file name"
| Some fname -> fname
in
- debug_print (sprintf "gunzipping %s (keep: %b, output: %s)"
- fname keep output);
+ Http_getter_logger.log ~level:3
+ (sprintf "gunzipping %s (keep: %b, output: %s)" fname keep output);
let (ic, oc) = (Gzip.open_in fname, open_out output) in
let buf = String.create bufsiz in
(try
try
Some (Http_client.http_get url)
with e ->
- debug_print (sprintf
+ Http_getter_logger.log (sprintf
"Warning: Http_client failed on url %s with exception: %s"
url (Printexc.to_string e));
None
projects / helm.git / commitdiff