Source file ct.ml

(*
  This file is part of ocaml-freetds - An OCaml binding to the FreeTDS library
  Copyright (C) 2004 Kenneth Knowles

  ocaml-freetds 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.

  ocaml-freetds 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 ocaml-freetds; if not, write to the Free Software
  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
*)

open Printf

(** A wrapper on the FreeTDS library for accessing Sybase and Microsoft database providers *)

type location =
        [
        | `Server
        | `Client
        ]


type severity =
        [
        | `Inform
        | `Api_fail
        | `Retry_fail
        | `Resource_fail
        | `Config_fail
        | `Comm_fail
        | `Internal_fail
        | `Fatal
        ]

(* This is the catch-all exception that client code should trap *)
exception End_results
exception End_data
exception Cancelled
exception Cmd_fail

(** And this is for me to let you know I didn't wrap every datatype :-) *)
exception Datatype_not_implemented

type context
type connection
type command

type binding_buffer

type prop_action = [ `Get | `Set | `Clear ]

type string_property = [ `Username | `Password | `Appname ]

type cmd_type = [ `Lang | `Rpc ]

type cmd_option = [ `Recompile | `NoRecompile ]

type result_type = [ `Row | `Param | `Status | `Cmd_done | `Cmd_succeed | `Cmd_fail ]
type resinfo_type = [ `Row_count | `Cmd_number | `Numdata ]

type datetime = {
    days : int;
    minutes : int;
    three_hundredths : int;
}

type locale = {
    language : string;
    charset : string;
    time : string;
    collate : string;
}

type status = [ `CanBeNull | `NoData | `Identity | `Return ]

type column = {
    col_name : string;
    col_status : status list;
    col_buffer : binding_buffer
}

type sql_t =
        [
        | `Bit of bool
        | `Tinyint of int
        | `Smallint of int
        | `Int of int32
        | `Text of string
        | `String of string
        | `Binary of string

        (* 64 bits *)
        | `Float of float

        (* These are the types I didn't want to even try to convert, so I let the DB convert them
           to strings for me *)

        (* Contains DATETIME and DATETIME4 *)
        | `Datetime of string

        (* Contains DECIMAL, MONEY, NUMERIC, etc *)
        | `Decimal of string

        | `Null
        ]

let _ =
    List.iter (fun (x,y) -> Callback.register_exception x y)
        [
            "cs_end_results", End_results;
            "cs_end_data", End_data;
            "cs_cancelled", Cancelled;
            "cs_cmd_fail", Cmd_fail;
            "cs_not_implemented", Datatype_not_implemented;
        ]
;;

(* Public interface, with unused parameters omitted. *)

(* This wraps both ctx_alloc and ct_init *)
external ctx_create : unit -> context = "mltds_cs_ctx_create"

(* Conections *)
external con_alloc : context -> connection = "mltds_ct_con_alloc"

(* This is a type-safer wrapper around ct_con_prop *)
external con_setstring : connection -> string_property -> string -> unit = "mltds_ct_con_setstring"
external connect : connection -> string -> unit = "mltds_ct_connect"

(* Commands *)
external cmd_alloc : connection -> command = "mltds_ct_cmd_alloc"
external command : command -> cmd_type -> ?option:cmd_option -> string -> unit = "mltds_ct_command"
external send : command -> unit = "mltds_ct_send"

(* Results *)
external results : command -> result_type = "mltds_ct_results"
external res_info : command -> resinfo_type -> int = "mltds_ct_res_info"
external fetch : command -> int = "mltds_ct_fetch"

(* Bind returns a binding buffer *)
external buffer_contents : binding_buffer -> sql_t = "mltds_buffer_contents"

(* A level of indirection to save me some C *)
external bind_col : command -> maxlen:int -> int -> column = "mltds_ct_bind"
let bind comm ?(maxlen = 256) index = bind_col comm maxlen index

(* Closing of connections *)
external close_con : connection -> bool -> unit = "mltds_ct_close"
let close ?(force = false) conn = close_con conn force

(* Error handling - but ct_diag not yet implemented *)
external get_messages : connection -> location list -> (severity * string) list
    = "mltds_get_messages"

(* Other deallocation is done by the GC *)