X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fgetter%2Fhttp_getter_cache.ml;h=144b9ac5f4c5ad99f9ebad8fb528a4977878a3f0;hb=3fd8583f198e7e09995c3a65b5f05a853c8d1646;hp=75730ac21dcbae6b7d1a87022e5143a9635383da;hpb=f44ab01307f10d4165c76e3108542a5bc2035766;p=helm.git diff --git a/helm/ocaml/getter/http_getter_cache.ml b/helm/ocaml/getter/http_getter_cache.ml index 75730ac21..144b9ac5f 100644 --- a/helm/ocaml/getter/http_getter_cache.ml +++ b/helm/ocaml/getter/http_getter_cache.ml @@ -32,11 +32,10 @@ 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 = @@ -102,7 +101,16 @@ let respond_xml (Lazy.force Http_getter_env.rdf_dir) escaped_prefix baseuri extension in let patch_fun = - if patch then Http_getter_common.patch_xml ~via_http () else (fun x -> x) + let xmlbases = + if Http_getter_common.is_theory_uri uri then + Some (Filename.dirname uri, Filename.dirname url) + else + None + in + if patch then + Http_getter_common.patch_xml ?xmlbases ~via_http () + else + (fun x -> x) in let basename = Pcre.replace ~pat:"\\.gz$" downloadname in let contype = "text/xml" in @@ -115,7 +123,7 @@ let respond_xml 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 -> @@ -148,7 +156,7 @@ let respond_xml res )); end else begin - debug_print "Cache HIT :-)"; + Http_getter_logger.log ~level:2 "Cache HIT :-)"; None end )) in @@ -160,10 +168,12 @@ let respond_xml (* 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 @@ -171,7 +181,8 @@ let respond_xml | `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 @@ -189,12 +200,14 @@ let respond_xml 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