Skip to content
Find file
Fetching contributors…
Cannot retrieve contributors at this time
1982 lines (1908 sloc) 78.8 KB
(* autogenerated by sql_orm *)
module Sql_access = struct
(*
* Copyright (c) 2009 Anil Madhavapeddy <anil@recoil.org>
*
* Permission to use, copy, modify, and distribute this software for any
* purpose with or without fee is hereby granted, provided that the above
* copyright notice and this permission notice appear in all copies.
*
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*)
open Sqlite3
open Printf
type transaction_mode = [
|`Deferred
|`Immediate
|`Exclusive
]
type state = {
db : db;
mutable in_transaction: int;
busyfn: db -> unit;
mode: transaction_mode;
}
let default_busyfn (db:Sqlite3.db) =
print_endline "WARNING: busy";
Thread.delay (Random.float 1.)
let raise_sql_error x =
raise (Sqlite3.Error (Rc.to_string x))
let try_finally fn finalfn =
try
let r = fn () in
finalfn ();
r
with e -> begin
print_endline (sprintf "WARNING: exception: %s" (Printexc.to_string e));
finalfn ();
raise e
end
(* retry until a non-BUSY error code is returned *)
let rec db_busy_retry db fn =
match fn () with
|Rc.BUSY ->
db.busyfn db.db;
db_busy_retry db fn;
|x -> x
(* make sure an OK is returned from the database *)
let db_must_ok db fn =
match db_busy_retry db fn with
|Rc.OK -> ()
|x -> raise_sql_error x
(* make sure a DONE is returned from the database *)
let db_must_done db fn =
match db_busy_retry db fn with
|Rc.DONE -> ()
|x -> raise_sql_error x
(* request a transaction *)
let transaction db fn =
let m = match db.mode with
|`Deferred -> "DEFERRED" |`Immediate -> "IMMEDIATE" |`Exclusive -> "EXCLUSIVE" in
try_finally (fun () ->
if db.in_transaction = 0 then (
db_must_ok db (fun () -> exec db.db (sprintf "BEGIN %s TRANSACTION" m));
);
db.in_transaction <- db.in_transaction + 1;
fn ();
) (fun () ->
if db.in_transaction = 1 then (
db_must_ok db (fun () -> exec db.db "END TRANSACTION");
);
db.in_transaction <- db.in_transaction - 1
)
(* iterate over a result set *)
let step_fold db stmt iterfn =
let stepfn () = Sqlite3.step stmt in
let rec fn a = match db_busy_retry db stepfn with
|Sqlite3.Rc.ROW -> fn (iterfn stmt :: a)
|Sqlite3.Rc.DONE -> a
|x -> raise_sql_error x
in
fn []
end
open Sql_access
module Attachment = struct
type t = <
id : int64 option;
set_id : int64 option -> unit;
file_name : string;
set_file_name : string -> unit;
uid : string;
set_uid : string -> unit;
mime_type : string;
set_mime_type : string -> unit;
save: int64; delete: unit
>
let init db =
let sql = "create table if not exists attachment (id integer primary key autoincrement,file_name text,uid text,mime_type text);" in
db_must_ok db (fun () -> Sqlite3.exec db.db sql);
let sql = "CREATE UNIQUE INDEX IF NOT EXISTS attachment_file_name_idx ON attachment (file_name) " in
db_must_ok db (fun () -> Sqlite3.exec db.db sql);
let sql = "CREATE UNIQUE INDEX IF NOT EXISTS attachment_uid_idx ON attachment (uid) " in
db_must_ok db (fun () -> Sqlite3.exec db.db sql);
()
(* object definition *)
let t ?(id=None) ~file_name ~uid ~mime_type db : t = object
(* get functions *)
val mutable _id = id
method id : int64 option = _id
val mutable _file_name = file_name
method file_name : string = _file_name
val mutable _uid = uid
method uid : string = _uid
val mutable _mime_type = mime_type
method mime_type : string = _mime_type
(* set functions *)
method set_id v =
_id <- v
method set_file_name v =
_file_name <- v
method set_uid v =
_uid <- v
method set_mime_type v =
_mime_type <- v
(* admin functions *)
method delete =
match _id with
|None -> ()
|Some id ->
let sql = "DELETE FROM attachment WHERE id=?" in
let stmt = Sqlite3.prepare db.db sql in
db_must_ok db (fun () -> Sqlite3.bind stmt 1 (Sqlite3.Data.INT id));
ignore(step_fold db stmt (fun _ -> ()));
_id <- None
method save = transaction db (fun () ->
(* insert any foreign-one fields into their table and get id *)
let _curobj_id = match _id with
|None -> (* insert new record *)
let sql = "INSERT INTO attachment VALUES(NULL,?,?,?)" in
let stmt = Sqlite3.prepare db.db sql in
db_must_ok db (fun () -> Sqlite3.bind stmt 1 (let v = _file_name in Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 2 (let v = _uid in Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 3 (let v = _mime_type in Sqlite3.Data.TEXT v));
db_must_done db (fun () -> Sqlite3.step stmt);
let __id = Sqlite3.last_insert_rowid db.db in
_id <- Some __id;
__id
|Some id -> (* update *)
let sql = "UPDATE attachment SET file_name=?,uid=?,mime_type=? WHERE id=?" in
let stmt = Sqlite3.prepare db.db sql in
db_must_ok db (fun () -> Sqlite3.bind stmt 1 (let v = _file_name in Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 2 (let v = _uid in Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 3 (let v = _mime_type in Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 4 (Sqlite3.Data.INT id));
db_must_done db (fun () -> Sqlite3.step stmt);
id
in
_curobj_id
)
end
(* General get function for any of the columns *)
let get ?(id=None) ?(file_name=None) ?(uid=None) ?(mime_type=None) ?(custom_where=("",[])) db =
(* assemble the SQL query string *)
let q = "" in
let _first = ref true in
let f () = match !_first with |true -> _first := false; " WHERE " |false -> " AND " in
let q = match id with |None -> q |Some b -> q ^ (f()) ^ "attachment.id=?" in
let q = match file_name with |None -> q |Some b -> q ^ (f()) ^ "attachment.file_name=?" in
let q = match uid with |None -> q |Some b -> q ^ (f()) ^ "attachment.uid=?" in
let q = match mime_type with |None -> q |Some b -> q ^ (f()) ^ "attachment.mime_type=?" in
let q = match custom_where with |"",_ -> q |w,_ -> q ^ (f()) ^ "(" ^ w ^ ")" in
let sql="SELECT attachment.id, attachment.file_name, attachment.uid, attachment.mime_type FROM attachment " ^ q in
let stmt=Sqlite3.prepare db.db sql in
(* bind the position variables to the statement *)
let bindpos = ref 1 in
ignore(match id with |None -> () |Some v ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos (Sqlite3.Data.INT v));
incr bindpos
);
ignore(match file_name with |None -> () |Some v ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos (Sqlite3.Data.TEXT v));
incr bindpos
);
ignore(match uid with |None -> () |Some v ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos (Sqlite3.Data.TEXT v));
incr bindpos
);
ignore(match mime_type with |None -> () |Some v ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos (Sqlite3.Data.TEXT v));
incr bindpos
);
ignore(match custom_where with |_,[] -> () |_,eb ->
List.iter (fun b ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos b);
incr bindpos
) 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: attachment 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)
)
~mime_type:(
(match Sqlite3.column stmt 3 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
(* foreign fields *)
db
in
(* execute the SQL query *)
step_fold db stmt of_stmt
let get_by_file_name ~file_name ?(custom_where=("",[])) db =
let q = "WHERE attachment.file_name=?" in
let q = match custom_where with |"",_ -> q |w,_ -> q ^ " AND (" ^ w ^ ")" in
let sql="SELECT attachment.id, attachment.file_name, attachment.uid, attachment.mime_type FROM attachment " ^ q in
let stmt=Sqlite3.prepare db.db sql in
db_must_ok db (fun () -> let v = file_name 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: attachment 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)
)
~mime_type:(
(match Sqlite3.column stmt 3 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
(* foreign fields *)
db
in
(* execute the SQL query *)
step_fold db stmt of_stmt
let get_by_uid ~uid ?(custom_where=("",[])) db =
let q = "WHERE attachment.uid=?" in
let q = match custom_where with |"",_ -> q |w,_ -> q ^ " AND (" ^ w ^ ")" in
let sql="SELECT attachment.id, attachment.file_name, attachment.uid, attachment.mime_type FROM attachment " ^ 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: attachment 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)
)
~mime_type:(
(match Sqlite3.column stmt 3 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
(* foreign fields *)
db
in
(* execute the SQL query *)
step_fold db stmt of_stmt
end
module Contact = struct
type t = <
id : int64 option;
set_id : int64 option -> unit;
file_name : string;
set_file_name : string -> unit;
uid : string;
set_uid : string -> unit;
first_name : string option;
set_first_name : string option -> unit;
last_name : string option;
set_last_name : string option -> unit;
mtime : float;
set_mtime : float -> unit;
save: int64; delete: unit
>
let init db =
let sql = "create table if not exists contact (id integer primary key autoincrement,file_name text,uid text,first_name text,last_name text,mtime real);" in
db_must_ok db (fun () -> Sqlite3.exec db.db sql);
let sql = "CREATE UNIQUE INDEX IF NOT EXISTS contact_uid_idx ON contact (uid) " in
db_must_ok db (fun () -> Sqlite3.exec db.db sql);
()
(* object definition *)
let t ?(id=None) ~file_name ~uid ?(first_name=None) ?(last_name=None) ~mtime db : t = object
(* get functions *)
val mutable _id = id
method id : int64 option = _id
val mutable _file_name = file_name
method file_name : string = _file_name
val mutable _uid = uid
method uid : string = _uid
val mutable _first_name = first_name
method first_name : string option = _first_name
val mutable _last_name = last_name
method last_name : string option = _last_name
val mutable _mtime = mtime
method mtime : float = _mtime
(* set functions *)
method set_id v =
_id <- v
method set_file_name v =
_file_name <- v
method set_uid v =
_uid <- v
method set_first_name v =
_first_name <- v
method set_last_name v =
_last_name <- v
method set_mtime v =
_mtime <- v
(* admin functions *)
method delete =
match _id with
|None -> ()
|Some id ->
let sql = "DELETE FROM contact WHERE id=?" in
let stmt = Sqlite3.prepare db.db sql in
db_must_ok db (fun () -> Sqlite3.bind stmt 1 (Sqlite3.Data.INT id));
ignore(step_fold db stmt (fun _ -> ()));
_id <- None
method save = transaction db (fun () ->
(* insert any foreign-one fields into their table and get id *)
let _curobj_id = match _id with
|None -> (* insert new record *)
let sql = "INSERT INTO contact VALUES(NULL,?,?,?,?,?)" in
let stmt = Sqlite3.prepare db.db sql in
db_must_ok db (fun () -> Sqlite3.bind stmt 1 (let v = _file_name in Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 2 (let v = _uid in Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 3 (match _first_name with |None -> Sqlite3.Data.NULL |Some v -> Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 4 (match _last_name with |None -> Sqlite3.Data.NULL |Some v -> Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 5 (let v = _mtime in Sqlite3.Data.FLOAT v));
db_must_done db (fun () -> Sqlite3.step stmt);
let __id = Sqlite3.last_insert_rowid db.db in
_id <- Some __id;
__id
|Some id -> (* update *)
let sql = "UPDATE contact SET file_name=?,uid=?,first_name=?,last_name=?,mtime=? WHERE id=?" in
let stmt = Sqlite3.prepare db.db sql in
db_must_ok db (fun () -> Sqlite3.bind stmt 1 (let v = _file_name in Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 2 (let v = _uid in Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 3 (match _first_name with |None -> Sqlite3.Data.NULL |Some v -> Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 4 (match _last_name with |None -> Sqlite3.Data.NULL |Some v -> Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 5 (let v = _mtime in Sqlite3.Data.FLOAT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 6 (Sqlite3.Data.INT id));
db_must_done db (fun () -> Sqlite3.step stmt);
id
in
_curobj_id
)
end
(* General get function for any of the columns *)
let get ?(id=None) ?(file_name=None) ?(uid=None) ?(first_name=None) ?(last_name=None) ?(mtime=None) ?(custom_where=("",[])) db =
(* assemble the SQL query string *)
let q = "" in
let _first = ref true in
let f () = match !_first with |true -> _first := false; " WHERE " |false -> " AND " in
let q = match id with |None -> q |Some b -> q ^ (f()) ^ "contact.id=?" in
let q = match file_name with |None -> q |Some b -> q ^ (f()) ^ "contact.file_name=?" in
let q = match uid with |None -> q |Some b -> q ^ (f()) ^ "contact.uid=?" in
let q = match first_name with |None -> q |Some b -> q ^ (f()) ^ "contact.first_name=?" in
let q = match last_name with |None -> q |Some b -> q ^ (f()) ^ "contact.last_name=?" in
let q = match mtime with |None -> q |Some b -> q ^ (f()) ^ "contact.mtime=?" in
let q = match custom_where with |"",_ -> q |w,_ -> q ^ (f()) ^ "(" ^ 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
(* bind the position variables to the statement *)
let bindpos = ref 1 in
ignore(match id with |None -> () |Some v ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos (Sqlite3.Data.INT v));
incr bindpos
);
ignore(match file_name with |None -> () |Some v ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos (Sqlite3.Data.TEXT v));
incr bindpos
);
ignore(match uid with |None -> () |Some v ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos (Sqlite3.Data.TEXT v));
incr bindpos
);
ignore(match first_name with |None -> () |Some v ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos (Sqlite3.Data.TEXT v));
incr bindpos
);
ignore(match last_name with |None -> () |Some v ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos (Sqlite3.Data.TEXT v));
incr bindpos
);
ignore(match mtime with |None -> () |Some v ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos (Sqlite3.Data.FLOAT v));
incr bindpos
);
ignore(match custom_where with |_,[] -> () |_,eb ->
List.iter (fun b ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos b);
incr bindpos
) 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
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
type t = <
id : int64 option;
set_id : int64 option -> unit;
name : string;
set_name : string -> unit;
label : string;
set_label : string -> unit;
icon : string option;
set_icon : string option -> unit;
implements : string;
set_implements : string -> unit;
save: int64; delete: unit
>
let init db =
let sql = "create table if not exists mtype (id integer primary key autoincrement,name text,label text,icon text,implements text);" in
db_must_ok db (fun () -> Sqlite3.exec db.db sql);
let sql = "CREATE UNIQUE INDEX IF NOT EXISTS mtype_name_idx ON mtype (name) " in
db_must_ok db (fun () -> Sqlite3.exec db.db sql);
()
(* object definition *)
let t ?(id=None) ~name ~label ?(icon=None) ~implements db : t = object
(* get functions *)
val mutable _id = id
method id : int64 option = _id
val mutable _name = name
method name : string = _name
val mutable _label = label
method label : string = _label
val mutable _icon = icon
method icon : string option = _icon
val mutable _implements = implements
method implements : string = _implements
(* set functions *)
method set_id v =
_id <- v
method set_name v =
_name <- v
method set_label v =
_label <- v
method set_icon v =
_icon <- v
method set_implements v =
_implements <- v
(* admin functions *)
method delete =
match _id with
|None -> ()
|Some id ->
let sql = "DELETE FROM mtype WHERE id=?" in
let stmt = Sqlite3.prepare db.db sql in
db_must_ok db (fun () -> Sqlite3.bind stmt 1 (Sqlite3.Data.INT id));
ignore(step_fold db stmt (fun _ -> ()));
_id <- None
method save = transaction db (fun () ->
(* insert any foreign-one fields into their table and get id *)
let _curobj_id = match _id with
|None -> (* insert new record *)
let sql = "INSERT INTO mtype VALUES(NULL,?,?,?,?)" in
let stmt = Sqlite3.prepare db.db sql in
db_must_ok db (fun () -> Sqlite3.bind stmt 1 (let v = _name in Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 2 (let v = _label in Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 3 (match _icon with |None -> Sqlite3.Data.NULL |Some v -> Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 4 (let v = _implements in Sqlite3.Data.TEXT v));
db_must_done db (fun () -> Sqlite3.step stmt);
let __id = Sqlite3.last_insert_rowid db.db in
_id <- Some __id;
__id
|Some id -> (* update *)
let sql = "UPDATE mtype SET name=?,label=?,icon=?,implements=? WHERE id=?" in
let stmt = Sqlite3.prepare db.db sql in
db_must_ok db (fun () -> Sqlite3.bind stmt 1 (let v = _name in Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 2 (let v = _label in Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 3 (match _icon with |None -> Sqlite3.Data.NULL |Some v -> Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 4 (let v = _implements in Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 5 (Sqlite3.Data.INT id));
db_must_done db (fun () -> Sqlite3.step stmt);
id
in
_curobj_id
)
end
(* General get function for any of the columns *)
let get ?(id=None) ?(name=None) ?(label=None) ?(icon=None) ?(implements=None) ?(custom_where=("",[])) db =
(* assemble the SQL query string *)
let q = "" in
let _first = ref true in
let f () = match !_first with |true -> _first := false; " WHERE " |false -> " AND " in
let q = match id with |None -> q |Some b -> q ^ (f()) ^ "mtype.id=?" in
let q = match name with |None -> q |Some b -> q ^ (f()) ^ "mtype.name=?" in
let q = match label with |None -> q |Some b -> q ^ (f()) ^ "mtype.label=?" in
let q = match icon with |None -> q |Some b -> q ^ (f()) ^ "mtype.icon=?" in
let q = match implements with |None -> q |Some b -> q ^ (f()) ^ "mtype.implements=?" in
let q = match custom_where with |"",_ -> q |w,_ -> q ^ (f()) ^ "(" ^ w ^ ")" in
let sql="SELECT mtype.id, mtype.name, mtype.label, mtype.icon, mtype.implements FROM mtype " ^ q in
let stmt=Sqlite3.prepare db.db sql in
(* bind the position variables to the statement *)
let bindpos = ref 1 in
ignore(match id with |None -> () |Some v ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos (Sqlite3.Data.INT v));
incr bindpos
);
ignore(match name with |None -> () |Some v ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos (Sqlite3.Data.TEXT v));
incr bindpos
);
ignore(match label with |None -> () |Some v ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos (Sqlite3.Data.TEXT v));
incr bindpos
);
ignore(match icon with |None -> () |Some v ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos (Sqlite3.Data.TEXT v));
incr bindpos
);
ignore(match implements with |None -> () |Some v ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos (Sqlite3.Data.TEXT v));
incr bindpos
);
ignore(match custom_where with |_,[] -> () |_,eb ->
List.iter (fun b ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos b);
incr bindpos
) 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: mtype id")))
)
~name:(
(match Sqlite3.column stmt 1 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
~label:(
(match Sqlite3.column stmt 2 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
~icon:(
(match Sqlite3.column stmt 3 with
|Sqlite3.Data.NULL -> None
|x -> Some (Sqlite3.Data.to_string x))
)
~implements:(
(match Sqlite3.column stmt 4 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
(* foreign fields *)
db
in
(* execute the SQL query *)
step_fold db stmt of_stmt
let get_by_name ~name ?(custom_where=("",[])) db =
let q = "WHERE mtype.name=?" in
let q = match custom_where with |"",_ -> q |w,_ -> q ^ " AND (" ^ w ^ ")" in
let sql="SELECT mtype.id, mtype.name, mtype.label, mtype.icon, mtype.implements FROM mtype " ^ q in
let stmt=Sqlite3.prepare db.db sql in
db_must_ok db (fun () -> let v = name 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: mtype id")))
)
~name:(
(match Sqlite3.column stmt 1 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
~label:(
(match Sqlite3.column stmt 2 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
~icon:(
(match Sqlite3.column stmt 3 with
|Sqlite3.Data.NULL -> None
|x -> Some (Sqlite3.Data.to_string x))
)
~implements:(
(match Sqlite3.column stmt 4 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
(* foreign fields *)
db
in
(* execute the SQL query *)
step_fold db stmt of_stmt
end
module Service = struct
type t = <
id : int64 option;
set_id : int64 option -> unit;
name : string;
set_name : string -> unit;
uid : string;
set_uid : string -> unit;
contact : Contact.t option;
set_contact : Contact.t option -> unit;
save: int64; delete: unit
>
let init db =
let sql = "create table if not exists service (id integer primary key autoincrement,name text,uid text,contact_id integer);" in
db_must_ok db (fun () -> Sqlite3.exec db.db sql);
()
(* object definition *)
let t ?(id=None) ~name ~uid ?(contact=None) db : t = object
(* get functions *)
val mutable _id = id
method id : int64 option = _id
val mutable _name = name
method name : string = _name
val mutable _uid = uid
method uid : string = _uid
val mutable _contact = contact
method contact : Contact.t option = _contact
(* set functions *)
method set_id v =
_id <- v
method set_name v =
_name <- v
method set_uid v =
_uid <- v
method set_contact v =
_contact <- v
(* admin functions *)
method delete =
match _id with
|None -> ()
|Some id ->
let sql = "DELETE FROM service WHERE id=?" in
let stmt = Sqlite3.prepare db.db sql in
db_must_ok db (fun () -> Sqlite3.bind stmt 1 (Sqlite3.Data.INT id));
ignore(step_fold db stmt (fun _ -> ()));
_id <- None
method save = transaction db (fun () ->
(* insert any foreign-one fields into their table and get id *)
let _contact_id = match contact with None -> None | Some x -> Some x#save in
let _curobj_id = match _id with
|None -> (* insert new record *)
let sql = "INSERT INTO service VALUES(NULL,?,?,?)" in
let stmt = Sqlite3.prepare db.db sql in
db_must_ok db (fun () -> Sqlite3.bind stmt 1 (let v = _name in Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 2 (let v = _uid in Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 3 (match _contact_id with |None -> Sqlite3.Data.NULL |Some v -> Sqlite3.Data.INT v));
db_must_done db (fun () -> Sqlite3.step stmt);
let __id = Sqlite3.last_insert_rowid db.db in
_id <- Some __id;
__id
|Some id -> (* update *)
let sql = "UPDATE service SET name=?,uid=?,contact_id=? WHERE id=?" in
let stmt = Sqlite3.prepare db.db sql in
db_must_ok db (fun () -> Sqlite3.bind stmt 1 (let v = _name in Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 2 (let v = _uid in Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 3 (match _contact_id with |None -> Sqlite3.Data.NULL |Some v -> Sqlite3.Data.INT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 4 (Sqlite3.Data.INT id));
db_must_done db (fun () -> Sqlite3.step stmt);
id
in
_curobj_id
)
end
(* General get function for any of the columns *)
let get ?(id=None) ?(name=None) ?(uid=None) ?(custom_where=("",[])) db =
(* assemble the SQL query string *)
let q = "" in
let _first = ref true in
let f () = match !_first with |true -> _first := false; " WHERE " |false -> " AND " in
let q = match id with |None -> q |Some b -> q ^ (f()) ^ "service.id=?" in
let q = match name with |None -> q |Some b -> q ^ (f()) ^ "service.name=?" in
let q = match uid with |None -> q |Some b -> q ^ (f()) ^ "service.uid=?" in
let q = match custom_where with |"",_ -> q |w,_ -> q ^ (f()) ^ "(" ^ w ^ ")" in
let sql="SELECT service_contact.id, service_contact.file_name, service_contact.uid, service_contact.first_name, service_contact.last_name, service_contact.mtime, service.id, service.name, service.uid, service.contact_id FROM service LEFT JOIN contact AS service_contact ON (service_contact.id = service.contact_id) " ^ q in
let stmt=Sqlite3.prepare db.db sql in
(* bind the position variables to the statement *)
let bindpos = ref 1 in
ignore(match id with |None -> () |Some v ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos (Sqlite3.Data.INT v));
incr bindpos
);
ignore(match name with |None -> () |Some v ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos (Sqlite3.Data.TEXT v));
incr bindpos
);
ignore(match uid with |None -> () |Some v ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos (Sqlite3.Data.TEXT v));
incr bindpos
);
ignore(match custom_where with |_,[] -> () |_,eb ->
List.iter (fun b ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos b);
incr bindpos
) eb);
(* convert statement into an ocaml object *)
let of_stmt stmt =
t
(* native fields *)
~id:(
(match Sqlite3.column stmt 6 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: service id")))
)
~name:(
(match Sqlite3.column stmt 7 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
~uid:(
(match Sqlite3.column stmt 8 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
(* foreign fields *)
~contact:(
(try
Some (
Contact.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: service_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: service_contact mtime"))
)
(* foreign fields *)
db
) with _ -> None))
db
in
(* execute the SQL query *)
step_fold db stmt of_stmt
end
module Tag = struct
type t = <
id : int64 option;
set_id : int64 option -> unit;
name : string;
set_name : string -> unit;
save: int64; delete: unit
>
let init db =
let sql = "create table if not exists tag (id integer primary key autoincrement,name text);" in
db_must_ok db (fun () -> Sqlite3.exec db.db sql);
()
(* object definition *)
let t ?(id=None) ~name db : t = object
(* get functions *)
val mutable _id = id
method id : int64 option = _id
val mutable _name = name
method name : string = _name
(* set functions *)
method set_id v =
_id <- v
method set_name v =
_name <- v
(* admin functions *)
method delete =
match _id with
|None -> ()
|Some id ->
let sql = "DELETE FROM tag WHERE id=?" in
let stmt = Sqlite3.prepare db.db sql in
db_must_ok db (fun () -> Sqlite3.bind stmt 1 (Sqlite3.Data.INT id));
ignore(step_fold db stmt (fun _ -> ()));
_id <- None
method save = transaction db (fun () ->
(* insert any foreign-one fields into their table and get id *)
let _curobj_id = match _id with
|None -> (* insert new record *)
let sql = "INSERT INTO tag VALUES(NULL,?)" in
let stmt = Sqlite3.prepare db.db sql in
db_must_ok db (fun () -> Sqlite3.bind stmt 1 (let v = _name in Sqlite3.Data.TEXT v));
db_must_done db (fun () -> Sqlite3.step stmt);
let __id = Sqlite3.last_insert_rowid db.db in
_id <- Some __id;
__id
|Some id -> (* update *)
let sql = "UPDATE tag SET name=? WHERE id=?" in
let stmt = Sqlite3.prepare db.db sql in
db_must_ok db (fun () -> Sqlite3.bind stmt 1 (let v = _name in Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 2 (Sqlite3.Data.INT id));
db_must_done db (fun () -> Sqlite3.step stmt);
id
in
_curobj_id
)
end
(* General get function for any of the columns *)
let get ?(id=None) ?(name=None) ?(custom_where=("",[])) db =
(* assemble the SQL query string *)
let q = "" in
let _first = ref true in
let f () = match !_first with |true -> _first := false; " WHERE " |false -> " AND " in
let q = match id with |None -> q |Some b -> q ^ (f()) ^ "tag.id=?" in
let q = match name with |None -> q |Some b -> q ^ (f()) ^ "tag.name=?" in
let q = match custom_where with |"",_ -> q |w,_ -> q ^ (f()) ^ "(" ^ w ^ ")" in
let sql="SELECT tag.id, tag.name FROM tag " ^ q in
let stmt=Sqlite3.prepare db.db sql in
(* bind the position variables to the statement *)
let bindpos = ref 1 in
ignore(match id with |None -> () |Some v ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos (Sqlite3.Data.INT v));
incr bindpos
);
ignore(match name with |None -> () |Some v ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos (Sqlite3.Data.TEXT v));
incr bindpos
);
ignore(match custom_where with |_,[] -> () |_,eb ->
List.iter (fun b ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos b);
incr bindpos
) 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: tag id")))
)
~name:(
(match Sqlite3.column stmt 1 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
(* foreign fields *)
db
in
(* execute the SQL query *)
step_fold db stmt of_stmt
end
module Entry = struct
type t = <
id : int64 option;
set_id : int64 option -> unit;
uid : string;
set_uid : string -> unit;
file_name : string;
set_file_name : string -> unit;
created : float;
set_created : float -> unit;
mtype : Mtype.t;
set_mtype : Mtype.t -> unit;
from : Service.t;
set_from : Service.t -> unit;
recipients : Service.t list;
set_recipients : Service.t list -> unit;
atts : Attachment.t list;
set_atts : Attachment.t list -> unit;
tags : Tag.t list;
set_tags : Tag.t list -> unit;
delivered : int64;
set_delivered : int64 -> unit;
save: int64; delete: unit
>
let init db =
let sql = "create table if not exists entry (id integer primary key autoincrement,uid text,file_name text,created real,mtype_id integer,from_id integer,delivered integer);" in
db_must_ok db (fun () -> Sqlite3.exec db.db sql);
let sql = "create table if not exists map_recipients_entry_service (entry_id integer, service_id integer, primary key(entry_id, service_id));" in
db_must_ok db (fun () -> Sqlite3.exec db.db sql);
let sql = "create table if not exists map_atts_entry_attachment (entry_id integer, attachment_id integer, primary key(entry_id, attachment_id));" in
db_must_ok db (fun () -> Sqlite3.exec db.db sql);
let sql = "create table if not exists map_tags_entry_tag (entry_id integer, tag_id integer, primary key(entry_id, tag_id));" in
db_must_ok db (fun () -> Sqlite3.exec db.db sql);
let sql = "CREATE UNIQUE INDEX IF NOT EXISTS entry_uid_idx ON entry (uid) " in
db_must_ok db (fun () -> Sqlite3.exec db.db sql);
let sql = "CREATE INDEX IF NOT EXISTS entry_created_idx ON entry (created) " in
db_must_ok db (fun () -> Sqlite3.exec db.db sql);
()
(* object definition *)
let t ?(id=None) ~uid ~file_name ~created ~mtype ~from ~recipients ~atts ~tags ~delivered db : t = object
(* get functions *)
val mutable _id = id
method id : int64 option = _id
val mutable _uid = uid
method uid : string = _uid
val mutable _file_name = file_name
method file_name : string = _file_name
val mutable _created = created
method created : float = _created
val mutable _mtype = mtype
method mtype : Mtype.t = _mtype
val mutable _from = from
method from : Service.t = _from
val mutable _recipients = recipients
method recipients : Service.t list = _recipients
val mutable _atts = atts
method atts : Attachment.t list = _atts
val mutable _tags = tags
method tags : Tag.t list = _tags
val mutable _delivered = delivered
method delivered : int64 = _delivered
(* set functions *)
method set_id v =
_id <- v
method set_uid v =
_uid <- v
method set_file_name v =
_file_name <- v
method set_created v =
_created <- v
method set_mtype v =
_mtype <- v
method set_from v =
_from <- v
method set_recipients v =
_recipients <- v
method set_atts v =
_atts <- v
method set_tags v =
_tags <- v
method set_delivered v =
_delivered <- v
(* admin functions *)
method delete =
match _id with
|None -> ()
|Some id ->
let sql = "DELETE FROM entry WHERE id=?" in
let stmt = Sqlite3.prepare db.db sql in
db_must_ok db (fun () -> Sqlite3.bind stmt 1 (Sqlite3.Data.INT id));
ignore(step_fold db stmt (fun _ -> ()));
_id <- None
method save = transaction db (fun () ->
(* insert any foreign-one fields into their table and get id *)
let _mtype_id = mtype#save in
let _from_id = from#save in
let _curobj_id = match _id with
|None -> (* insert new record *)
let sql = "INSERT INTO entry VALUES(NULL,?,?,?,?,?,?)" in
let stmt = Sqlite3.prepare db.db sql in
db_must_ok db (fun () -> Sqlite3.bind stmt 1 (let v = _uid in Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 2 (let v = _file_name in Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 3 (let v = _created in Sqlite3.Data.FLOAT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 4 (let v = _mtype_id in Sqlite3.Data.INT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 5 (let v = _from_id in Sqlite3.Data.INT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 6 (let v = _delivered in Sqlite3.Data.INT v));
db_must_done db (fun () -> Sqlite3.step stmt);
let __id = Sqlite3.last_insert_rowid db.db in
_id <- Some __id;
__id
|Some id -> (* update *)
let sql = "UPDATE entry SET uid=?,file_name=?,created=?,mtype_id=?,from_id=?,delivered=? WHERE id=?" in
let stmt = Sqlite3.prepare db.db sql in
db_must_ok db (fun () -> Sqlite3.bind stmt 1 (let v = _uid in Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 2 (let v = _file_name in Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 3 (let v = _created in Sqlite3.Data.FLOAT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 4 (let v = _mtype_id in Sqlite3.Data.INT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 5 (let v = _from_id in Sqlite3.Data.INT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 6 (let v = _delivered in Sqlite3.Data.INT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 7 (Sqlite3.Data.INT id));
db_must_done db (fun () -> Sqlite3.step stmt);
id
in
List.iter (fun f ->
let _refobj_id = f#save in
let sql = "INSERT OR IGNORE INTO map_recipients_entry_service VALUES(?,?)" in
let stmt = Sqlite3.prepare db.db sql in
db_must_ok db (fun () -> Sqlite3.bind stmt 1 (Sqlite3.Data.INT _curobj_id));
db_must_ok db (fun () -> Sqlite3.bind stmt 2 (Sqlite3.Data.INT _refobj_id));
ignore(step_fold db stmt (fun _ -> ()));
) _recipients;
let ids = String.concat "," (List.map (fun x -> match x#id with |None -> assert false |Some x -> Int64.to_string x) _recipients) in
let sql = "DELETE FROM map_recipients_entry_service WHERE entry_id=? AND (service_id NOT IN (" ^ ids ^ "))" in
let stmt = Sqlite3.prepare db.db sql in
db_must_ok db (fun () -> Sqlite3.bind stmt 1 (Sqlite3.Data.INT _curobj_id));
ignore(step_fold db stmt (fun _ -> ()));
List.iter (fun f ->
let _refobj_id = f#save in
let sql = "INSERT OR IGNORE INTO map_atts_entry_attachment VALUES(?,?)" in
let stmt = Sqlite3.prepare db.db sql in
db_must_ok db (fun () -> Sqlite3.bind stmt 1 (Sqlite3.Data.INT _curobj_id));
db_must_ok db (fun () -> Sqlite3.bind stmt 2 (Sqlite3.Data.INT _refobj_id));
ignore(step_fold db stmt (fun _ -> ()));
) _atts;
let ids = String.concat "," (List.map (fun x -> match x#id with |None -> assert false |Some x -> Int64.to_string x) _atts) in
let sql = "DELETE FROM map_atts_entry_attachment WHERE entry_id=? AND (attachment_id NOT IN (" ^ ids ^ "))" in
let stmt = Sqlite3.prepare db.db sql in
db_must_ok db (fun () -> Sqlite3.bind stmt 1 (Sqlite3.Data.INT _curobj_id));
ignore(step_fold db stmt (fun _ -> ()));
List.iter (fun f ->
let _refobj_id = f#save in
let sql = "INSERT OR IGNORE INTO map_tags_entry_tag VALUES(?,?)" in
let stmt = Sqlite3.prepare db.db sql in
db_must_ok db (fun () -> Sqlite3.bind stmt 1 (Sqlite3.Data.INT _curobj_id));
db_must_ok db (fun () -> Sqlite3.bind stmt 2 (Sqlite3.Data.INT _refobj_id));
ignore(step_fold db stmt (fun _ -> ()));
) _tags;
let ids = String.concat "," (List.map (fun x -> match x#id with |None -> assert false |Some x -> Int64.to_string x) _tags) in
let sql = "DELETE FROM map_tags_entry_tag WHERE entry_id=? AND (tag_id NOT IN (" ^ ids ^ "))" in
let stmt = Sqlite3.prepare db.db sql in
db_must_ok db (fun () -> Sqlite3.bind stmt 1 (Sqlite3.Data.INT _curobj_id));
ignore(step_fold db stmt (fun _ -> ()));
_curobj_id
)
end
(* General get function for any of the columns *)
let get ?(id=None) ?(uid=None) ?(file_name=None) ?(created=None) ?(delivered=None) ?(custom_where=("",[])) db =
(* assemble the SQL query string *)
let q = "" in
let _first = ref true in
let f () = match !_first with |true -> _first := false; " WHERE " |false -> " AND " in
let q = match id with |None -> q |Some b -> q ^ (f()) ^ "entry.id=?" in
let q = match uid with |None -> q |Some b -> q ^ (f()) ^ "entry.uid=?" in
let q = match file_name with |None -> q |Some b -> q ^ (f()) ^ "entry.file_name=?" in
let q = match created with |None -> q |Some b -> q ^ (f()) ^ "entry.created=?" in
let q = match delivered with |None -> q |Some b -> q ^ (f()) ^ "entry.delivered=?" in
let q = match custom_where with |"",_ -> q |w,_ -> q ^ (f()) ^ "(" ^ w ^ ")" in
let sql="SELECT entry_from.id, entry_from.name, entry_from.uid, entry_from.contact_id, entry_mtype.id, entry_mtype.name, entry_mtype.label, entry_mtype.icon, entry_mtype.implements, entry.id, entry.uid, entry.file_name, entry.created, entry.mtype_id, entry.from_id, entry.delivered, entry_from_contact.id, entry_from_contact.file_name, entry_from_contact.uid, entry_from_contact.first_name, entry_from_contact.last_name, entry_from_contact.mtime FROM entry LEFT JOIN mtype AS entry_mtype ON (entry_mtype.id = entry.mtype_id) LEFT JOIN service AS entry_from ON (entry_from.id = entry.from_id) LEFT JOIN contact AS entry_from_contact ON (entry_from_contact.id = entry_from.contact_id) " ^ q in
let stmt=Sqlite3.prepare db.db sql in
(* bind the position variables to the statement *)
let bindpos = ref 1 in
ignore(match id with |None -> () |Some v ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos (Sqlite3.Data.INT v));
incr bindpos
);
ignore(match uid with |None -> () |Some v ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos (Sqlite3.Data.TEXT v));
incr bindpos
);
ignore(match file_name with |None -> () |Some v ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos (Sqlite3.Data.TEXT v));
incr bindpos
);
ignore(match created with |None -> () |Some v ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos (Sqlite3.Data.FLOAT v));
incr bindpos
);
ignore(match delivered with |None -> () |Some v ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos (Sqlite3.Data.INT v));
incr bindpos
);
ignore(match custom_where with |_,[] -> () |_,eb ->
List.iter (fun b ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos b);
incr bindpos
) eb);
(* convert statement into an ocaml object *)
let of_stmt stmt =
t
(* native fields *)
~id:(
(match Sqlite3.column stmt 9 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: entry id")))
)
~uid:(
(match Sqlite3.column stmt 10 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
~file_name:(
(match Sqlite3.column stmt 11 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
~created:(
(match Sqlite3.column stmt 12 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: entry created"))
)
~delivered:(
(match Sqlite3.column stmt 15 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> match x with |Sqlite3.Data.INT i -> i |x -> (try Int64.of_string (Sqlite3.Data.to_string x) with _ -> failwith "error: entry delivered"))
)
(* foreign fields *)
~mtype:(
Mtype.t
(* native fields *)
~id:(
(match Sqlite3.column stmt 4 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: entry_mtype id")))
)
~name:(
(match Sqlite3.column stmt 5 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
~label:(
(match Sqlite3.column stmt 6 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
~icon:(
(match Sqlite3.column stmt 7 with
|Sqlite3.Data.NULL -> None
|x -> Some (Sqlite3.Data.to_string x))
)
~implements:(
(match Sqlite3.column stmt 8 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
(* foreign fields *)
db
)
~from:(
Service.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: entry_from id")))
)
~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)
)
(* foreign fields *)
~contact:(
(try
Some (
Contact.t
(* native fields *)
~id:(
(match Sqlite3.column stmt 16 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: entry_from_contact id")))
)
~file_name:(
(match Sqlite3.column stmt 17 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
~uid:(
(match Sqlite3.column stmt 18 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
~first_name:(
(match Sqlite3.column stmt 19 with
|Sqlite3.Data.NULL -> None
|x -> Some (Sqlite3.Data.to_string x))
)
~last_name:(
(match Sqlite3.column stmt 20 with
|Sqlite3.Data.NULL -> None
|x -> Some (Sqlite3.Data.to_string x))
)
~mtime:(
(match Sqlite3.column stmt 21 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: entry_from_contact mtime"))
)
(* foreign fields *)
db
) with _ -> None))
db
)
~recipients:(
(* foreign many-many mapping field *)
let sql' = "select service_id from map_recipients_entry_service where entry_id=?" in
let stmt' = Sqlite3.prepare db.db sql' in
let entry__id = Sqlite3.column stmt 9 in
db_must_ok db (fun () -> Sqlite3.bind stmt' 1 entry__id);
List.flatten (step_fold db stmt' (fun s ->
let i = match Sqlite3.column s 0 with |Sqlite3.Data.INT i -> i |_ -> assert false in
Service.get ~id:(Some i) db)
))
~atts:(
(* foreign many-many mapping field *)
let sql' = "select attachment_id from map_atts_entry_attachment where entry_id=?" in
let stmt' = Sqlite3.prepare db.db sql' in
let entry__id = Sqlite3.column stmt 9 in
db_must_ok db (fun () -> Sqlite3.bind stmt' 1 entry__id);
List.flatten (step_fold db stmt' (fun s ->
let i = match Sqlite3.column s 0 with |Sqlite3.Data.INT i -> i |_ -> assert false in
Attachment.get ~id:(Some i) db)
))
~tags:(
(* foreign many-many mapping field *)
let sql' = "select tag_id from map_tags_entry_tag where entry_id=?" in
let stmt' = Sqlite3.prepare db.db sql' in
let entry__id = Sqlite3.column stmt 9 in
db_must_ok db (fun () -> Sqlite3.bind stmt' 1 entry__id);
List.flatten (step_fold db stmt' (fun s ->
let i = match Sqlite3.column s 0 with |Sqlite3.Data.INT i -> i |_ -> assert false in
Tag.get ~id:(Some i) db)
))
db
in
(* execute the SQL query *)
step_fold db stmt of_stmt
let get_uid ?(custom_where=("",[])) db =
let q = "" in
let q = match custom_where with |"",_ -> q |w,_ -> q ^ "WHERE (" ^ w ^ ")" in
let sql="SELECT entry.id, entry.uid FROM entry " ^ q in
let stmt=Sqlite3.prepare db.db sql in
ignore(match custom_where with |_,[] -> () |_,eb ->
let pos = ref 1 in
List.iter (fun b ->
db_must_ok db (fun () -> Sqlite3.bind stmt !pos b);
incr pos;
) eb);
let t ~id ~uid db = (uid) in
(* 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: entry id")))
)
~uid:(
(match Sqlite3.column stmt 1 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
(* foreign fields *)
db
in
(* execute the SQL query *)
step_fold db stmt of_stmt
let get_file_name ?(custom_where=("",[])) db =
let q = "" in
let q = match custom_where with |"",_ -> q |w,_ -> q ^ "WHERE (" ^ w ^ ")" in
let sql="SELECT entry.id, entry.file_name FROM entry " ^ q in
let stmt=Sqlite3.prepare db.db sql in
ignore(match custom_where with |_,[] -> () |_,eb ->
let pos = ref 1 in
List.iter (fun b ->
db_must_ok db (fun () -> Sqlite3.bind stmt !pos b);
incr pos;
) eb);
let t ~id ~file_name db = (file_name) in
(* 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: entry id")))
)
~file_name:(
(match Sqlite3.column stmt 1 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
(* foreign fields *)
db
in
(* execute the SQL query *)
step_fold db stmt of_stmt
let get_created ?(custom_where=("",[])) db =
let q = "" in
let q = match custom_where with |"",_ -> q |w,_ -> q ^ "WHERE (" ^ w ^ ")" in
let sql="SELECT entry.id, entry.created FROM entry " ^ q in
let stmt=Sqlite3.prepare db.db sql in
ignore(match custom_where with |_,[] -> () |_,eb ->
let pos = ref 1 in
List.iter (fun b ->
db_must_ok db (fun () -> Sqlite3.bind stmt !pos b);
incr pos;
) eb);
let t ~id ~created db = (created) in
(* 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: entry id")))
)
~created:(
(match Sqlite3.column stmt 1 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: entry created"))
)
(* foreign fields *)
db
in
(* execute the SQL query *)
step_fold db stmt of_stmt
let get_from_recipients ?(custom_where=("",[])) db =
let q = "" in
let q = match custom_where with |"",_ -> q |w,_ -> q ^ "WHERE (" ^ w ^ ")" in
let sql="SELECT entry_from.id, entry_from.name, entry_from.uid, entry_from.contact_id, entry.id, entry.from_id, entry_from_contact.id, entry_from_contact.file_name, entry_from_contact.uid, entry_from_contact.first_name, entry_from_contact.last_name, entry_from_contact.mtime FROM entry LEFT JOIN service AS entry_from ON (entry_from.id = entry.from_id) LEFT JOIN contact AS entry_from_contact ON (entry_from_contact.id = entry_from.contact_id) " ^ q in
let stmt=Sqlite3.prepare db.db sql in
ignore(match custom_where with |_,[] -> () |_,eb ->
let pos = ref 1 in
List.iter (fun b ->
db_must_ok db (fun () -> Sqlite3.bind stmt !pos b);
incr pos;
) eb);
let t ~id ~from ~recipients db = (from,recipients) in
(* convert statement into an ocaml object *)
let of_stmt stmt =
t
(* native fields *)
~id:(
(match Sqlite3.column stmt 4 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: entry id")))
)
(* foreign fields *)
~from:(
Service.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: entry_from id")))
)
~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)
)
(* foreign fields *)
~contact:(
(try
Some (
Contact.t
(* native fields *)
~id:(
(match Sqlite3.column stmt 6 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: entry_from_contact id")))
)
~file_name:(
(match Sqlite3.column stmt 7 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
~uid:(
(match Sqlite3.column stmt 8 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
~first_name:(
(match Sqlite3.column stmt 9 with
|Sqlite3.Data.NULL -> None
|x -> Some (Sqlite3.Data.to_string x))
)
~last_name:(
(match Sqlite3.column stmt 10 with
|Sqlite3.Data.NULL -> None
|x -> Some (Sqlite3.Data.to_string x))
)
~mtime:(
(match Sqlite3.column stmt 11 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: entry_from_contact mtime"))
)
(* foreign fields *)
db
) with _ -> None))
db
)
~recipients:(
(* foreign many-many mapping field *)
let sql' = "select service_id from map_recipients_entry_service where entry_id=?" in
let stmt' = Sqlite3.prepare db.db sql' in
let entry__id = Sqlite3.column stmt 4 in
db_must_ok db (fun () -> Sqlite3.bind stmt' 1 entry__id);
List.flatten (step_fold db stmt' (fun s ->
let i = match Sqlite3.column s 0 with |Sqlite3.Data.INT i -> i |_ -> assert false in
Service.get ~id:(Some i) db)
))
db
in
(* execute the SQL query *)
step_fold db stmt of_stmt
let get_by_uid ~uid ?(custom_where=("",[])) db =
let q = "WHERE entry.uid=?" in
let q = match custom_where with |"",_ -> q |w,_ -> q ^ " AND (" ^ w ^ ")" in
let sql="SELECT entry_from.id, entry_from.name, entry_from.uid, entry_from.contact_id, entry_mtype.id, entry_mtype.name, entry_mtype.label, entry_mtype.icon, entry_mtype.implements, entry.id, entry.uid, entry.file_name, entry.created, entry.mtype_id, entry.from_id, entry.delivered, entry_from_contact.id, entry_from_contact.file_name, entry_from_contact.uid, entry_from_contact.first_name, entry_from_contact.last_name, entry_from_contact.mtime FROM entry LEFT JOIN mtype AS entry_mtype ON (entry_mtype.id = entry.mtype_id) LEFT JOIN service AS entry_from ON (entry_from.id = entry.from_id) LEFT JOIN contact AS entry_from_contact ON (entry_from_contact.id = entry_from.contact_id) " ^ 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 9 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: entry id")))
)
~uid:(
(match Sqlite3.column stmt 10 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
~file_name:(
(match Sqlite3.column stmt 11 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
~created:(
(match Sqlite3.column stmt 12 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: entry created"))
)
~delivered:(
(match Sqlite3.column stmt 15 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> match x with |Sqlite3.Data.INT i -> i |x -> (try Int64.of_string (Sqlite3.Data.to_string x) with _ -> failwith "error: entry delivered"))
)
(* foreign fields *)
~mtype:(
Mtype.t
(* native fields *)
~id:(
(match Sqlite3.column stmt 4 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: entry_mtype id")))
)
~name:(
(match Sqlite3.column stmt 5 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
~label:(
(match Sqlite3.column stmt 6 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
~icon:(
(match Sqlite3.column stmt 7 with
|Sqlite3.Data.NULL -> None
|x -> Some (Sqlite3.Data.to_string x))
)
~implements:(
(match Sqlite3.column stmt 8 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
(* foreign fields *)
db
)
~from:(
Service.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: entry_from id")))
)
~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)
)
(* foreign fields *)
~contact:(
(try
Some (
Contact.t
(* native fields *)
~id:(
(match Sqlite3.column stmt 16 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: entry_from_contact id")))
)
~file_name:(
(match Sqlite3.column stmt 17 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
~uid:(
(match Sqlite3.column stmt 18 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
~first_name:(
(match Sqlite3.column stmt 19 with
|Sqlite3.Data.NULL -> None
|x -> Some (Sqlite3.Data.to_string x))
)
~last_name:(
(match Sqlite3.column stmt 20 with
|Sqlite3.Data.NULL -> None
|x -> Some (Sqlite3.Data.to_string x))
)
~mtime:(
(match Sqlite3.column stmt 21 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: entry_from_contact mtime"))
)
(* foreign fields *)
db
) with _ -> None))
db
)
~recipients:(
(* foreign many-many mapping field *)
let sql' = "select service_id from map_recipients_entry_service where entry_id=?" in
let stmt' = Sqlite3.prepare db.db sql' in
let entry__id = Sqlite3.column stmt 9 in
db_must_ok db (fun () -> Sqlite3.bind stmt' 1 entry__id);
List.flatten (step_fold db stmt' (fun s ->
let i = match Sqlite3.column s 0 with |Sqlite3.Data.INT i -> i |_ -> assert false in
Service.get ~id:(Some i) db)
))
~atts:(
(* foreign many-many mapping field *)
let sql' = "select attachment_id from map_atts_entry_attachment where entry_id=?" in
let stmt' = Sqlite3.prepare db.db sql' in
let entry__id = Sqlite3.column stmt 9 in
db_must_ok db (fun () -> Sqlite3.bind stmt' 1 entry__id);
List.flatten (step_fold db stmt' (fun s ->
let i = match Sqlite3.column s 0 with |Sqlite3.Data.INT i -> i |_ -> assert false in
Attachment.get ~id:(Some i) db)
))
~tags:(
(* foreign many-many mapping field *)
let sql' = "select tag_id from map_tags_entry_tag where entry_id=?" in
let stmt' = Sqlite3.prepare db.db sql' in
let entry__id = Sqlite3.column stmt 9 in
db_must_ok db (fun () -> Sqlite3.bind stmt' 1 entry__id);
List.flatten (step_fold db stmt' (fun s ->
let i = match Sqlite3.column s 0 with |Sqlite3.Data.INT i -> i |_ -> assert false in
Tag.get ~id:(Some i) db)
))
db
in
(* execute the SQL query *)
step_fold db stmt of_stmt
let get_by_file_name ~file_name ?(custom_where=("",[])) db =
let q = "WHERE entry.file_name=?" in
let q = match custom_where with |"",_ -> q |w,_ -> q ^ " AND (" ^ w ^ ")" in
let sql="SELECT entry_from.id, entry_from.name, entry_from.uid, entry_from.contact_id, entry_mtype.id, entry_mtype.name, entry_mtype.label, entry_mtype.icon, entry_mtype.implements, entry.id, entry.uid, entry.file_name, entry.created, entry.mtype_id, entry.from_id, entry.delivered, entry_from_contact.id, entry_from_contact.file_name, entry_from_contact.uid, entry_from_contact.first_name, entry_from_contact.last_name, entry_from_contact.mtime FROM entry LEFT JOIN mtype AS entry_mtype ON (entry_mtype.id = entry.mtype_id) LEFT JOIN service AS entry_from ON (entry_from.id = entry.from_id) LEFT JOIN contact AS entry_from_contact ON (entry_from_contact.id = entry_from.contact_id) " ^ q in
let stmt=Sqlite3.prepare db.db sql in
db_must_ok db (fun () -> let v = file_name 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 9 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: entry id")))
)
~uid:(
(match Sqlite3.column stmt 10 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
~file_name:(
(match Sqlite3.column stmt 11 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
~created:(
(match Sqlite3.column stmt 12 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: entry created"))
)
~delivered:(
(match Sqlite3.column stmt 15 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> match x with |Sqlite3.Data.INT i -> i |x -> (try Int64.of_string (Sqlite3.Data.to_string x) with _ -> failwith "error: entry delivered"))
)
(* foreign fields *)
~mtype:(
Mtype.t
(* native fields *)
~id:(
(match Sqlite3.column stmt 4 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: entry_mtype id")))
)
~name:(
(match Sqlite3.column stmt 5 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
~label:(
(match Sqlite3.column stmt 6 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
~icon:(
(match Sqlite3.column stmt 7 with
|Sqlite3.Data.NULL -> None
|x -> Some (Sqlite3.Data.to_string x))
)
~implements:(
(match Sqlite3.column stmt 8 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
(* foreign fields *)
db
)
~from:(
Service.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: entry_from id")))
)
~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)
)
(* foreign fields *)
~contact:(
(try
Some (
Contact.t
(* native fields *)
~id:(
(match Sqlite3.column stmt 16 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: entry_from_contact id")))
)
~file_name:(
(match Sqlite3.column stmt 17 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
~uid:(
(match Sqlite3.column stmt 18 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
~first_name:(
(match Sqlite3.column stmt 19 with
|Sqlite3.Data.NULL -> None
|x -> Some (Sqlite3.Data.to_string x))
)
~last_name:(
(match Sqlite3.column stmt 20 with
|Sqlite3.Data.NULL -> None
|x -> Some (Sqlite3.Data.to_string x))
)
~mtime:(
(match Sqlite3.column stmt 21 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: entry_from_contact mtime"))
)
(* foreign fields *)
db
) with _ -> None))
db
)
~recipients:(
(* foreign many-many mapping field *)
let sql' = "select service_id from map_recipients_entry_service where entry_id=?" in
let stmt' = Sqlite3.prepare db.db sql' in
let entry__id = Sqlite3.column stmt 9 in
db_must_ok db (fun () -> Sqlite3.bind stmt' 1 entry__id);
List.flatten (step_fold db stmt' (fun s ->
let i = match Sqlite3.column s 0 with |Sqlite3.Data.INT i -> i |_ -> assert false in
Service.get ~id:(Some i) db)
))
~atts:(
(* foreign many-many mapping field *)
let sql' = "select attachment_id from map_atts_entry_attachment where entry_id=?" in
let stmt' = Sqlite3.prepare db.db sql' in
let entry__id = Sqlite3.column stmt 9 in
db_must_ok db (fun () -> Sqlite3.bind stmt' 1 entry__id);
List.flatten (step_fold db stmt' (fun s ->
let i = match Sqlite3.column s 0 with |Sqlite3.Data.INT i -> i |_ -> assert false in
Attachment.get ~id:(Some i) db)
))
~tags:(
(* foreign many-many mapping field *)
let sql' = "select tag_id from map_tags_entry_tag where entry_id=?" in
let stmt' = Sqlite3.prepare db.db sql' in
let entry__id = Sqlite3.column stmt 9 in
db_must_ok db (fun () -> Sqlite3.bind stmt' 1 entry__id);
List.flatten (step_fold db stmt' (fun s ->
let i = match Sqlite3.column s 0 with |Sqlite3.Data.INT i -> i |_ -> assert false in
Tag.get ~id:(Some i) db)
))
db
in
(* execute the SQL query *)
step_fold db stmt of_stmt
end
module Init = struct
type t = state
type transaction_mode = [`Exclusive |`Deferred |`Immediate ]
let t ?(busyfn=default_busyfn) ?(mode=`Immediate) db_name =
let db = {db=Sqlite3.db_open db_name; in_transaction=0; mode=mode; busyfn=busyfn } in
Attachment.init db;
Contact.init db;
Mtype.init db;
Service.init db;
Tag.init db;
Entry.init db;
db
let db handle = handle.db
end
Something went wrong with that request. Please try again.