open Http_getter_common
open Http_getter_misc
-open Http_getter_debugger
open Http_getter_types
exception Not_implemented of string
type logger_callback = HelmLogger.html_tag -> unit
+let stdout_logger tag = print_string (HelmLogger.string_of_html_tag tag)
+
let not_implemented s = raise (Not_implemented ("Http_getter." ^ s))
let (index_line_sep_RE, index_sep_RE, trailing_types_RE,
| 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) ->
| uri -> raise (Invalid_URI uri)
in
logger (`T ("Processing server: " ^ server_url));
+ logger `BR;
let (xml_index, rdf_index, xsl_index) =
(* TODO keeps index in memory, is better to keep them on temp files? *)
(http_get (server_url ^ "/" ^ (Lazy.force Http_getter_env.xml_index)),
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 ...<br />");
+ logger (`T "- Updating XML db ...");
+(* logger `BR; *)
List.iter
(function
| l when is_blank_line l -> () (* skip blank and commented lines *)
assert (is_cic_uri uri || is_nuprl_uri uri) ;
(map_of_uri uri)#replace
uri ((xml_url_of_uri uri) ^ ".xml")
- | _ -> logger (`T ("Ignoring invalid line: '" ^ l)))
+ | _ ->
+ logger (`T ("Ignoring invalid line: '" ^ l));
+ logger `BR)
with Invalid_URI uri ->
- logger (`T ("Ignoring invalid XML URI: '" ^ l))))
+ logger (`T ("Ignoring invalid XML URI: '" ^ l));
+ logger `BR))
(Pcre.split ~rex:index_sep_RE xml_index); (* xml_index lines *)
- logger (`T "All done")
+ logger (`T "All done");
+ logger `BR
| None -> ());
(match rdf_index with
| Some rdf_index ->
- logger (`T "Updating RDF db ...");
+ logger (`T "- Updating RDF db ...");
+(* logger `BR; *)
List.iter
(fun l ->
try
| [uri] ->
(Lazy.force rdf_map) # replace uri
((rdf_url_of_uri uri) ^ ".xml")
- | _ -> logger (`T ("Ignoring invalid line: '" ^ l)))
+ | _ ->
+ logger (`T ("Ignoring invalid line: '" ^ l));
+ logger `BR)
with Invalid_URI uri ->
- logger (`T ("Ignoring invalid RDF URI: '" ^ l)))
+ logger (`T ("Ignoring invalid RDF URI: '" ^ l));
+ logger `BR)
(Pcre.split ~rex:index_sep_RE rdf_index); (* rdf_index lines *)
- logger (`T "All done")
+ logger (`T "All done");
+ logger `BR
| None -> ());
(match xsl_index with
| Some xsl_index ->
- logger (`T "Updating XSLT db ...");
+ logger (`T "- Updating XSLT db ...");
+(* logger `BR; *)
List.iter
(fun l -> (Lazy.force xsl_map) # replace l (server_url ^ "/" ^ l))
(Pcre.split ~rex:index_sep_RE xsl_index);
- logger (`T "All done")
+ 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 ();
let getdtd_remote ~patch_dtd uri = not_implemented "getdtd_remote"
let clean_cache_remote () = not_implemented "clean_cache_remote"
let list_servers_remote () = not_implemented "list_servers_remote"
-let add_server_remote ~logger ~position name = not_implemented "add_server_remote"
-let remove_server_remote ~logger position = not_implemented "remove_server_remote"
+let add_server_remote ~logger ~position name =
+ not_implemented "add_server_remote"
+let remove_server_remote ~logger position =
+ not_implemented "remove_server_remote"
let getalluris_remote () = not_implemented "getalluris_remote"
let getallrdfuris_remote () = not_implemented "getallrdfuris_remote"
let ls_remote lsuri = not_implemented "ls_remote"
let update_remote logger () =
let answer = ClientHTTP.get (getter_url () ^ "update") in
- logger (`T answer)
+ logger (`T answer);
+ logger `BR
let getxml_remote ~format ~patch_dtd uri =
- ClientHTTP.get_and_save_to_tmp
- (sprintf "%sgetxml?uri=%s&format=%s&patch_dtd=%s"
- (getter_url ()) uri
- (match format with Enc_normal -> "normal" | Enc_gzipped -> "gzipped")
- (match patch_dtd with true -> "yes" | false -> "no"))
+ ClientHTTP.get_and_save_to_tmp
+ (sprintf "%sgetxml?uri=%s&format=%s&patch_dtd=%s"
+ (getter_url ()) uri
+ (match format with `Normal -> "normal" | `Gzipped -> "gzipped")
+ (match patch_dtd with true -> "yes" | false -> "no"))
(* API *)
else
update_from_all_servers logger ()
-let getxml ?(format = Enc_normal) ?(patch_dtd = true) uri =
+let getxml ?(format = `Normal) ?(patch_dtd = true) uri =
if remote () then
getxml_remote ~format ~patch_dtd uri
else begin
let url = resolve uri in
let (fname, outchan) = temp_file_of_uri uri in
- Http_getter_cache.respond_xml ~uri ~url ~enc:format ~patch:patch_dtd
- outchan;
+ Http_getter_cache.respond_xml ~via_http:false ~enc:format ~patch:patch_dtd
+ ~uri ~url outchan;
close_out outchan;
fname
end
else begin
let url = resolve uri in
let (fname, outchan) = temp_file_of_uri uri in
- Http_getter_cache.respond_xsl ~url ~patch:patch_dtd outchan;
+ Http_getter_cache.respond_xsl ~via_http:false ~url ~patch:patch_dtd outchan;
close_out outchan;
fname
end
else begin
let url = Lazy.force Http_getter_env.dtd_dir ^ "/" ^ uri in
let (fname, outchan) = temp_file_of_uri uri in
- Http_getter_cache.respond_dtd ~url ~patch:patch_dtd outchan;
+ Http_getter_cache.respond_dtd ~via_http:false ~url ~patch:patch_dtd outchan;
close_out outchan;
fname
end
projects / helm.git / blobdiff