X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FDEVEL%2Frdfly%2Fquery.ml;h=f63d780cbb5bf769088d931032be1c945209d3ee;hb=d6a9268278d123d3d20b7833a3a83c8abed6bb02;hp=2ea00d0c2a65d60dc2175150cfbf86d0a106f1e2;hpb=d07851ade676917a00ad479fb427dff0dfd06ff3;p=helm.git
diff --git a/helm/DEVEL/rdfly/query.ml b/helm/DEVEL/rdfly/query.ml
index 2ea00d0c2..f63d780cb 100644
--- a/helm/DEVEL/rdfly/query.ml
+++ b/helm/DEVEL/rdfly/query.ml
@@ -1,17 +1,105 @@
-let db = Postgres.Connection.connect "dbname=mowgli user=helm host=mowgli.cs.unibo.it"
-
-let _ =
- let status =
- match Postgres.Connection.status db with
- Postgres.Connection.Ok -> "ok"
- | _ -> "bad"
- in
- Printf.printf "connection status is %s\n" status ;
- flush stdout
-
-let res = Postgres.Connection.exec db "SELECT * FROM refObj WHERE source = 'cic:/Coq/Arith/Le/le_O_n.con';"
-
-let _ =
- Printf.printf "# results: %d\n" (Postgres.Result.ntuples res) ;
- flush stdout
+module PG = Postgres
+
+let open_db connection_string =
+ try
+ new PG.connection connection_string
+ with
+ PG.Error e as exc ->
+ prerr_endline (PG.string_of_error e) ;
+ raise exc
+
+let extract_position s =
+ let sharp_pos = String.rindex s '#' + 1 in
+ String.sub s sharp_pos ((String.length s) - sharp_pos)
+
+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
+
+let msg_output_header msg obj =
+ msg_output_string msg "\n\n" ;
+ msg_output_string msg ("\n \n")
+
+let msg_output_trailer msg =
+ msg_output_string msg " \n\n"
+
+let forward_metadata db obj =
+ let res = db#exec ("SELECT * FROM refObj WHERE source = '" ^ obj ^ "';") in
+ let msg = mk_new_msg () in
+ msg_output_header msg obj ;
+ for i = res#ntuples downto 1 do
+ let position = extract_position (res#getvalue (i - 1) 2)
+ and occurrence = res#getvalue (i - 1) 1 in
+ msg_output_string msg " \n \n" ;
+ msg_output_string msg (" " ^ position ^ "\n") ;
+ msg_output_string msg (" " ^ occurrence ^ "\n") ;
+ msg_output_string msg " \n \n"
+ done ;
+ msg_output_trailer msg ;
+ msg_serialize msg
+
+let backward_metadata db obj =
+ let res = db#exec ("SELECT * FROM refObj WHERE h_occurrence = '" ^ obj ^ "';") in
+ let msg = mk_new_msg () in
+ msg_output_header msg obj ;
+ for i = res#ntuples downto 1 do
+ let position = extract_position (res#getvalue (i - 1) 2)
+ and occurrence = res#getvalue (i - 1) 0 in
+ msg_output_string msg " \n \n" ;
+ msg_output_string msg (" " ^ position ^ "\n") ;
+ msg_output_string msg (" " ^ occurrence ^ "\n") ;
+ msg_output_string msg " \n \n"
+ done ;
+ msg_output_trailer msg ;
+ msg_serialize msg
+
+let debug_print s = prerr_endline ("[RDFly] " ^ s)
+
+let mk_return_fun contype msg outchan =
+ Http_daemon.respond
+ ~body:msg ~headers:["Content-Type", contype] 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_html_error s = return_html ("" ^ s ^ "")
+
+let callback (req: Http_types.request) ch =
+ try
+ debug_print ("Connection from " ^ req#clientAddr) ;
+ debug_print ("Received request: " ^ req#path) ;
+ (match req#path with
+ | "/help" ->
+ return_html_error "yeah right..." ch
+ | "/get" ->
+ let obj = req#param "object"
+ and kind = req#param "kind" in
+ let db = open_db "dbname='mowgli' user='helm'" in
+ begin
+ match kind with
+ "forward" -> return_xml (forward_metadata db obj) ch
+ | "backward" -> return_xml (backward_metadata db obj) ch
+ | s -> return_html_error ("unsupported kind: " ^ s) ch
+ end ;
+ db#close
+ | invalid_request -> Http_daemon.respond_error ~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
+ | exc ->
+ return_html_error ("Uncaught exception: " ^ (Printexc.to_string exc)) ch
+
+let main () =
+ Sys.catch_break true;
+ try
+ Http_daemon.start'
+ ~timeout:(Some 600) ~port:58088 callback
+ with Sys.Break -> ()
+in
+
+main ()
+