add in a /contact interface to retrieve contact information (no servi…

…ce stuff yet)

lifedb_dispatch.ml

@@ -120,6 +120,12 @@ let dispatch (lifedb : Lifedb_schema.Init.t) (syncdb : Sync_schema.Init.t) env (
     |(`GET|`HEAD), "doc" ->
       mark_get_rpc cgi;
       Lifedb_query.dispatch lifedb syncdb env cgi (`Doc (List.nth url_list 1))
+    |(`GET|`HEAD), "contact" -> begin
+      match url_list with
+      |[_] -> Lifedb_query.dispatch lifedb syncdb env cgi `Contact_list
+      |[_;uid] -> Lifedb_query.dispatch lifedb syncdb env cgi (`Contact_get uid)
+      |_ -> raise (Lifedb_rpc.Invalid_rpc "need 0/1 args")
+    end
     |(`GET|`HEAD), "att" ->
       mark_get_rpc cgi;
       Lifedb_query.dispatch lifedb syncdb env cgi (`Att (List.nth url_list 1))

lifedb_query.ml

@@ -177,5 +177,15 @@ let dispatch lifedb syncdb env (cgi:Netcgi.cgi_activation) = function
       let contacts = results_of_search (unique (fun x y -> x#uid <> y#uid) contacts) in
       Lifedb_rpc.return_json cgi (Query.json_of_contacts contacts)
     end
-    |_ -> Lifedb_rpc.return_error cgi `Not_found "bad mode" "bad mode"
+   |_ -> Lifedb_rpc.return_error cgi `Not_found "bad mode" "bad mode"
   end
+  |`Contact_list ->
+    let cs :> Query.contact list = LS.Contact.get lifedb in
+    let contacts = results_of_search cs in 
+    Lifedb_rpc.return_json cgi (Query.json_of_contacts contacts)
+  |`Contact_get uid -> begin
+    match LS.Contact.get_by_uid uid lifedb with
+    |[c] -> Lifedb_rpc.return_json cgi (Query.json_of_contact (c :> Query.contact))
+    |_ -> raise (Lifedb_rpc.Resource_not_found uid)
+  end  
+

lifedb_schema.ml

@@ -516,6 +516,58 @@ module Contact = struct
     (* execute the SQL query *)
     step_fold db stmt of_stmt
 
+  let get_by_uid ~uid ?(custom_where=("",[])) db =
+    let q = "WHERE contact.uid=?" in
+    let q = match custom_where with |"",_ -> q |w,_ -> q ^ " AND  (" ^ w ^ ")" in
+    let sql="SELECT contact.id, contact.file_name, contact.uid, contact.first_name, contact.last_name, contact.mtime FROM contact " ^ q in
+    let stmt=Sqlite3.prepare db.db sql in
+    db_must_ok db (fun () -> let v = uid in Sqlite3.bind stmt 1 (Sqlite3.Data.TEXT v));
+    ignore(match custom_where with |_,[] -> () |_,eb ->
+      let pos = ref 2 in
+      List.iter (fun b ->
+        db_must_ok db (fun () -> Sqlite3.bind stmt !pos b);
+        incr pos;
+      ) eb);
+    (* convert statement into an ocaml object *)
+    let of_stmt stmt =
+    t
+      (* native fields *)
+      ~id:(
+      (match Sqlite3.column stmt 0 with
+        |Sqlite3.Data.NULL -> None
+        |x -> Some (match x with |Sqlite3.Data.INT i -> i |x -> (try Int64.of_string (Sqlite3.Data.to_string x) with _ -> failwith "error: contact id")))
+      )
+      ~file_name:(
+      (match Sqlite3.column stmt 1 with
+        |Sqlite3.Data.NULL -> failwith "null of_stmt"
+        |x -> Sqlite3.Data.to_string x)
+      )
+      ~uid:(
+      (match Sqlite3.column stmt 2 with
+        |Sqlite3.Data.NULL -> failwith "null of_stmt"
+        |x -> Sqlite3.Data.to_string x)
+      )
+      ~first_name:(
+      (match Sqlite3.column stmt 3 with
+        |Sqlite3.Data.NULL -> None
+        |x -> Some (Sqlite3.Data.to_string x))
+      )
+      ~last_name:(
+      (match Sqlite3.column stmt 4 with
+        |Sqlite3.Data.NULL -> None
+        |x -> Some (Sqlite3.Data.to_string x))
+      )
+      ~mtime:(
+      (match Sqlite3.column stmt 5 with
+        |Sqlite3.Data.NULL -> failwith "null of_stmt"
+        |x -> match x with |Sqlite3.Data.FLOAT i -> i|x -> (try float_of_string (Sqlite3.Data.to_string x) with _ -> failwith "error: contact mtime"))
+      )
+      (* foreign fields *)
+    db
+    in 
+    (* execute the SQL query *)
+    step_fold db stmt of_stmt
+
 end
 
 module Mtype = struct

lifedb_schema.mli

@@ -107,6 +107,11 @@ module Contact : sig
    @raise Sql_error if a database error is encountered
     *)
 
+  val get_by_uid :
+    uid:string -> 
+    ?custom_where:string * Sqlite3.Data.t list -> Init.t -> 
+    t list
+
 end
 module Mtype : sig
   type t = <

lifedb_schema_generator.ml

@@ -30,7 +30,7 @@ let lifedb = make [
     text ~flags:[`Optional] "first_name";
     text ~flags:[`Optional] "last_name";
     date "mtime";
-  ], [], default_opts;
+  ], [ [], ["uid"] ], default_opts;
 
   "mtype" , [
     text ~flags:[`Unique; `Index] "name";