Skip to content
Browse files

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

…ce stuff yet)
  • Loading branch information...
1 parent a154c50 commit 5bba90ff1302554ab215aceaa7b29c89226e2a9e @avsm committed Aug 22, 2009
Showing with 75 additions and 2 deletions.
  1. +6 −0 lifedb_dispatch.ml
  2. +11 −1 lifedb_query.ml
  3. +52 −0 lifedb_schema.ml
  4. +5 −0 lifedb_schema.mli
  5. +1 −1 lifedb_schema_generator.ml
View
6 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))
View
12 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
+
View
52 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
View
5 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 = <
View
2 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";

0 comments on commit 5bba90f

Please sign in to comment.
Something went wrong with that request. Please try again.