From 473fed516103ec08653701ec8f702145c13590cd Mon Sep 17 00:00:00 2001 From: Ferruccio Guidi Date: Wed, 12 Sep 2007 16:23:20 +0000 Subject: [PATCH] rdfly patched to work with the new db structure --- daemons/rdfly/Makefile | 2 +- daemons/rdfly/rdfly.conf.xml.sample | 11 +- daemons/rdfly/rdfly.ml | 166 ++++++++++++---------------- 3 files changed, 77 insertions(+), 102 deletions(-) diff --git a/daemons/rdfly/Makefile b/daemons/rdfly/Makefile index 26e296409..a762f5273 100644 --- a/daemons/rdfly/Makefile +++ b/daemons/rdfly/Makefile @@ -1,5 +1,5 @@ BIN_DIR = /usr/local/bin -REQUIRES = mysql http helm-registry +REQUIRES = http helm-registry helm-hmysql helm-library PREDICATES = OCAMLOPTIONS = -package "$(REQUIRES)" -predicates "$(PREDICATES)" -pp camlp4o ifeq ($(origin OCAMLPATH), undefined) diff --git a/daemons/rdfly/rdfly.conf.xml.sample b/daemons/rdfly/rdfly.conf.xml.sample index 5d479dacf..d84e22426 100644 --- a/daemons/rdfly/rdfly.conf.xml.sample +++ b/daemons/rdfly/rdfly.conf.xml.sample @@ -1,12 +1,11 @@ +
+ mysql://mowgli.cs.unibo.it public helm none library + mysql://mowgli.cs.unibo.it mowgli helm none legacy + file:///tmp/ dust.db helm none user +
-
- localhost - helm - mowgli - 3306 -
58086
diff --git a/daemons/rdfly/rdfly.ml b/daemons/rdfly/rdfly.ml index 8dbb6b051..eadb2c773 100644 --- a/daemons/rdfly/rdfly.ml +++ b/daemons/rdfly/rdfly.ml @@ -1,19 +1,15 @@ -module M = Mysql - - (* First of all we load the configuration *) -let _ = - let configuration_file = "/projects/helm/etc/rdfly.conf.xml" in - Helm_registry.load_from configuration_file -;; - -let open_db ?host ?database ?port ?password ?user = - try - M.quick_connect ?host ?database ?port ?password ?user - with - M.Error e as exc -> - prerr_endline e ; - raise exc +module Registry = Helm_registry +module SQL = HSql +module DB = LibraryDb + +let exec_and_iter dbd query f = + let db_types = [SQL.Library; SQL.Legacy] in + let map db_type = + let res = SQL.exec db_type dbd query in + SQL.iter res ~f + in + List.iter map db_types let extract_position s = let sharp_pos = String.rindex s '#' + 1 in @@ -37,120 +33,101 @@ let msg_output_dc_header msg obj = msg_output_string msg "\n\n" ; msg_output_string msg ("\n") ; msg_output_string msg " " -;; let msg_output_dc_trailer msg = msg_output_string msg " \n" -;; let value_of_optional_value = function None -> assert false | Some v -> v -;; -let forward_metadata db obj = - let res = M.exec db ("SELECT * FROM refObj WHERE source = '" ^ obj ^ "';") in +let forward_metadata dbd obj = let msg = mk_new_msg () in - msg_output_header msg obj ; - M.iter res - ~f:(function cols -> + let query = "SELECT * FROM refObj WHERE source = '" ^ obj ^ "';" in + let map cols = let position = extract_position (value_of_optional_value (cols.(2))) in let occurrence = value_of_optional_value (cols.(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" - ) ; + in + msg_output_header msg obj ; + exec_and_iter dbd query map ; msg_output_trailer msg ; msg_serialize msg -;; -let backward_metadata db obj = - let res = M.exec db ("SELECT * FROM refObj WHERE h_occurrence = '" ^ obj ^ "';") in +let backward_metadata dbd obj = let msg = mk_new_msg () in - msg_output_header msg obj ; - M.iter res - ~f:(function cols -> + let query = "SELECT * FROM refObj WHERE h_occurrence = '" ^ obj ^ "';" in + let map cols = let position = extract_position (value_of_optional_value (cols.(2))) in let occurrence = value_of_optional_value (cols.(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" - ) ; + in + msg_output_header msg obj ; + exec_and_iter dbd query map ; msg_output_trailer msg ; msg_serialize msg -;; - -let dc_metadata db obj = - let tables = - [ "dc:creator","dccreator" ; - "dc:date","dcdate" ; - "dc:description","dcdescription" ; - "dc:format","dcformat" ; - "dc:identifier","dcidentifier" ; - "dc:language","dclanguage" ; - "dc:publisher","dcpublisher" ; - "dcq:RelationType","dcqRelationType" ; - "dc:relation","dcrelation" ; - "dc:rights","dcrights" ; - "dc:source","dcsource" ; - "dc:subject","dcsubject" ; - "dc:title","dctitle" ; - "hth:ResourceFormat","hthResourceFormat" ; - "hth:contact","hthcontact" ; - "hth:firstVersion","hthfirstVersion" ; - "hth:institution","hthinstitution" ; - "hth:modified","hthmodified" - ] - in - let msg = mk_new_msg () in - msg_output_dc_header msg obj ; - List.iter - (fun (propertyname,tablename) -> - let res = - M.exec db - ("SELECT * FROM " ^ tablename ^ " WHERE uri = '" ^ obj ^ "';") in - M.iter res - ~f:(function cols -> - let value = value_of_optional_value (cols.(0)) in - msg_output_string msg - (" <" ^ propertyname ^ ">" ^ value ^ "\n") ; - ) ; - ) tables ; + +let dc_metadata dbd obj = + let tables = + [ "dc:creator","dccreator" ; + "dc:date","dcdate" ; + "dc:description","dcdescription" ; + "dc:format","dcformat" ; + "dc:identifier","dcidentifier" ; + "dc:language","dclanguage" ; + "dc:publisher","dcpublisher" ; + "dcq:RelationType","dcqRelationType" ; + "dc:relation","dcrelation" ; + "dc:rights","dcrights" ; + "dc:source","dcsource" ; + "dc:subject","dcsubject" ; + "dc:title","dctitle" ; + "hth:ResourceFormat","hthResourceFormat" ; + "hth:contact","hthcontact" ; + "hth:firstVersion","hthfirstVersion" ; + "hth:institution","hthinstitution" ; + "hth:modified","hthmodified" + ] + in + let msg = mk_new_msg () in + let table_map (propertyname, tablename) = + let query = "SELECT * FROM " ^ tablename ^ " WHERE uri = '" ^ obj ^ "';" in + let map cols = + let value = value_of_optional_value (cols.(0)) in + msg_output_string msg + (" <" ^ propertyname ^ ">" ^ value ^ "\n") + in + exec_and_iter dbd query map + in + msg_output_dc_header msg obj ; + List.iter table_map tables ; msg_output_dc_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:(`Code 400) ~body ch let return_html_error s = return_html ("" ^ s ^ "") -let get_option key = - try - Some (Helm_registry.get key) - with Helm_registry.Key_not_found _ -> None - -let get_int_option key = - try - Some (Helm_registry.get_int key) - with Helm_registry.Key_not_found _ -> None - -let host = get_option "rdfly.mysql_connection.host";; -let database = get_option "rdfly.mysql_connection.database";; -let port = get_int_option "rdfly.mysql_connection.port";; -let password = get_option "rdfly.mysql_connection.password";; -let user = get_option "rdfly.mysql_connection.user";; -let daemonport = Helm_registry.get_int "rdfly.port";; +(* First of all we load the configuration *) +let configuration_file = "/projects/helm/etc/rdfly.conf.xml" +let _ = Registry.load_from configuration_file +let db_spec = DB.parse_dbd_conf () +let daemonport = Helm_registry.get_int "rdfly.port" let callback (req: Http_types.request) ch = try @@ -162,15 +139,15 @@ let callback (req: Http_types.request) ch = | "/get" -> let obj = req#param "object" and kind = req#param "kind" in - let db = open_db ?host ?database ?port ?password ?user () in + let dbd = SQL.quick_connect db_spec in begin match kind with - "forward" -> return_xml (forward_metadata db obj) ch - | "backward" -> return_xml (backward_metadata db obj) ch - | "dc" -> return_xml (dc_metadata db obj) ch + "forward" -> return_xml (forward_metadata dbd obj) ch + | "backward" -> return_xml (backward_metadata dbd obj) ch + | "dc" -> return_xml (dc_metadata dbd obj) ch | s -> return_html_error ("unsupported kind: " ^ s) ch end ; - M.disconnect db + SQL.disconnect dbd | invalid_request -> Http_daemon.respond_error ~code:(`Status (`Client_error `Bad_request)) ch) @@ -181,7 +158,7 @@ let callback (req: Http_types.request) ch = return_html_error ("Uncaught exception: " ^ (Printexc.to_string exc)) ch let main () = - Sys.catch_break true; + Sys.catch_break true; try let d_spec = Http_daemon.daemon_spec ~timeout:(Some 600) ~port:daemonport ~callback ~auto_close:true () @@ -189,6 +166,5 @@ let main () = Http_daemon.main d_spec with Sys.Break -> () in - -main () +main () -- 2.39.2