mysql.ml

(*
    Ocaml-MySQL: MySQL bindings for Ocaml.
    Copyright (C) 2001-2003 Shawn Wagner <shawnw@speakeasy.org>
                  1998, 1999 Christian Lindig <lindig@eecs.harvard.edu>

    This library is free software; you can redistribute it and/or
    modify it under the terms of the GNU Lesser General Public
    License as published by the Free Software Foundation; either
    version 2.1 of the License, or (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
    Lesser General Public License for more details.

    You should have received a copy of the GNU Lesser General Public
    License along with this library; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307  USA
*)

module Map = MoreLabels.Map
module String = StdLabels.String
module Array = StdLabels.Array

module StrMap = Map.Make(struct type t = string let compare = compare end)

exception Error of string

let _ = Callback.register_exception "mysql error" (Error "Registering Callback")

(* let error msg   = raise (Error msg) *)
let fail  msg   = raise (Failure msg)

type dbd        (* database connection handle *)
type result     (* handle to access result from query *)

external init : unit -> unit = "db_library_init"

(* Do not change any type definition that is used by external functions 
   without changing the C source code accordingly! *)

(* Error codes *)
(* Auto-generated on Thu Feb 20 06:10:26 2003 from MySQL headers. *)
type error_code = Aborting_connection | Access_denied_error | Alter_info | Bad_db_error | Bad_field_error | Bad_host_error | Bad_null_error | Bad_table_error | Blob_cant_have_default | Blob_key_without_length | Blob_used_as_key | Blobs_and_no_terminated | Cant_create_db | Cant_create_file | Cant_create_table | Cant_create_thread | Cant_delete_file | Cant_drop_field_or_key | Cant_find_dl_entry | Cant_find_system_rec | Cant_find_udf | Cant_get_stat | Cant_get_wd | Cant_initialize_udf | Cant_lock | Cant_open_file | Cant_open_library | Cant_read_charset | Cant_read_dir | Cant_remove_all_fields | Cant_reopen_table | Cant_set_wd | Checkread | Columnaccess_denied_error | Commands_out_of_sync | Con_count_error | Conn_host_error | Connection_error | Db_create_exists | Db_drop_delete | Db_drop_exists | Db_drop_rmdir | Dbaccess_denied_error | Delayed_cant_change_lock | Delayed_insert_table_locked | Disk_full | Dup_entry | Dup_fieldname | Dup_key | Dup_keyname | Dup_unique | Empty_query | Error_on_close | Error_on_read | Error_on_rename | Error_on_write | Field_specified_twice | File_exists_error | File_not_found | File_used | Filsort_abort | Forcing_close | Form_not_found | Function_not_defined | Get_errno | Got_signal | Grant_wrong_host_or_user | Handshake_error | Hashchk | Host_is_blocked | Host_not_privileged | Illegal_grant_for_table | Illegal_ha | Insert_info | Insert_table_used | Invalid_default | Invalid_group_func_use | Invalid_use_of_null | Ipsock_error | Key_column_does_not_exits | Key_not_found | Kill_denied_error | Load_info | Localhost_connection | Mix_of_group_func_and_fields | Multiple_pri_key | Namedpipe_connection | Namedpipeopen_error | Namedpipesetstate_error | Namedpipewait_error | Net_error_on_write | Net_fcntl_error | Net_packet_too_large | Net_packets_out_of_order | Net_read_error | Net_read_error_from_pipe | Net_read_interrupted | Net_uncompress_error | Net_write_interrupted | Nisamchk | No | No_db_error | No_raid_compiled | No_such_index | No_such_table | No_such_thread | No_tables_used | No_unique_logfile | Non_uniq_error | Nonexisting_grant | Nonexisting_table_grant | Nonuniq_table | Normal_shutdown | Not_allowed_command | Not_form_file | Not_keyfile | Null_column_in_index | Old_keyfile | Open_as_readonly | Out_of_memory | Out_of_resources | Out_of_sortmemory | Outofmemory | Parse_error | Password_anonymous_user | Password_no_match | Password_not_allowed | Primary_cant_have_null | Ready | Record_file_full | Regexp_error | Requires_primary_key | Server_gone_error | Server_handshake_err | Server_lost | Server_shutdown | Shutdown_complete | Socket_create_error | Stack_overrun | Syntax_error | Table_cant_handle_auto_increment | Table_cant_handle_blob | Table_exists_error | Table_must_have_columns | Table_not_locked | Table_not_locked_for_write | Tableaccess_denied_error | Tcp_connection | Textfile_not_readable | Too_big_fieldlength | Too_big_rowsize | Too_big_select | Too_big_set | Too_long_ident | Too_long_key | Too_long_string | Too_many_delayed_threads | Too_many_fields | Too_many_key_parts | Too_many_keys | Too_many_rows | Too_many_tables | Udf_exists | Udf_no_paths | Unexpected_eof | Unknown_character_set | Unknown_com_error | Unknown_error | Unknown_host | Unknown_procedure | Unknown_table | Unsupported_extension | Update_info | Update_without_key_in_safe_mode | Version_error | Wrong_auto_key | Wrong_column_name | Wrong_db_name | Wrong_field_spec | Wrong_field_terminators | Wrong_field_with_group | Wrong_group_field | Wrong_host_info | Wrong_key_column | Wrong_mrg_table | Wrong_outer_join | Wrong_paramcount_to_procedure | Wrong_parameters_to_procedure | Wrong_sub_key | Wrong_sum_select | Wrong_table_name | Wrong_value_count | Wrong_value_count_on_row | Yes

let error_of_int code = match code with
| 1000 -> Hashchk
| 1001 -> Nisamchk
| 1002 -> No
| 1003 -> Yes
| 1004 -> Cant_create_file
| 1005 -> Cant_create_table
| 1006 -> Cant_create_db
| 1007 -> Db_create_exists
| 1008 -> Db_drop_exists
| 1009 -> Db_drop_delete
| 1010 -> Db_drop_rmdir
| 1011 -> Cant_delete_file
| 1012 -> Cant_find_system_rec
| 1013 -> Cant_get_stat
| 1014 -> Cant_get_wd
| 1015 -> Cant_lock
| 1016 -> Cant_open_file
| 1017 -> File_not_found
| 1018 -> Cant_read_dir
| 1019 -> Cant_set_wd
| 1020 -> Checkread
| 1021 -> Disk_full
| 1022 -> Dup_key
| 1023 -> Error_on_close
| 1024 -> Error_on_read
| 1025 -> Error_on_rename
| 1026 -> Error_on_write
| 1027 -> File_used
| 1028 -> Filsort_abort
| 1029 -> Form_not_found
| 1030 -> Get_errno
| 1031 -> Illegal_ha
| 1032 -> Key_not_found
| 1033 -> Not_form_file
| 1034 -> Not_keyfile
| 1035 -> Old_keyfile
| 1036 -> Open_as_readonly
| 1037 -> Outofmemory
| 1038 -> Out_of_sortmemory
| 1039 -> Unexpected_eof
| 1040 -> Con_count_error
| 1041 -> Out_of_resources
| 1042 -> Bad_host_error
| 1043 -> Handshake_error
| 1044 -> Dbaccess_denied_error
| 1045 -> Access_denied_error
| 1046 -> No_db_error
| 1047 -> Unknown_com_error
| 1048 -> Bad_null_error
| 1049 -> Bad_db_error
| 1050 -> Table_exists_error
| 1051 -> Bad_table_error
| 1052 -> Non_uniq_error
| 1053 -> Server_shutdown
| 1054 -> Bad_field_error
| 1055 -> Wrong_field_with_group
| 1056 -> Wrong_group_field
| 1057 -> Wrong_sum_select
| 1058 -> Wrong_value_count
| 1059 -> Too_long_ident
| 1060 -> Dup_fieldname
| 1061 -> Dup_keyname
| 1062 -> Dup_entry
| 1063 -> Wrong_field_spec
| 1064 -> Parse_error
| 1065 -> Empty_query
| 1066 -> Nonuniq_table
| 1067 -> Invalid_default
| 1068 -> Multiple_pri_key
| 1069 -> Too_many_keys
| 1070 -> Too_many_key_parts
| 1071 -> Too_long_key
| 1072 -> Key_column_does_not_exits
| 1073 -> Blob_used_as_key
| 1074 -> Too_big_fieldlength
| 1075 -> Wrong_auto_key
| 1076 -> Ready
| 1077 -> Normal_shutdown
| 1078 -> Got_signal
| 1079 -> Shutdown_complete
| 1080 -> Forcing_close
| 1081 -> Ipsock_error
| 1082 -> No_such_index
| 1083 -> Wrong_field_terminators
| 1084 -> Blobs_and_no_terminated
| 1085 -> Textfile_not_readable
| 1086 -> File_exists_error
| 1087 -> Load_info
| 1088 -> Alter_info
| 1089 -> Wrong_sub_key
| 1090 -> Cant_remove_all_fields
| 1091 -> Cant_drop_field_or_key
| 1092 -> Insert_info
| 1093 -> Insert_table_used
| 1094 -> No_such_thread
| 1095 -> Kill_denied_error
| 1096 -> No_tables_used
| 1097 -> Too_big_set
| 1098 -> No_unique_logfile
| 1099 -> Table_not_locked_for_write
| 1100 -> Table_not_locked
| 1101 -> Blob_cant_have_default
| 1102 -> Wrong_db_name
| 1103 -> Wrong_table_name
| 1104 -> Too_big_select
| 1105 -> Unknown_error
| 1106 -> Unknown_procedure
| 1107 -> Wrong_paramcount_to_procedure
| 1108 -> Wrong_parameters_to_procedure
| 1109 -> Unknown_table
| 1110 -> Field_specified_twice
| 1111 -> Invalid_group_func_use
| 1112 -> Unsupported_extension
| 1113 -> Table_must_have_columns
| 1114 -> Record_file_full
| 1115 -> Unknown_character_set
| 1116 -> Too_many_tables
| 1117 -> Too_many_fields
| 1118 -> Too_big_rowsize
| 1119 -> Stack_overrun
| 1120 -> Wrong_outer_join
| 1121 -> Null_column_in_index
| 1122 -> Cant_find_udf
| 1123 -> Cant_initialize_udf
| 1124 -> Udf_no_paths
| 1125 -> Udf_exists
| 1126 -> Cant_open_library
| 1127 -> Cant_find_dl_entry
| 1128 -> Function_not_defined
| 1129 -> Host_is_blocked
| 1130 -> Host_not_privileged
| 1131 -> Password_anonymous_user
| 1132 -> Password_not_allowed
| 1133 -> Password_no_match
| 1134 -> Update_info
| 1135 -> Cant_create_thread
| 1136 -> Wrong_value_count_on_row
| 1137 -> Cant_reopen_table
| 1138 -> Invalid_use_of_null
| 1139 -> Regexp_error
| 1140 -> Mix_of_group_func_and_fields
| 1141 -> Nonexisting_grant
| 1142 -> Tableaccess_denied_error
| 1143 -> Columnaccess_denied_error
| 1144 -> Illegal_grant_for_table
| 1145 -> Grant_wrong_host_or_user
| 1146 -> No_such_table
| 1147 -> Nonexisting_table_grant
| 1148 -> Not_allowed_command
| 1149 -> Syntax_error
| 1150 -> Delayed_cant_change_lock
| 1151 -> Too_many_delayed_threads
| 1152 -> Aborting_connection
| 1153 -> Net_packet_too_large
| 1154 -> Net_read_error_from_pipe
| 1155 -> Net_fcntl_error
| 1156 -> Net_packets_out_of_order
| 1157 -> Net_uncompress_error
| 1158 -> Net_read_error
| 1159 -> Net_read_interrupted
| 1160 -> Net_error_on_write
| 1161 -> Net_write_interrupted
| 1162 -> Too_long_string
| 1163 -> Table_cant_handle_blob
| 1164 -> Table_cant_handle_auto_increment
| 1165 -> Delayed_insert_table_locked
| 1166 -> Wrong_column_name
| 1167 -> Wrong_key_column
| 1168 -> Wrong_mrg_table
| 1169 -> Dup_unique
| 1170 -> Blob_key_without_length
| 1171 -> Primary_cant_have_null
| 1172 -> Too_many_rows
| 1173 -> Requires_primary_key
| 1174 -> No_raid_compiled
| 1175 -> Update_without_key_in_safe_mode
| 2000 -> Unknown_error
| 2001 -> Socket_create_error
| 2002 -> Connection_error
| 2003 -> Conn_host_error
| 2004 -> Ipsock_error
| 2005 -> Unknown_host
| 2006 -> Server_gone_error
| 2007 -> Version_error
| 2008 -> Out_of_memory
| 2009 -> Wrong_host_info
| 2010 -> Localhost_connection
| 2011 -> Tcp_connection
| 2012 -> Server_handshake_err
| 2013 -> Server_lost
| 2014 -> Commands_out_of_sync
| 2015 -> Namedpipe_connection
| 2016 -> Namedpipewait_error
| 2017 -> Namedpipeopen_error
| 2018 -> Namedpipesetstate_error
| 2019 -> Cant_read_charset
| 2020 -> Net_packet_too_large
| _ -> Unknown_error


(* Status of MySQL database after an operation. Especially indicates empty 
   result sets *)
type status =
| StatusOK
| StatusEmpty
| StatusError of error_code

(* database field type *)
type dbty =
| IntTy         (* 0  *)
| FloatTy       (* 1  *)
| StringTy      (* 2  *)
| SetTy         (* 3  *)
| EnumTy        (* 4  *)
| DateTimeTy    (* 5  *)
| DateTy        (* 6  *)
| TimeTy        (* 7  *)
| YearTy        (* 8  *)
| TimeStampTy   (* 9  *)
| UnknownTy     (* 10 *)
| Int64Ty       (* 11 *)
| BlobTy        (* 12 *)
| DecimalTy     (* 13 *)

let pretty_type = function
  | IntTy -> "integer"
  | FloatTy -> "float"
  | StringTy -> "string"
  | SetTy -> "set"
  | EnumTy -> "enum"
  | DateTimeTy  -> "datetime"
  | DateTy        -> "date"
  | TimeTy        -> "time"
  | YearTy        -> "year"
  | TimeStampTy   -> "timestamp"
  | UnknownTy     -> "unknown"
  | Int64Ty       -> "int64"
  | BlobTy        -> "blob"
  | DecimalTy     -> "decimal"


(* database login informations -- use None for default values *)

type db         =
                { dbhost    : string option  (*    database server host *)
                ; dbname    : string option  (*    database name        *)
                ; dbport    : int option     (*    port                 *)
                ; dbpwd     : string option  (*    user password        *)
                ; dbuser    : string option  (*    database user        *)
                ; dbsocket  : string option  (*    unix socket path     *)
                }

type field = { name : string; (* Name of the field *)
               table : string option; (* Table name, or None if a constructed field *)
               def : string option; (* Default value of the field *)
               ty : dbty;
               max_length : int; (* Maximum width of field for the result set *)
               flags : int; (* Flags set *)
               decimals : int (* Number of decimals for numeric fields *)
             } 


(* low level C interface *)

let defaults = { dbhost = None; dbname = None; dbport = None; dbpwd = None; dbuser = None; dbsocket = None; }

type protocol =
| PROTOCOL_DEFAULT
| PROTOCOL_TCP
| PROTOCOL_SOCKET
| PROTOCOL_PIPE
| PROTOCOL_MEMORY

type db_option =
| OPT_COMPRESS
| OPT_NAMED_PIPE
| OPT_LOCAL_INFILE of bool
| OPT_RECONNECT of bool
| OPT_SSL_VERIFY_SERVER_CERT of bool
| REPORT_DATA_TRUNCATION of bool
| SECURE_AUTH of bool
| OPT_PROTOCOL of protocol
| OPT_CONNECT_TIMEOUT of int
| OPT_READ_TIMEOUT of int
| OPT_WRITE_TIMEOUT of int
| INIT_COMMAND of string
| READ_DEFAULT_FILE of string
| READ_DEFAULT_GROUP of string
| SET_CHARSET_DIR of string
| SET_CHARSET_NAME of string
| SHARED_MEMORY_BASE_NAME of string
| OPT_FOUND_ROWS

external connect    : db_option list -> db -> dbd                             = "db_connect"

let connect ?(options=[]) db = connect options db

let quick_connect ?options ?host ?database ?port ?password ?user ?socket () =
  connect ?options { dbhost = host; dbname = database; dbport = port; dbpwd = password; dbuser = user; dbsocket = socket; }

external change_user : dbd -> db -> unit                    = "db_change_user"

let quick_change ?user ?password ?database conn =
  change_user conn { defaults with dbuser = user; dbpwd = password; dbname = database }

external select_db   : dbd -> string -> unit                = "db_select_db"
external list_dbs    : dbd -> ?pat:string -> unit -> string array option = "db_list_dbs"
external disconnect : dbd -> unit                           = "db_disconnect"
external ping       : dbd -> unit                           = "db_ping"
external exec       : dbd -> string -> result               = "db_exec"
external real_status     : dbd -> int                         = "db_status"
external errmsg     : dbd -> string option                  = "db_errmsg"
external db_escape  : string -> string                      = "db_escape"
let escape s =
  init (); (* libmariadb crashes without init *)
  db_escape s
external real_escape: dbd -> string -> string               = "db_real_escape"
external set_charset: dbd -> string -> unit                 = "db_set_charset"
external fetch      : result -> string option array option  = "db_fetch" 
external to_row     : result -> int64 -> unit                 = "db_to_row"
external size       : result -> int64                         = "db_size"
external affected    : dbd -> int64                           = "db_affected"
external insert_id: dbd -> int64 = "db_insert_id"
external fields     : result -> int                         = "db_fields"
external client_info : unit -> string = "db_client_info" (* works without init *)
external host_info   : dbd -> string = "db_host_info"
external server_info : dbd -> string = "db_server_info"
external proto_info  : dbd -> int    = "db_proto_info"
external fetch_field : result -> field option = "db_fetch_field"
external fetch_fields : result -> field array option = "db_fetch_fields"
external fetch_field_dir : result -> int -> field option = "db_fetch_field_dir"

let status dbd =
  let x = real_status dbd in
  match x with
  | 0 -> StatusOK
  | 1065 -> StatusEmpty
  | _ -> StatusError (error_of_int x)

let errno dbd = error_of_int (real_status dbd)

(* [sub start len str] returns integer obtained from substring of length 
   [len] from [str] *)

let sub start len str = int_of_string (String.sub str ~pos:start ~len)

(* xxx2ml parses a string returned from a MySQL field typed xxx and turns it into a 
   corresponding OCaml value.

   MySQL uses the following representations for date/time values

   DATETIME     yyyy-mm-dd hh:mm:ss
   DATE         yyyy-mm-dd'
   TIME         hh:mm:ss'
   YEAR         yyyy'
   TIMESTAMP    YYYYMMDDHHMMSS'
*)
 

let int2ml   str        = int_of_string str
let decimal2ml   str    = str
let int322ml str        = Int32.of_string str
let int642ml str        = Int64.of_string str
let nativeint2ml str    = Nativeint.of_string str
let float2ml str        = float_of_string str
let str2ml   str        = str
let enum2ml  str        = str
let blob2ml  str        = str

(* [set2ml str] parses a comma separated list of words in [str] and
   returns them in a list.  MySQL uses this format for sets of values
   *)

let set2ml str =
  let rec wsp acc i =
    if i = String.length str then acc else
    match str.[i] with
    | ' ' | '\t' | '\n' | '\r' | ',' -> wsp acc (i + 1)
    | _ -> loop acc i (i+1)
  and loop acc p_start i =
    if i = String.length str then (String.sub str p_start (String.length str - p_start)) :: acc else
    match str.[i] with
    | ' ' | '\t' | '\n' | '\r' | ',' -> wsp (String.sub str p_start (i - p_start) :: acc) (i+1)
    | _ -> loop acc p_start (i+1)
  in
  List.rev (wsp [] 0)

let datetime2ml str =
    assert (String.length str = 19);

    let year    = sub 0  4 str   in
    let month   = sub 5  2 str   in 
    let day     = sub 8  2 str   in
    let hour    = sub 11 2 str   in
    let minute  = sub 14 2 str   in
    let second  = sub 17 2 str   in
        (year,month,day,hour,minute,second)

let date2ml str =
    assert (String.length str = 10);
    let year    = sub 0  4 str   in
    let month   = sub 5  2 str   in 
    let day     = sub 8  2 str   in
        (year,month,day)

let time2ml str =
    assert (String.length str = 8);

    let hour    = sub 0 2 str   in
    let minute  = sub 3 2 str   in
    let second  = sub 6 2 str   in
        (hour,minute,second)

let year2ml str =
    assert (String.length str = 4);
    sub 0 4 str

let timestamp2ml str =
    assert (String.length str = 14);
    let year    = sub 0  4 str   in
    let month   = sub 4  2 str   in 
    let day     = sub 6  2 str   in
    let hour    = sub 8  2 str   in
    let minute  = sub 10 2 str   in
    let second  = sub 12 2 str   in
        (year,month,day,hour,minute,second)


(* [opt f v] applies [f] to optional value [v]. Use this to fetch
   data of known type from database fields which might be NULL:
   [opt int2ml str] *)
let opt f arg = match arg with 
    | None      -> None
    | Some x    -> Some (f x)

(* [not_null f v] applies [f] to [Some v]. Use this to fetch data of known 
   type from database fields which never can be NULL: [not_null int2ml str] 
*)
let not_null f arg = match arg with
    | None      -> fail "not_null was applied to None"
    | Some x    -> f x 


let names result =
  Array.init (fields result) ~f:(function offset ->
    match fetch_field_dir result offset with
    | Some field -> field.name
    | None -> "")

let types result =
  Array.init (fields result) ~f:(function offset ->
    match fetch_field_dir result offset with
    | Some field -> field.ty
    | None -> (fail "Unknown type in field"))

(* [column result] returns a function [col] which fetches columns from
   results by column name.  [col] has type string -> 'a array -> 'b. 
   Where the first argument is the name of the column. 


        let r   = exec dbd "select * from table"  in
        let col = col r                           in
        let rec loop = function
            None   -> []
            Some a -> not_null int2ml (col "label" a) :: loop (fetch r)
        in 
            loop (fetch r)

*)

let column result =
    let names = names result                                    in
    let map   = (* maps names to positions *)
        match Array.length names with
        | 0 -> StrMap.empty
        | n -> let rec loop i map =
                 if   i = n 
                 then map
                 else loop (i+1) (StrMap.add ~key:names.(i) ~data:i map)
               in
                 loop 0 StrMap.empty                            in
     (* return column name from array and apply f *)
     let col ~key ~row =
       row.(StrMap.find key map)
     in
     col

(* ml2xxx encodes OCaml values into strings that match the MysQL syntax of 
   the corresponding type *)

let ml2str str  = "'" ^ escape str ^ "'"
let ml2rstr conn str = "'" ^ real_escape conn str ^ "'"
let ml2blob     = ml2str
let ml2rblob    = ml2rstr
let ml2int x    = string_of_int x
let ml2decimal x    = x
let ml322int x  = Int32.to_string x
let ml642int x  = Int64.to_string x
let mlnative2int x = Nativeint.to_string x
let ml2float x  = string_of_float x
let ml2enum x   = escape x
let ml2renum x  = real_escape x
let ml2set_filter f x =
  let rec loop f = function
  | []        -> ""
  | [x]       -> f x
  | x::y::ys  -> f x ^ "," ^ loop f (y::ys)
  in loop f x
let ml2set x       = ml2set_filter escape x
let ml2rset conn x = ml2set_filter (real_escape conn) x

let ml2datetimel ~year ~month ~day ~hour ~min ~sec =
    Printf.sprintf "'%04d-%02d-%02d %02d:%02d:%02d'"
      year month day hour min sec
let ml2datetime (year,month,day,hour,min,sec) =
  ml2datetimel ~year ~month ~day ~hour ~min ~sec

let ml2datel ~year ~month ~day =
  Printf.sprintf "%04d-%02d-%02d" year month day
let ml2date (year,month,day) =
  ml2datel ~year ~month ~day

let ml2timel ~hour ~min ~sec =
  Printf.sprintf "%02d:%02d%02d" hour min sec
let ml2time (hour,min,sec) =
  ml2timel ~hour ~min ~sec

let ml2year yyyy = Printf.sprintf "%04d" yyyy

let ml2timestampl ~year ~month ~day ~hour ~min ~sec =
    Printf.sprintf "%04d%02d%02d%02d%02d%02d" year month day hour min sec
let ml2timestamp (year,month,day,hour,min,sec) =
  ml2timestampl ~year ~month ~day ~hour ~min ~sec


(* [values vs] creates from a list of values in MySQL format
   a vector (x,y,z,..) for the MySQL values construct *)

let values vs = 
    let rec loop arg = match arg with
        | []        -> ""
        | [x]       -> x
        | x::y::ys  -> x ^ "," ^ loop (y::ys)
    in
        "(" ^ loop vs ^ ")"


(* Apply f to each row or a specific column of the results *)
let iter res ~f =
  if size res > Int64.zero then
    let rec loop () =
      match fetch res with
      | Some row -> f row; loop ()
      | None -> ()
    in
    to_row res Int64.zero;
    loop ()

let iter_col res ~key ~f =
  let col = column res ~key in
  iter res ~f:(function row -> f (col ~row))

let iter_cols res ~key ~f =
  let col = column res in
  iter res ~f:(function row -> f (Array.map key ~f:(function key -> col ~key ~row)))

let map res ~f =
  if size res > Int64.zero then
    let rec loop lst = 
      match fetch res with
      | Some row -> loop (f row :: lst)
      | None -> lst
    in
    to_row res Int64.zero;
    List.rev (loop [])
  else
    []

let map_col res ~key ~f =
  let col = column res ~key in
  map res ~f:(function row -> f (col ~row))

let map_cols res ~key ~f =
  let col = column res in
  map res ~f:(function row -> f (Array.map key ~f:(function key -> col ~key ~row)))

module Prepared = struct

type stmt
type stmt_result

external create : dbd -> string -> stmt = "caml_mysql_stmt_prepare"
external execute : stmt -> string array -> stmt_result = "caml_mysql_stmt_execute"
external execute_null : stmt -> string option array -> stmt_result = "caml_mysql_stmt_execute_null"
external affected : stmt -> int64 = "caml_mysql_stmt_affected"
external insert_id : stmt -> int64 = "caml_mysql_stmt_insert_id"
external real_status : stmt -> int = "caml_mysql_stmt_status"
external fetch : stmt_result -> string option array option = "caml_mysql_stmt_fetch"
external result_metadata : stmt -> result = "caml_mysql_stmt_result_metadata"
external close : stmt -> unit = "caml_mysql_stmt_close"

end