impl/sqlgg_mysql.ml

   1 (**
   2   Mysql OCaml traits for sqlgg
   3   by ygrek
   4   2014-06-12
   5
   6   This is free and unencumbered software released into the public domain.
   7
   8   Anyone is free to copy, modify, publish, use, compile, sell, or
   9   distribute this software, either in source code form or as a compiled
  10   binary, for any purpose, commercial or non-commercial, and by any
  11   means.
  12
  13   For more information, please refer to <http://unlicense.org/>
  14 *)
  15
  16 open Printf
  17
  18 module P = Mysql.Prepared
  19
  20 module Make(Number : sig type t val of_string : string -> t val to_string : t -> string end) = struct
  21
  22 type statement = P.stmt
  23 type connection = Mysql.dbd
  24 type params = statement * string array
  25 type row = string option array
  26 type result = P.stmt_result
  27
  28 type num = Number.t
  29 type text = string
  30 type any = string
  31 type datetime = float
  32
  33 exception Oops of string
  34 let oops fmt = ksprintf (fun s -> raise (Oops s)) fmt
  35
  36 let get_column_ty name conv row index =
  37   try
  38     conv (match row.(index) with None -> failwith "no value" | Some (x:string) -> x)
  39   with
  40     e -> oops "get_column_%s %i (%s)" name index (Printexc.to_string e)
  41
  42 let get_column_Int = get_column_ty "Int" Number.of_string
  43 let get_column_Text = get_column_ty "Text" (fun x -> x)
  44 let get_column_Float = get_column_ty "Float" float_of_string
  45 let get_column_Datetime = get_column_ty "Datetime" float_of_string
  46 let get_column_Any = get_column_Text
  47
  48 let bind_param data (_,params) index =
  49   match data with
  50   | Some s -> params.(index) <- s
  51   | None -> oops "bind_param None -- not implemented"
  52
  53 let start_params stmt n = (stmt,Array.make n "")
  54 let finish_params (stmt,params) = P.execute stmt params
  55
  56 let set_param_Text stmt index v = bind_param (Some v) stmt index
  57 let set_param_null stmt index = bind_param None stmt index
  58 let set_param_Any = set_param_Text
  59 let set_param_Int stmt index v = bind_param (Some (Number.to_string v)) stmt index
  60 let set_param_Float stmt index v = bind_param (Some (string_of_float v)) stmt index
  61 let set_param_Datetime = set_param_Float
  62
  63 let no_params stmt = P.execute stmt [||]
  64
  65 let try_finally final f x =
  66   let r =
  67     try f x with exn -> final (); raise exn
  68   in
  69     final ();
  70     r
  71
  72 let bracket res dtor k = try_finally (fun () -> dtor res) k res
  73 let with_stmt db sql = bracket (P.create db sql) P.close
  74
  75 let select db sql set_params callback =
  76   with_stmt db sql (fun stmt ->
  77     let r = set_params stmt in
  78     let rec loop () =
  79       match P.fetch r with
  80       | Some row -> callback row; loop ()
  81       | None -> ()
  82     in
  83     loop ())
  84
  85 let execute db sql set_params =
  86   with_stmt db sql (fun stmt ->
  87     let _ = set_params stmt in
  88     if 0 <> P.real_status stmt then oops "execute : %s" sql;
  89     P.affected stmt)
  90
  91 let select1 db sql set_params callback =
  92   with_stmt db sql (fun stmt ->
  93     match P.fetch (set_params stmt) with
  94     | Some row -> Some (callback row)
  95     | None -> None)
  96
  97 end
  98