Find file
Fetching contributors…
Cannot retrieve contributors at this time
278 lines (254 sloc) 9.87 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 Task = struct
type t = <
id : int64 option;
set_id : int64 option -> unit;
name : string;
set_name : string -> unit;
started : float;
set_started : float -> unit;
time_taken : float;
set_time_taken : float -> unit;
exit_code : int64;
set_exit_code : int64 -> unit;
save: int64; delete: unit
>
let init db =
let sql = "create table if not exists task (id integer primary key autoincrement,name text,started real,time_taken real,exit_code integer);" in
db_must_ok db (fun () -> Sqlite3.exec db.db sql);
()
(* object definition *)
let t ?(id=None) ~name ~started ~time_taken ~exit_code db : t = object
(* get functions *)
val mutable _id = id
method id : int64 option = _id
val mutable _name = name
method name : string = _name
val mutable _started = started
method started : float = _started
val mutable _time_taken = time_taken
method time_taken : float = _time_taken
val mutable _exit_code = exit_code
method exit_code : int64 = _exit_code
(* set functions *)
method set_id v =
_id <- v
method set_name v =
_name <- v
method set_started v =
_started <- v
method set_time_taken v =
_time_taken <- v
method set_exit_code v =
_exit_code <- v
(* admin functions *)
method delete =
match _id with
|None -> ()
|Some id ->
let sql = "DELETE FROM task 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 task 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 = _started in Sqlite3.Data.FLOAT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 3 (let v = _time_taken in Sqlite3.Data.FLOAT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 4 (let v = _exit_code 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 task SET name=?,started=?,time_taken=?,exit_code=? 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 = _started in Sqlite3.Data.FLOAT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 3 (let v = _time_taken in Sqlite3.Data.FLOAT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 4 (let v = _exit_code in Sqlite3.Data.INT 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) ?(started=None) ?(time_taken=None) ?(exit_code=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()) ^ "task.id=?" in
let q = match name with |None -> q |Some b -> q ^ (f()) ^ "task.name=?" in
let q = match started with |None -> q |Some b -> q ^ (f()) ^ "task.started=?" in
let q = match time_taken with |None -> q |Some b -> q ^ (f()) ^ "task.time_taken=?" in
let q = match exit_code with |None -> q |Some b -> q ^ (f()) ^ "task.exit_code=?" in
let q = match custom_where with |"",_ -> q |w,_ -> q ^ (f()) ^ "(" ^ w ^ ")" in
let sql="SELECT task.id, task.name, task.started, task.time_taken, task.exit_code FROM task " ^ 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 started with |None -> () |Some v ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos (Sqlite3.Data.FLOAT v));
incr bindpos
);
ignore(match time_taken with |None -> () |Some v ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos (Sqlite3.Data.FLOAT v));
incr bindpos
);
ignore(match exit_code 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 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: task id")))
)
~name:(
(match Sqlite3.column stmt 1 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
~started:(
(match Sqlite3.column stmt 2 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: task started"))
)
~time_taken:(
(match Sqlite3.column stmt 3 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: task time_taken"))
)
~exit_code:(
(match Sqlite3.column stmt 4 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: task exit_code"))
)
(* foreign fields *)
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
Task.init db;
db
let db handle = handle.db
end