From a3b2a5b4a985644c7bd7271b40b599e154d347ef Mon Sep 17 00:00:00 2001
From: Stefano Zacchiroli <zack@upsilon.cc>
Date: Fri, 9 Apr 2004 15:09:28 +0000
Subject: [PATCH] ported to latest polymorphic variant types

---
 helm/http_getter/main.ml | 23 ++++++++++++-----------
 1 file changed, 12 insertions(+), 11 deletions(-)

diff --git a/helm/http_getter/main.ml b/helm/http_getter/main.ml
index faf899b80..974d029e5 100644
--- a/helm/http_getter/main.ml
+++ b/helm/http_getter/main.ml
@@ -35,7 +35,8 @@ open Http_getter_debugger
 
   (* constants *)
 
-let configuration_file = "/projects/helm/etc/http_getter.conf.xml"
+(* let configuration_file = "/projects/helm/etc/http_getter.conf.xml" *)
+let configuration_file = "http_getter.conf.xml"
 
 let common_headers = [
   "Cache-Control", "no-cache";
@@ -45,14 +46,14 @@ let common_headers = [
 
   (* HTTP queries argument parsing *)
 
-  (* parse encoding ("format" parameter), default is Enc_normal *)
+  (* parse encoding ("format" parameter), default is `Normal *)
 let parse_enc (req: Http_types.request) =
   try
     (match req#param "format" with
-    | "normal" -> Enc_normal
-    | "gz" -> Enc_gzipped
+    | "normal" -> `Normal
+    | "gz" -> `Gzipped
     | s -> raise (Bad_request ("Invalid format: " ^ s)))
-  with Http_types.Param_not_found _ -> Enc_normal
+  with Http_types.Param_not_found _ -> `Normal
 
   (* parse "patch_dtd" parameter, default is true *)
 let parse_patch (req: Http_types.request) =
@@ -66,8 +67,8 @@ let parse_patch (req: Http_types.request) =
   (* parse output format ("format" parameter), no default value *)
 let parse_output_format meth (req: Http_types.request) =
   match req#param "format" with
-  | s when String.lowercase s = "txt" -> Fmt_text
-  | s when String.lowercase s = "xml" -> Fmt_xml
+  | s when String.lowercase s = "txt" -> `Text
+  | s when String.lowercase s = "xml" -> `Xml
   | s -> raise (Bad_request ("Invalid /" ^ meth ^ " format: " ^ s))
 
   (* parse "baseuri" format for /ls method, no default value *)
@@ -151,14 +152,14 @@ let return_all_foo_uris doctype uris outchan =
 let return_all_xml_uris fmt outchan =
  let uris = Http_getter.getalluris () in
   match fmt with
-   | Fmt_text ->
+   | `Text ->
       let buf = Buffer.create 10240 in
        List.iter (bprintf buf "%s\n") uris ;
        let body = Buffer.contents buf in
        Http_daemon.respond
          ~headers:(("Content-Type", "text/plain") :: common_headers)
          ~body outchan
-   | Fmt_xml ->
+   | `Xml ->
       return_all_foo_uris "alluris" uris outchan
   
 let return_all_rdf_uris classs outchan =
@@ -168,7 +169,7 @@ let return_ls xmluri fmt outchan =
   let ls_items = Http_getter.ls xmluri in
   let buf = Buffer.create 10240 in
   (match fmt with
-  | Fmt_text ->
+  | `Text ->
       List.iter
         (function
           | Ls_section dir -> bprintf buf "dir, %s\n" dir
@@ -179,7 +180,7 @@ let return_ls xmluri fmt outchan =
               (string_of_ls_flag obj.body)
               (string_of_ls_flag obj.proof_tree))
         ls_items
-  | Fmt_xml ->
+  | `Xml ->
       Buffer.add_string buf "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>\n";
       bprintf buf "<!DOCTYPE ls SYSTEM \"%s/getdtd?uri=ls.dtd\">\n"
         (Lazy.force Http_getter_env.my_own_url);
-- 
2.39.2