From 5a9b1f46a8e866382a71d686e689e9e5907f1824 Mon Sep 17 00:00:00 2001
From: Claudio Sacerdoti Coen <claudio.sacerdoticoen@unibo.it>
Date: Fri, 20 Feb 2004 16:47:21 +0000
Subject: [PATCH] Ported to  - Helm_registry  - Mysql

---
 helm/DEVEL/rdfly/.cvsignore             |  1 +
 helm/DEVEL/rdfly/Makefile               |  7 ++-
 helm/DEVEL/rdfly/rdfly.conf.xml.sample  | 13 +++++
 helm/DEVEL/rdfly/{query.ml => rdfly.ml} | 73 ++++++++++++++++---------
 4 files changed, 66 insertions(+), 28 deletions(-)
 create mode 100644 helm/DEVEL/rdfly/.cvsignore
 create mode 100644 helm/DEVEL/rdfly/rdfly.conf.xml.sample
 rename helm/DEVEL/rdfly/{query.ml => rdfly.ml} (56%)

diff --git a/helm/DEVEL/rdfly/.cvsignore b/helm/DEVEL/rdfly/.cvsignore
new file mode 100644
index 000000000..5424f8c69
--- /dev/null
+++ b/helm/DEVEL/rdfly/.cvsignore
@@ -0,0 +1 @@
+*.o *.cm[iox] rdfly rdfly.opt
diff --git a/helm/DEVEL/rdfly/Makefile b/helm/DEVEL/rdfly/Makefile
index 92fdb740e..779bb7b44 100644
--- a/helm/DEVEL/rdfly/Makefile
+++ b/helm/DEVEL/rdfly/Makefile
@@ -1,5 +1,5 @@
 BIN_DIR = /usr/local/bin
-REQUIRES = postgres http
+REQUIRES = mysql http helm-registry
 PREDICATES = 
 OCAMLOPTIONS = -package "$(REQUIRES)" -predicates "$(PREDICATES)" -pp camlp4o
 OCAMLFIND = ocamlfind
@@ -10,7 +10,10 @@ OCAMLDEP = ocamldep -pp camlp4o
 LIBRARIES = $(shell $(OCAMLFIND) query -recursive -predicates "byte $(PREDICATES)" -format "%d/%a" $(REQUIRES))
 LIBRARIES_OPT = $(shell $(OCAMLFIND) query -recursive -predicates "native $(PREDICATES)" -format "%d/%a" $(REQUIRES))
 
-OBJS = query.cmo
+OBJS = rdfly.cmo
+
+all: rdfly
+opt: rdfly.opt
 
 rdfly: $(OBJS) $(LIBRARIES)
 	$(OCAMLC) -linkpkg -o $@ $(OBJS)
diff --git a/helm/DEVEL/rdfly/rdfly.conf.xml.sample b/helm/DEVEL/rdfly/rdfly.conf.xml.sample
new file mode 100644
index 000000000..360797898
--- /dev/null
+++ b/helm/DEVEL/rdfly/rdfly.conf.xml.sample
@@ -0,0 +1,13 @@
+<?xml version="1.0" encoding="utf-8"?>
+<helm_registry>
+  <section name="rdfly">
+    <section name="mysql_connection">
+      <key name="host">localhost</key>
+      <key name="password">bjIcRpru</key>
+      <key name="user">helmadmin</key>
+      <key name="database">mowgli</key>
+      <key name="port">3306</key>
+    </section>
+    <key name="port">58086</key>
+  </section>
+</helm_registry>
diff --git a/helm/DEVEL/rdfly/query.ml b/helm/DEVEL/rdfly/rdfly.ml
similarity index 56%
rename from helm/DEVEL/rdfly/query.ml
rename to helm/DEVEL/rdfly/rdfly.ml
index f63d780cb..0a268ce7c 100644
--- a/helm/DEVEL/rdfly/query.ml
+++ b/helm/DEVEL/rdfly/rdfly.ml
@@ -1,12 +1,18 @@
 
-module PG = Postgres
+module M = Mysql
 
-let open_db connection_string =
+  (* 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
-    new PG.connection connection_string
+    M.quick_connect ~host ~database ~port ~password ~user
   with
-    PG.Error e as exc ->
-      prerr_endline (PG.string_of_error e) ;
+    M.Error e as exc ->
+      prerr_endline e ;
       raise exc
 
 let extract_position s =
@@ -27,33 +33,41 @@ let msg_output_header msg obj =
 let msg_output_trailer msg =
   msg_output_string msg "  </h:Object>\n</rdf:RDF>\n"
 
+let value_of_optional_value =
+ function
+    None -> assert false
+  | Some v -> v
+;;
+
 let forward_metadata db obj =
-  let res = db#exec ("SELECT * FROM refObj WHERE source = '" ^ obj ^ "';") in
+  let res = M.exec db ("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 "    <h:refObj>\n      <h:Occurrence>\n" ;
-    msg_output_string msg ("        <h:position>" ^ position ^ "</h:position>\n") ;
-    msg_output_string msg ("        <h:occurrence>" ^ occurrence ^ "</h:occurrence>\n") ;
-    msg_output_string msg "      </h:Occurrence>\n    </h:refObj>\n"
-  done ;
+  M.iter res
+   ~f:(function 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 "    <h:refObj>\n      <h:Occurrence>\n" ;
+     msg_output_string msg ("        <h:position>" ^ position ^ "</h:position>\n") ;
+     msg_output_string msg ("        <h:occurrence>" ^ occurrence ^ "</h:occurrence>\n") ;
+     msg_output_string msg "      </h:Occurrence>\n    </h:refObj>\n"
+   ) ;
   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 res = M.exec db ("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 "    <h:backPointer>\n      <h:Occurrence>\n" ;
-    msg_output_string msg ("        <h:position>" ^ position ^ "</h:position>\n") ;
-    msg_output_string msg ("        <h:occurrence>" ^ occurrence ^ "</h:occurrence>\n") ;
-    msg_output_string msg "      </h:Occurrence>\n    </h:backPointer>\n"
-  done ;
+  M.iter res
+   ~f:(function 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 "    <h:backPointer>\n      <h:Occurrence>\n" ;
+     msg_output_string msg ("        <h:position>" ^ position ^ "</h:position>\n") ;
+     msg_output_string msg ("        <h:occurrence>" ^ occurrence ^ "</h:occurrence>\n") ;
+     msg_output_string msg "      </h:Occurrence>\n    </h:backPointer>\n"
+   ) ;
   msg_output_trailer msg ;
   msg_serialize msg
 
@@ -68,6 +82,13 @@ 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 ("<html><body>" ^ s ^ "</body></html>")
 
+let host = Helm_registry.get "rdfly.mysql_connection.host";;
+let database = Helm_registry.get "rdfly.mysql_connection.database";;
+let port = Helm_registry.get_int "rdfly.mysql_connection.port";;
+let password = Helm_registry.get "rdfly.mysql_connection.password";;
+let user = Helm_registry.get "rdfly.mysql_connection.user";;
+let daemonport = Helm_registry.get_int "rdfly.port";;
+
 let callback (req: Http_types.request) ch =
   try
     debug_print ("Connection from " ^ req#clientAddr) ;
@@ -78,14 +99,14 @@ let callback (req: Http_types.request) ch =
     | "/get" ->
       let obj = req#param "object"
       and kind = req#param "kind" in
-      let db = open_db "dbname='mowgli' user='helm'" in
+      let db = open_db ~host ~database ~port ~password ~user () 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
+      M.disconnect db
     | invalid_request -> Http_daemon.respond_error ~status:(`Client_error `Bad_request) ch)
   with
   | Http_types.Param_not_found attr_name ->
@@ -97,7 +118,7 @@ let main () =
   Sys.catch_break true;
   try
     Http_daemon.start'
-      ~timeout:(Some 600) ~port:58088 callback
+      ~timeout:(Some 600) ~port:daemonport callback
   with Sys.Break -> ()
 in
                                                                                                                                                                                     
-- 
2.39.2