From 33036a1e6428d09d3ce35a820c983bf25107a136 Mon Sep 17 00:00:00 2001 From: Claudio Sacerdoti Coen Date: Mon, 23 Feb 2004 12:42:04 +0000 Subject: [PATCH] kind=dc implemented. --- helm/DEVEL/rdfly/rdfly.ml | 52 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 52 insertions(+) diff --git a/helm/DEVEL/rdfly/rdfly.ml b/helm/DEVEL/rdfly/rdfly.ml index bb734a62b..724d8f8bd 100644 --- a/helm/DEVEL/rdfly/rdfly.ml +++ b/helm/DEVEL/rdfly/rdfly.ml @@ -33,6 +33,15 @@ let msg_output_header msg obj = let msg_output_trailer msg = msg_output_string msg " \n\n" +let msg_output_dc_header msg obj = + msg_output_string msg "\n\n" ; + msg_output_string msg ("\n") +;; + +let msg_output_dc_trailer msg = + msg_output_string msg " \n" +;; + let value_of_optional_value = function None -> assert false @@ -54,6 +63,7 @@ let forward_metadata db obj = ) ; 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 @@ -70,6 +80,47 @@ let backward_metadata db obj = ) ; 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 ; + msg_output_dc_trailer msg ; + msg_serialize msg +;; let debug_print s = prerr_endline ("[RDFly] " ^ s) @@ -114,6 +165,7 @@ let callback (req: Http_types.request) ch = 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 | s -> return_html_error ("unsupported kind: " ^ s) ch end ; M.disconnect db -- 2.39.2