ocaml 3.09 transition

[helm.git] / helm / DEVEL / rdfly / rdfly.ml
diff --git a/helm/DEVEL/rdfly/rdfly.ml b/helm/DEVEL/rdfly/rdfly.ml

index 724d8f8bd9af6b19b55127a7c23fd301327007fa..b9a79d1397da4941f444b678bc6d62d04322e995 100644 (file)
--- a/helm/DEVEL/rdfly/rdfly.ml
+++ b/helm/DEVEL/rdfly/rdfly.ml
@@ -24,7 +24,7 @@ let mk_new_msg () = ref []
  let msg_output_string msg s = msg := s::!msg
  
  let msg_serialize msg =
-  List.fold_left (fun acc s -> s ^ acc) "" !msg
+  String.concat "" (List.rev !msg)
  
  let msg_output_header msg obj =
    msg_output_string msg "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>\n\n" ;
@@ -35,7 +35,8 @@ let msg_output_trailer msg =
  
  let msg_output_dc_header msg obj =
    msg_output_string msg "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>\n\n" ;
-  msg_output_string msg ("<rdf:RDF xml:lang=\"en\"\n         xmlns:rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\"\n         xmlns:rdfs=\"http://www.w3.org/2000/01/rdf-schema#\"\n         xmlns:dc=\"http://purl.org/metadata/dublin_core#\"\n         xmlns:dcq=\"http://purl.org/metadata/dublin_core_qualifiers#\"\n         xmlns:h=\"http:/www.cs.unibo.it/helm/schemas/schema-h.rdf#\"\n         xmlns:hth=\"http://www.cs.unibo.it/helm/schemas/schema-hth.rdf#\">\n")
+  msg_output_string msg ("<rdf:RDF xml:lang=\"en\"\n         xmlns:rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\"\n         xmlns:rdfs=\"http://www.w3.org/2000/01/rdf-schema#\"\n         xmlns:dc=\"http://purl.org/metadata/dublin_core#\"\n         xmlns:dcq=\"http://purl.org/metadata/dublin_core_qualifiers#\"\n         xmlns:h=\"http:/www.cs.unibo.it/helm/schemas/schema-h.rdf#\"\n         xmlns:hth=\"http://www.cs.unibo.it/helm/schemas/schema-hth.rdf#\">\n") ;
+  msg_output_string msg "  <h:DirectoryOfObjects>"
  ;;
  
  let msg_output_dc_trailer msg =
@@ -130,7 +131,8 @@ let mk_return_fun contype msg outchan =
                                                                                                                                                                                      
  let return_html = mk_return_fun "text/html"
  let return_xml = mk_return_fun "text/xml"
-let return_400 body ch = Http_daemon.respond_error ~code:400 ~body ch
+let return_400 body ch =
+  Http_daemon.respond_error ~code:(`Code 400) ~body ch
  let return_html_error s = return_html ("<html><body>" ^ s ^ "</body></html>")
  
  let get_option key =
@@ -153,7 +155,7 @@ let daemonport = Helm_registry.get_int "rdfly.port";;
  let callback (req: Http_types.request) ch =
    try
      debug_print ("Connection from " ^ req#clientAddr) ;
-    debug_print ("Received request: " ^ req#path) ;
+    debug_print ("Received request: " ^ req#uri) ;
      (match req#path with
      | "/help" ->
          return_html_error "yeah right..." ch
@@ -169,7 +171,9 @@ let callback (req: Http_types.request) ch =
          | s -> return_html_error ("unsupported kind: " ^ s) ch
        end ;
        M.disconnect db
-    | invalid_request -> Http_daemon.respond_error ~status:(`Client_error `Bad_request) ch)
+    | invalid_request ->
+        Http_daemon.respond_error ~code:(`Status (`Client_error `Bad_request))
+          ch)
    with
    | Http_types.Param_not_found attr_name ->
        return_400 (Printf.sprintf "Parameter '%s' is missing" attr_name) ch