prima implementazione di demodulate, superposition_left e superposition_right

[helm.git] / helm / ocaml / getter / http_getter_cache.ml

diff --git a/helm/ocaml/getter/http_getter_cache.ml b/helm/ocaml/getter/http_getter_cache.ml
index 2802f9926fc847637985450bcd812c20e1df106b..e6627fa1e3ddab95761eba19c3b407e75cab8a92 100644 (file)
--- a/helm/ocaml/getter/http_getter_cache.ml
+++ b/helm/ocaml/getter/http_getter_cache.ml
@@ -76,7 +76,8 @@ let is_in_cache basename =
 let respond_xml
   ?(via_http = true) ?(enc = `Normal) ?(patch = true) ~url ~uri outchan
   =
-  let local_resource = Http_getter_misc.is_local_url url in
+  let local_part = Http_getter_misc.local_url url in
+  let local_resource = local_part <> None in
   let resource_type = resource_type_of_url url in
   let extension = extension_of_resource_type resource_type in
   let downloadname =
@@ -109,9 +110,9 @@ let respond_xml
       None
     in
      if patch then
-       Http_getter_common.patch_xml ?xmlbases ~via_http ()
+       Some (Http_getter_common.patch_xml ?xmlbases ~via_http ())
      else
-       (fun x -> x)
+       None
   in
   let basename = Pcre.replace ~pat:"\\.gz$" downloadname in
   let contype = "text/xml" in
@@ -167,6 +168,7 @@ let respond_xml
   let tmp_short_circuit = fill_cache () in
   threadSafe#doReader (lazy(
     assert (local_resource || is_in_cache basename);
+    let basename = match local_part with Some f -> f | None -> basename in
     let resource_type =
       if local_resource then
         resource_type
@@ -180,13 +182,14 @@ let respond_xml
         | `Normal ->
             Http_getter_logger.log ~level:2
               "No format mangling required (encoding = normal)";
-            return_file ~via_http ~fname:basename ~contype ~patch_fun outchan
+            return_file ~via_http ~fname:basename ~contype ?patch_fun ~enc
+              outchan
         | `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
+              ?patch_fun ~gunzip:true ~enc
               outchan)
     | `Normal, `Gzipped | `Gzipped, `Normal ->
         (match tmp_short_circuit with
@@ -200,27 +203,27 @@ let respond_xml
               (* required format normal, cached (or local) version gzipped *)
               gunzip  (* gunzip to tmp *)
                 ~output:tmp ~keep:true (basename ^ ".gz");
-              return_file ~via_http ~fname:tmp ~contype ~patch_fun outchan;
+              return_file ~via_http ~fname:tmp ~contype ?patch_fun ~enc outchan
             | `Gzipped ->
               (* required format is gzipped, cached version is normal *)
               gzip ~output:tmp ~keep:true basename;  (* gzip to tmp *)
               return_file
                 ~via_http ~fname:tmp ~contype ~contenc:"x-gzip"
-                ~patch_fun ~gunzip:true
+                ?patch_fun ~gunzip:true ~enc
                 outchan)
           ))
         | Some (fname, `Normal) ->  (* short circuit available, use it! *)
             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
+              return_file ~via_http ~fname ~contype ?patch_fun ~enc outchan
             ))
         | Some (fname, `Gzipped) -> (* short circuit available, use it! *)
             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
+              return_file ~via_http ~fname ~contype ~contenc:"x-gzip" ?patch_fun
+                ~gunzip:true ~enc outchan
             )))
   ))
 
@@ -234,7 +237,7 @@ let respond_xsl
   let fname = tempfile () in
   finally (fun () -> Sys.remove fname) (lazy (
     wget ~output:fname url;
-    return_file ~via_http ~fname ~contype:"text/xml" ~patch_fun outchan
+    return_file ~via_http ~fname ~contype:"text/xml" ~patch_fun ~enc outchan
   ))
 
   (* TODO enc is not yet supported *)
@@ -246,7 +249,8 @@ let respond_dtd
   in
   if Sys.file_exists url then
     (* TODO check this: old getter here used text/xml *)
-    return_file ~via_http ~fname:url ~contype:"text/plain" ~patch_fun outchan
+    return_file ~via_http ~fname:url ~contype:"text/plain" ~patch_fun ~enc 
+      outchan
   else
     raise (Dtd_not_found url)