ported to regexp based /ls method

diff --git a/helm/http_getter/main.ml b/helm/http_getter/main.ml
index 8fa671ab9febd8ae04b44c687cca723f40505aee..44c69610e1d4e0ffffcef79d3c332988e127ed8f 100644 (file)
--- a/helm/http_getter/main.ml
+++ b/helm/http_getter/main.ml
@@ -69,26 +69,6 @@ let parse_output_format meth (req: Http_types.request) =
   | s when String.lowercase s = "xml" -> `Xml
   | s -> raise (Bad_request ("Invalid /" ^ meth ^ " format: " ^ s))
 
-  (* parse "baseuri" format for /ls method, no default value *)
-let parse_ls_uri =
-  let parse_ls_RE = Pcre.regexp "^(\\w+):(.*)$" in
-  let trailing_slash_RE = Pcre.regexp "/+$" in
-  let wrong_uri uri =
-    raise (Bad_request ("Invalid /ls baseuri: " ^ uri))
-  in
-  fun (req: Http_types.request) ->
-    let baseuri = req#param "baseuri" in
-    try
-      let subs =
-        Pcre.extract ~rex:parse_ls_RE
-          (Pcre.replace ~rex:trailing_slash_RE  baseuri)
-      in
-      (match (subs.(1), subs.(2)) with
-      | "cic", uri -> Cic uri
-      | "theory", uri -> Theory uri
-      | _ -> wrong_uri baseuri)
-    with Not_found -> wrong_uri baseuri
-
   (* parse "position" argument, default is 0 *)
 let parse_position (req: Http_types.request) =
   try
@@ -164,8 +144,8 @@ let return_all_xml_uris fmt outchan =
 let return_all_rdf_uris classs outchan =
   return_all_foo_uris "allrdfuris" (Http_getter.getallrdfuris classs) outchan
 
-let return_ls xmluri fmt outchan =
-  let ls_items = Http_getter.ls xmluri in
+let return_ls regexp fmt outchan =
+  let ls_items = Http_getter.ls regexp in
   let buf = Buffer.create 10240 in
   (match fmt with
   | `Text ->
@@ -303,7 +283,7 @@ let callback (req: Http_types.request) outchan =
        return_all_xml_uris (parse_output_format "getalluris" req) outchan
     | "/getallrdfuris" -> return_all_rdf_uris (parse_rdf_class req) outchan
     | "/ls" ->
-       return_ls (parse_ls_uri req) (parse_output_format "ls" req) outchan
+        return_ls (req#param "baseuri") (parse_output_format "ls" req) outchan
     | "/getempty" ->
         Http_daemon.respond ~body:Http_getter_const.empty_xml outchan
     | invalid_request ->