|
Module      :  Database.Oracle.OCIFunctions
Copyright   :  (c) 2004 Oleg Kiselyov, Alistair Bayley
License     :  BSD-style
Maintainer  :  oleg@pobox.com, alistair@abayley.org
Stability   :  experimental
Portability :  non-portable

Simple wrappers for OCI functions (FFI).

The functions in this file are simple wrappers for OCI functions.
The wrappers add error detection and exceptions;
functions in this module raise 'OCIException'.
The next layer up traps these and turns them into 'Database.Enumerator.DBException'.

Note that 'OCIException' /does not/ contain the error number and text
returned by 'getOCIErrorMsg'.
It is the job of the next layer (module) up to catch the 'OCIException'
and then call 'getOCIErrorMsg' to get the actual error details.
The 'OCIException' simply contains the error number returned by
the OCI call, and some text identifying the wrapper function.
See 'formatErrorCodeDesc' for the set of possible values for the OCI error numbers.

> {-# OPTIONS -ffi #-}
> {-# OPTIONS -fglasgow-exts #-}


> module Database.Oracle.OCIFunctions where


> import Database.Oracle.OCIConstants
> import Database.Util
> import Foreign
> import Foreign.C
> import Control.Monad
> import Control.Exception
> import Data.Dynamic
> import System.Time
> import Data.Time



|
 * Each handle type has its own data type, to prevent stupid errors
   i.e. using the wrong handle at the wrong time.

 * In GHC you can simply say @data OCIStruct@ i.e. there's no need for @= OCIStruct@.
   I've decided to be more portable, as it doesn't cost much.

 * Use castPtr if you need to convert handles (say 'OCIHandle' to a more specific type, or vice versa).

> data OCIStruct = OCIStruct
> type OCIHandle = Ptr OCIStruct  -- generic Handle for OCI functions that return Handles
> data OCIBuffer = OCIBuffer  -- generic buffer. Could hold anything: value or pointer.
> type BufferPtr = Ptr OCIBuffer
> type BufferFPtr = ForeignPtr OCIBuffer
> type ColumnResultBuffer = ForeignPtr OCIBuffer  -- use ForeignPtr to ensure GC'd
> -- triple of (nullind, buffer, size)
> type BindBuffer = (ForeignPtr CShort, ForeignPtr OCIBuffer, ForeignPtr CUShort)
> data Context = Context
> type ContextPtr = Ptr Context

> data EnvStruct = EnvStruct
> type EnvHandle = Ptr EnvStruct
> data ErrorStruct = ErrorStruct
> type ErrorHandle = Ptr ErrorStruct
> data ServerStruct = ServerStruct
> type ServerHandle = Ptr ServerStruct
> data UserStruct = UserStruct
> type UserHandle = Ptr UserStruct
> data ConnStruct = ConnStruct
> type ConnHandle = Ptr ConnStruct  -- AKA Service Context
> data SessStruct = SessStruct
> type SessHandle = Ptr SessStruct
> data StmtStruct = StmtStruct
> type StmtHandle = Ptr StmtStruct
> data DefnStruct = DefnStruct
> type DefnHandle = Ptr DefnStruct
> data ParamStruct = ParamStruct
> type ParamHandle = Ptr ParamStruct
> data BindStruct = BindStruct
> type BindHandle = Ptr BindStruct
> type ColumnInfo = (DefnHandle, ColumnResultBuffer, ForeignPtr CShort, ForeignPtr CUShort)


|Low-level, OCI library errors.

> data OCIException = OCIException CInt String
>   deriving (Typeable, Show)

If we can't derive Typeable then the following code should do the trick:

 > data OCIException = OCIException CInt String
 > ociExceptionTc :: TyCon
 > ociExceptionTc = mkTyCon "Database.Oracle.OCIFunctions.OCIException"
 > instance Typeable OCIException where typeOf _ = mkAppTy ociExceptionTc []


> catchOCI :: IO a -> (OCIException -> IO a) -> IO a
> catchOCI = catchDyn

> throwOCI :: OCIException -> a
> throwOCI = throwDyn



> mkCInt :: Int -> CInt
> mkCInt n = fromIntegral n

> mkCShort :: CInt -> CShort
> mkCShort n = fromIntegral n

> mkCUShort :: CInt -> CUShort
> mkCUShort n = fromIntegral n

> cStrLen :: CStringLen -> CInt
> cStrLen = mkCInt . snd

> cStr :: CStringLen -> CString
> cStr = fst



---------------------------------------------------------------------------------
-- ** Foreign OCI functions
---------------------------------------------------------------------------------


> foreign import ccall "OCIEnvCreate" ociEnvCreate :: Ptr EnvHandle -> CInt -> Ptr a -> FunPtr a -> FunPtr a -> FunPtr a -> CInt -> Ptr (Ptr a) -> IO CInt
> foreign import ccall "OCIHandleAlloc" ociHandleAlloc :: OCIHandle -> Ptr OCIHandle -> CInt -> CInt -> Ptr a -> IO CInt
> foreign import ccall "oci.h OCIHandleFree" ociHandleFree :: OCIHandle -> CInt -> IO CInt
> foreign import ccall "oci.h OCIErrorGet" ociErrorGet :: OCIHandle -> CInt -> CString -> Ptr CInt -> CString -> CInt -> CInt -> IO CInt


> foreign import ccall "oci.h OCIParamGet" ociParamGet :: OCIHandle -> CInt -> ErrorHandle -> Ptr OCIHandle -> CInt -> IO CInt
> foreign import ccall "oci.h OCIAttrGet" ociAttrGet
>   :: OCIHandle -> CInt -> BufferPtr -> Ptr CInt -> CInt -> ErrorHandle -> IO CInt
> foreign import ccall "oci.h OCIAttrSet" ociAttrSet
>   :: OCIHandle -> CInt -> BufferPtr -> CInt -> CInt -> ErrorHandle -> IO CInt


> foreign import ccall "oci.h OCILogon" ociLogon
>   :: EnvHandle -> ErrorHandle -> Ptr ConnHandle -> CString -> CInt -> CString -> CInt -> CString -> CInt -> IO CInt
> foreign import ccall "oci.h OCILogoff" ociLogoff :: ConnHandle -> ErrorHandle -> IO CInt
> foreign import ccall "oci.h OCISessionBegin" ociSessionBegin :: ConnHandle -> ErrorHandle -> SessHandle -> CInt -> CInt -> IO CInt
> foreign import ccall "oci.h OCISessionEnd" ociSessionEnd :: ConnHandle -> ErrorHandle -> SessHandle -> CInt -> IO CInt
> foreign import ccall "oci.h OCIServerAttach" ociServerAttach :: ServerHandle -> ErrorHandle -> CString -> CInt -> CInt -> IO CInt
> foreign import ccall "oci.h OCIServerDetach" ociServerDetach :: ServerHandle -> ErrorHandle -> CInt -> IO CInt
> foreign import ccall "oci.h OCITerminate" ociTerminate :: CInt -> IO CInt

> foreign import ccall "oci.h OCITransStart" ociTransStart :: ConnHandle -> ErrorHandle -> Word8 -> CInt -> IO CInt
> foreign import ccall "oci.h OCITransCommit" ociTransCommit :: ConnHandle -> ErrorHandle -> CInt -> IO CInt
> foreign import ccall "oci.h OCITransRollback" ociTransRollback :: ConnHandle -> ErrorHandle -> CInt -> IO CInt

> foreign import ccall "oci.h OCIStmtPrepare" ociStmtPrepare :: StmtHandle -> ErrorHandle -> CString -> CInt -> CInt -> CInt -> IO CInt
> foreign import ccall "oci.h OCIDefineByPos" ociDefineByPos
>   :: StmtHandle -> Ptr DefnHandle -> ErrorHandle -> CInt -> BufferPtr -> CInt -> CUShort -> Ptr CShort -> Ptr CUShort -> Ptr CUShort -> CInt -> IO CInt
> foreign import ccall "oci.h OCIStmtExecute" ociStmtExecute :: ConnHandle -> StmtHandle -> ErrorHandle -> CInt -> CInt -> OCIHandle -> OCIHandle -> CInt -> IO CInt
> foreign import ccall "oci.h OCIStmtFetch" ociStmtFetch :: StmtHandle -> ErrorHandle -> CInt -> CShort -> CInt -> IO CInt

stmt, ptr bindHdl, err, pos, valuePtr, sizeOfValue,
datatype, indicatorPtr, lenArrayPtr, retCodeArrayPtr,
plsqlArrayMaxLen, plsqlCurrEltPtr, mode

> foreign import ccall "oci.h OCIBindByPos" ociBindByPos ::
>   StmtHandle -> Ptr BindHandle -> ErrorHandle -> CUInt -> BufferPtr -> CInt
>   -> CUShort -> Ptr CShort -> Ptr CUShort -> Ptr CUShort
>   -> CUInt -> Ptr CUInt -> CUInt -> IO CInt

> foreign import ccall "oci.h OCIBindDynamic" ociBindDynamic ::
>   BindHandle -> ErrorHandle -> ContextPtr -> FunPtr OCICallbackInBind
>   -> ContextPtr -> FunPtr OCICallbackOutBind -> IO CInt

> type OCICallbackInBind = ContextPtr -> BindHandle -> CInt -> CInt
>   -> Ptr BufferPtr -> CInt -> Ptr Word8 -> Ptr CShort -> IO CInt

> type OCICallbackOutBind = ContextPtr -> BindHandle -> CInt -> CInt
>   -> Ptr BufferPtr -> Ptr CInt -> Ptr Word8 -> Ptr CShort -> Ptr (Ptr CShort) -> IO CInt

> foreign import ccall "wrapper" mkOCICallbackInBind ::
>   OCICallbackInBind -> IO (FunPtr OCICallbackInBind)
> foreign import ccall "wrapper" mkOCICallbackOutBind ::
>   OCICallbackOutBind -> IO (FunPtr OCICallbackOutBind)

---------------------------------------------------------------------------------
-- ** OCI error reporting
---------------------------------------------------------------------------------

|This is just an auxiliary function for getOCIErrorMsg.

> getOCIErrorMsg2 :: OCIHandle -> CInt -> Ptr CInt -> CString -> CInt -> IO (CInt, String)
> getOCIErrorMsg2 ocihandle handleType errCodePtr errMsgBuf maxErrMsgLen = do
>   rc <- ociErrorGet ocihandle 1 nullPtr errCodePtr errMsgBuf maxErrMsgLen handleType
>   if rc < 0
>     then return (0, "Error message not available.")
>     else do
>       msg <- peekCString errMsgBuf
>       e <- peek errCodePtr
>       return (e, msg)


> getOCIErrorMsg :: OCIHandle -> CInt -> IO (CInt, String)
> getOCIErrorMsg ocihandle handleType = do
>   let stringBufferLen = 1000
>   allocaBytes stringBufferLen $ \errMsg ->
>     alloca $ \errCode ->
>     getOCIErrorMsg2 ocihandle handleType errCode errMsg (mkCInt stringBufferLen)

> fromEnumOCIErrorCode :: CInt -> String
> fromEnumOCIErrorCode err
>   | err == oci_SUCCESS = "OCI_SUCCESS"
>   | err == oci_SUCCESS_WITH_INFO = "OCI_SUCCESS_WITH_INFO"
>   | err == oci_NEED_DATA = "OCI_NEED_DATA"
>   | err == oci_NO_DATA = "OCI_NO_DATA"
>   | err == oci_INVALID_HANDLE = "OCI_INVALID_HANDLE"
>   | err == oci_STILL_EXECUTING = "OCI_STILL_EXECUTING"
>   | err == oci_CONTINUE = "OCI_CONTINUE"
>   | err == oci_RESERVED_FOR_INT_USE = "OCI_RESERVED_FOR_INT_USE"
>   | otherwise = "OCI_ERROR"

> formatErrorCodeDesc :: CInt -> String -> String
> formatErrorCodeDesc err desc
>   | err == oci_ERROR = ""
>   | otherwise = (fromEnumOCIErrorCode err) ++ " - " ++ desc


|Given the two parts of an 'OCIException' (the error number and text)
get the actual error message from the DBMS and construct an error message
from all of these pieces.

> formatOCIMsg :: CInt -> String -> OCIHandle -> CInt -> IO (Int, String)
> formatOCIMsg e m ocihandle handleType = do
>   (err, msg) <- getOCIErrorMsg ocihandle handleType
>   --return (fromIntegral err, (formatErrorCodeDesc e m) ++ " : " ++ (show err) ++ " - " ++ msg)
>   if msg == ""
>     then return (fromIntegral err, (formatErrorCodeDesc e m))
>     else return (fromIntegral err, (formatErrorCodeDesc e m) ++ " : " ++ msg)



|We have two format functions: 'formatEnvMsg' takes the 'EnvHandle',
'formatErrorMsg' takes the 'ErrorHandle'.
They're just type-safe wrappers for 'formatMsgCommon'.

> formatMsgCommon :: OCIException -> OCIHandle -> CInt -> IO (Int, String)
> formatMsgCommon (OCIException e m) h handleType = do
>   if e == 0
>     then return (0, "")
>     else case () of
>       _ | e == oci_ERROR -> do (formatOCIMsg e m h handleType)
>         | e == oci_SUCCESS_WITH_INFO -> do (formatOCIMsg e m h handleType)
>         | otherwise -> return (fromIntegral e, formatErrorCodeDesc e m)

> formatErrorMsg :: OCIException -> ErrorHandle -> IO (Int, String)
> formatErrorMsg exc err = formatMsgCommon exc (castPtr err) oci_HTYPE_ERROR

> formatEnvMsg :: OCIException -> EnvHandle -> IO (Int, String)
> formatEnvMsg exc err = formatMsgCommon exc (castPtr err) oci_HTYPE_ENV



|The testForError functions are the only places where OCIException is thrown,
so if you want to change or embellish it, your changes will be localised here.
These functions factor out common error handling code
from the OCI wrapper functions that follow.

Typically an OCI wrapper function would look like:

 > handleAlloc handleType env = alloca ptr -> do
 >   rc <- ociHandleAlloc env ptr handleType 0 nullPtr
 >   if rc < 0
 >     then throwOCI (OCIException rc msg)
 >     else return ()

where the code from @if rc < 0@ onwards was identical.
'testForError' replaces the code from @if rc < 0 ...@ onwards.

> testForError :: CInt -> String -> a -> IO a
> testForError rc msg retval = do
>   if rc < 0
>     then throwOCI (OCIException rc msg)
>     else return retval


|Like 'testForError' but when the value you want to return
is at the end of a pointer.
Either there was an error, in which case the pointer probably isn't valid,
or there is something at the end of the pointer to return.
See 'dbLogon' and 'getHandleAttr' for example usage.

> testForErrorWithPtr :: Storable a => CInt -> String -> Ptr a -> IO a
> testForErrorWithPtr rc msg retval = do
>   if rc < 0
>     then throwOCI (OCIException rc msg)
>     else peek retval


---------------------------------------------------------------------------------
-- ** Allocating Handles (i.e. creating OCI data structures, and memory management)
---------------------------------------------------------------------------------


> envCreate :: IO EnvHandle
> envCreate = alloca $ \ptr -> do
>   rc <- ociEnvCreate ptr oci_DEFAULT nullPtr nullFunPtr nullFunPtr nullFunPtr 0 nullPtr
>   testForErrorWithPtr rc "allocate initial end" ptr

> handleAlloc :: CInt -> OCIHandle -> IO OCIHandle
> handleAlloc handleType env = alloca $ \ptr -> do
>   rc <- ociHandleAlloc env ptr handleType 0 nullPtr
>   testForErrorWithPtr rc "allocate handle" ptr

> handleFree :: CInt -> OCIHandle -> IO ()
> handleFree handleType ptr = do
>    rc <- ociHandleFree ptr handleType
>    testForError rc "free handle" ()



> setHandleAttr :: ErrorHandle -> OCIHandle -> CInt -> Ptr a -> CInt -> IO ()
> setHandleAttr err ocihandle handleType handleAttr attrType = do
>   rc <- ociAttrSet ocihandle handleType (castPtr handleAttr) 0 attrType err
>   testForError rc "setHandleAttr" ()


> setHandleAttrString :: ErrorHandle -> OCIHandle -> CInt -> String -> CInt -> IO ()
> setHandleAttrString err ocihandle handleType s attrType = do
>   withCStringLen s $ \sC -> do
>     rc <- ociAttrSet ocihandle handleType (castPtr (cStr sC)) (cStrLen sC) attrType err
>     testForError rc "setHandleAttrString" ()


ociAttrGet returns a pointer to something - maybe a handle or a chunk of memory.
Sometimes it's a pointer to a Handle, i.e. a Ptr to a Ptr to a Struct,
so we want to peek it to get the Handle.
Other times it's a pointer to (say) a few bytes which might contain a number or a string.
Deref'ing it returns that value immediately, rather than a Ptr to that value.

> getHandleAttr :: (Storable a) => ErrorHandle -> OCIHandle -> CInt -> CInt -> IO a
> getHandleAttr err ocihandle handleType attrType = alloca $ \ptr -> do
>   -- 3rd arg has type Ptr OCIBuffer.
>   rc <- ociAttrGet ocihandle handleType (castPtr ptr) nullPtr attrType err
>   testForErrorWithPtr rc "getAttrHandle" ptr

> getParam :: ErrorHandle -> StmtHandle -> Int -> IO ParamHandle
> getParam err stmt posn = alloca $ \ptr -> do
>   rc <- ociParamGet (castPtr stmt) oci_HTYPE_STMT err ptr (mkCInt posn)
>   testForErrorWithPtr rc "getParam" (castPtr ptr)


---------------------------------------------------------------------------------
-- ** Connecting and detaching
---------------------------------------------------------------------------------

|The OCI Logon function doesn't behave as you'd expect when the password is due to expire.
'ociLogon' returns 'Database.Oracle.OCIConstants.oci_SUCCESS_WITH_INFO',
but the 'ConnHandle' returned is not valid.
In this case we have to change 'Database.Oracle.OCIConstants.oci_SUCCESS_WITH_INFO'
to 'Database.Oracle.OCIConstants.oci_ERROR',
so that the error handling code will catch it and abort. 
I don't know why the handle returned isn't valid,
as the logon process should be able to complete successfully in this case.


> dbLogon :: String -> String -> String -> EnvHandle -> ErrorHandle -> IO ConnHandle
> dbLogon user pswd db env err =
>   withCStringLen user $ \userC ->
>   withCStringLen pswd $ \pswdC ->
>   withCStringLen db   $ \dbC ->
>   alloca $ \conn -> do
>     rc <- ociLogon env err conn (cStr userC) (cStrLen userC) (cStr pswdC) (cStrLen pswdC) (cStr dbC) (cStrLen dbC)
>     case () of
>       _ | rc == oci_SUCCESS_WITH_INFO -> testForErrorWithPtr oci_ERROR "logon" conn
>         | otherwise -> testForErrorWithPtr rc "logon" conn


> dbLogoff :: ErrorHandle -> ConnHandle -> IO ()
> dbLogoff err conn = do
>   rc <- ociLogoff conn err
>   testForError rc "logoff" ()


> terminate :: IO ()
> terminate = do
>   rc <- ociTerminate oci_DEFAULT
>   testForError rc "terminate" ()



> serverDetach :: ErrorHandle -> ServerHandle -> IO ()
> serverDetach err server = do
>   rc <- ociServerDetach server err oci_DEFAULT
>   testForError rc "server detach" ()


> serverAttach :: ErrorHandle -> ServerHandle -> String -> IO ()
> serverAttach err server dblink = do
>   withCStringLen dblink $ \s -> do
>     rc <- ociServerAttach server err (cStr s) (cStrLen s) oci_DEFAULT
>     testForError rc "server attach" ()


|Having established a connection (Service Context), now get the Session.
You can have more than one session per connection,
but I haven't implemented it yet.

> getSession :: ErrorHandle -> ConnHandle -> IO SessHandle
> getSession err conn = liftM castPtr (getHandleAttr err (castPtr conn) oci_HTYPE_SVCCTX oci_ATTR_SESSION)


> sessionBegin :: ErrorHandle -> ConnHandle -> SessHandle -> CInt -> IO ()
> sessionBegin err conn sess cred = do
>   rc <- ociSessionBegin conn err sess cred oci_DEFAULT
>   testForError rc "session begin" ()


> sessionEnd :: ErrorHandle -> ConnHandle -> SessHandle -> IO ()
> sessionEnd err conn sess = do
>   rc <- ociSessionEnd conn err sess oci_DEFAULT
>   testForError rc "session end" ()



---------------------------------------------------------------------------------
-- ** Transactions
---------------------------------------------------------------------------------

> beginTrans :: ErrorHandle -> ConnHandle -> CInt -> IO ()
> beginTrans err conn isolation = do
>   rc <- ociTransStart conn err 0 isolation
>   testForError rc "begin transaction" ()

> commitTrans :: ErrorHandle -> ConnHandle -> IO ()
> commitTrans err conn = do
>   rc <- ociTransCommit conn err oci_DEFAULT
>   testForError rc "commit" ()

> rollbackTrans :: ErrorHandle -> ConnHandle -> IO ()
> rollbackTrans err conn = do
>   rc <- ociTransRollback conn err oci_DEFAULT
>   testForError rc "rollback" ()


---------------------------------------------------------------------------------
-- ** Issuing queries
---------------------------------------------------------------------------------

|With the OCI you do queries with these steps:

 * prepare your statement (it's just a String) - no communication with DBMS

 * execute it (this sends it to the DBMS for parsing etc)

 * allocate result set buffers by calling 'defineByPos' for each column

 * call fetch for each row.

 * call 'handleFree' for the 'StmtHandle'
   (I assume this is the approved way of terminating the query;
   the OCI docs aren't explicit about this.)


> stmtPrepare :: ErrorHandle -> StmtHandle -> String -> IO ()
> stmtPrepare err stmt sqltext = do
>   withCStringLen sqltext $ \sqltextC -> do
>     rc <- ociStmtPrepare stmt err (cStr sqltextC) (cStrLen sqltextC) oci_NTV_SYNTAX oci_DEFAULT
>     testForError rc "stmtPrepare" ()


> stmtExecute :: ErrorHandle -> ConnHandle -> StmtHandle -> Int -> IO ()
> stmtExecute err conn stmt iterations = do
>   rc <- ociStmtExecute conn stmt err (mkCInt iterations) 0 nullPtr nullPtr oci_DEFAULT
>   testForError rc "stmtExecute" ()



|defineByPos allocates memory for a single column value.
The allocated components are:

 * the result (i.e. value) - you have to say how big with bufsize.

 * the null indicator (int16)

 * the size of the returned data (int16)

Previously it was the caller's responsibility to free the memory after they're done with it.
Now we use 'Foreign.ForeignPtr.mallocForeignPtr', so manual memory management is hopefully
a thing of the past.
The caller will also have to cast the data in bufferptr to the expected type
(using 'Foreign.Ptr.castPtr').


> defineByPos :: ErrorHandle
>   -> StmtHandle
>   -> Int   -- ^ Position
>   -> Int   -- ^ Buffer size in bytes
>   -> CInt  -- ^ SQL Datatype (from "Database.Oracle.OCIConstants")
>   -> IO ColumnInfo  -- ^ tuple: (DefnHandle, Ptr to buffer, Ptr to null indicator, Ptr to size of value in buffer)
> defineByPos err stmt posn bufsize sqldatatype = do
>   bufferFPtr <- mallocForeignPtrBytes bufsize
>   nullIndFPtr <- mallocForeignPtr
>   retSizeFPtr <- mallocForeignPtr
>   alloca $ \defnPtr ->
>     withForeignPtr bufferFPtr $ \bufferPtr ->
>     withForeignPtr nullIndFPtr $ \nullIndPtr ->
>     withForeignPtr retSizeFPtr $ \retSizePtr -> do
>     rc <- ociDefineByPos stmt defnPtr err (mkCInt posn) bufferPtr (mkCInt bufsize) (mkCUShort sqldatatype) nullIndPtr retSizePtr nullPtr oci_DEFAULT
>     defn <- peek defnPtr  -- no need for caller to free defn; I think freeing the stmt handle does it.
>     testForError rc "defineByPos" (defn, bufferFPtr, nullIndFPtr, retSizeFPtr)


|Oracle only understands bind variable placeholders using syntax :x,
where x is a number or a variable name.
Most other DBMS's use ? as a placeholder,
so we have this function to substitute ? with :n,
where n starts at one and increases with each ?.

We don't use this function into this library though;
it's used in the higher-level implementation of Enumerator.
We prefer to retain flexibility at this lower-level,
and not force arbitrary implementation choices too soon.
If you want to use this library and use :x style syntax, you can.

> substituteBindPlaceHolders sql =
>   sbph sql 1 False ""

> sbph :: String -> Int -> Bool -> String -> String
> sbph [] _ _ acc = reverse acc
> sbph ('\'':cs) i inQuote acc = sbph cs i (not inQuote) ('\'':acc)
> sbph ('?':cs) i False acc = sbph cs (i+1) False ((reverse (show i)) ++ (':':acc))
> sbph (c:cs) i inQuote acc = sbph cs i inQuote (c:acc)



> bindByPos ::
>   ErrorHandle
>   -> StmtHandle
>   -> Int   -- ^ Position
>   -> CShort   -- ^ Null ind: 0 == not null, -1 == null
>   -> BufferPtr  -- ^ payload
>   -> Int   -- ^ payload size in bytes
>   -> CInt  -- ^ SQL Datatype (from "Database.Oracle.OCIConstants")
>   -> IO ()
> bindByPos err stmt pos nullInd bufptr sze sqltype = do
>   indFPtr <- mallocForeignPtr
>   sizeFPtr <- mallocForeignPtr
>   withForeignPtr indFPtr $ \p -> poke p nullInd
>   -- You can't put any old junk in the return-size field,
>   -- even if the parameter is IN-only.
>   -- So tell it how big the input buffer is.
>   withForeignPtr sizeFPtr $ \p -> poke p (fromIntegral sze)
>   bufFPtr <- newForeignPtr_ bufptr
>   bindOutputByPos err stmt pos (indFPtr, bufFPtr, sizeFPtr) sze sqltype
>   return ()

Note that this function takes a ForeignPtr to the output-size
(in the triple) and also a size parameter, which is the input size.
We need to provide both, apparently, regardless of actual parameter
direction.

> bindOutputByPos ::
>   ErrorHandle
>   -> StmtHandle
>   -> Int   -- ^ Position
>   -> BindBuffer  -- ^ triple of (null-ind, payload, output-size)
>   -> Int   -- ^ payload input size in bytes
>   -> CInt  -- ^ SQL Datatype (from "Database.Oracle.OCIConstants")
>   -> IO BindHandle
> bindOutputByPos err stmt pos (nullIndFPtr, bufFPtr, sizeFPtr) sze sqltype =
>   alloca $ \bindHdl ->
>   withForeignPtr nullIndFPtr $ \indPtr -> do
>   withForeignPtr sizeFPtr $ \sizePtr -> do
>   withForeignPtr bufFPtr $ \bufPtr -> do
>     rc <- ociBindByPos stmt bindHdl err (fromIntegral pos) bufPtr
>             (fromIntegral sze) (fromIntegral sqltype)
>             indPtr sizePtr nullPtr 0 nullPtr (fromIntegral oci_DEFAULT)
>     testForError rc "bindOutputByPos" ()
>     bptr <- peek bindHdl
>     return bptr


| Fetch a single row into the buffers.
If you have specified a prefetch count > 1 then the row
might already be cached by the OCI library.

> stmtFetch :: ErrorHandle -> StmtHandle -> IO CInt
> stmtFetch err stmt = do
>   let numRowsToFetch = 1
>   rc <- ociStmtFetch stmt err numRowsToFetch (mkCShort oci_FETCH_NEXT) oci_DEFAULT
>   if rc == oci_NO_DATA
>     then return rc
>     else testForError rc "stmtFetch" rc

From the "Bindind and Defining" chapter in the OCI docs:

Binding RETURNING...INTO variables

An OCI application implements the placeholders in the RETURNING clause
as pure OUT bind variables. However, all binds in the RETURNING clause
are initially IN and must be properly initialized.
To provide a valid value, you can provide a NULL indicator
and set that indicator to -1 (NULL).

An application must adhere to the following rules when working with
bind variables in a RETURNING clause:

   1. Bind RETURNING clause placeholders in OCI_DATA_AT_EXEC mode using
      OCIBindByName() or OCIBindByPos(), followed by a call to
      OCIBindDynamic() for each placeholder.

      Note: The OCI only supports the callback mechanism for
      RETURNING clause binds. The polling mechanism is not supported.

   2. When binding RETURNING clause placeholders, you must supply a valid out
      bind function as the ocbfp parameter of the OCIBindDynamic() call.
      This function must provide storage to hold the returned data.

   3. The icbfp parameter of OCIBindDynamic() call should provide a
      "dummy" function which returns NULL values when called.

   4. The piecep parameter of OCIBindDynamic() must be set to OCI_ONE_PIECE.

   5. No duplicate binds are allowed in a DML statement with a
      RETURNING clause, such as no duplication between bind variables
      in the DML section and the RETURNING section of the statement.

|Short-circuit null test: if the buffer contains a null then return Nothing.
Otherwise, run the IO action to extract a value from the buffer and return Just it.

> maybeBufferNull :: ForeignPtr CShort -> Maybe a -> IO a -> IO (Maybe a)
> maybeBufferNull nullIndFPtr nullVal action =
>   withForeignPtr nullIndFPtr $ \nullIndPtr -> do
>     nullInd <- liftM cShort2Int (peek nullIndPtr)
>     if (nullInd == -1)  -- -1 == null, 0 == value
>       then return nullVal
>       else do
>         v <- action
>         return (Just v)


> nullByte :: CChar
> nullByte = 0

> cShort2Int :: CShort -> Int
> cShort2Int n = fromIntegral n

> cUShort2Int :: CUShort -> Int
> cUShort2Int n = fromIntegral n

> cuCharToInt :: CUChar -> Int
> cuCharToInt c = fromIntegral c

> byteToInt :: Ptr CUChar -> Int -> IO Int
> byteToInt buffer n = do
>   b <- peekByteOff buffer n
>   return (cuCharToInt b)


> bufferToString :: ColumnInfo -> IO (Maybe String)
> bufferToString (_, bufFPtr, nullFPtr, sizeFPtr) =
>   withForeignPtr nullFPtr $ \nullIndPtr -> do
>     nullInd <- liftM cShort2Int (peek nullIndPtr)
>     if (nullInd == -1)  -- -1 == null, 0 == value
>       then return Nothing
>       else do
>         -- Given a column buffer, extract a string of variable length
>         -- (you have to terminate it yourself).
>         withForeignPtr bufFPtr $ \bufferPtr ->
>           withForeignPtr sizeFPtr $ \retSizePtr -> do
>             retsize <- liftM cUShort2Int (peek retSizePtr)
>             pokeByteOff (castPtr bufferPtr) retsize nullByte
>             val <- peekCString (castPtr bufferPtr)
>             return (Just val)


| Oracle's excess-something-or-other encoding for years:
year = 100*(c - 100) + (y - 100),
c = (year div 100) + 100,
y = (year mod 100) + 100.

+1999 -> 119, 199
+0100 -> 101, 100
+0001 -> 100, 101
-0001 -> 100,  99
-0100 ->  99, 100
-1999 ->  81,   1

> makeYear :: Int -> Int -> Int
> makeYear c100 y100 = 100 * (c100 - 100) + (y100 - 100)

> makeYearByte :: Int -> Word8
> makeYearByte y = fromIntegral ((rem y 100) + 100)

> makeCentByte :: Int -> Word8
> makeCentByte y = fromIntegral ((quot y 100) + 100)

> dumpBuffer :: Ptr Word8 -> IO ()
> dumpBuffer buf = do
>   dumpByte 0
>   dumpByte 1
>   dumpByte 2
>   dumpByte 3
>   dumpByte 4
>   dumpByte 5
>   dumpByte 6
>   putStrLn ""
>   where
>   dumpByte n = do
>     b <- (peekByteOff buf n :: IO Word8)
>     putStr $ (show b) ++ " "


> bufferToCaltime :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe CalendarTime)
> bufferToCaltime nullind fptr = maybeBufferNull nullind Nothing $
>   withForeignPtr fptr $ \bufferPtr -> do
>     let buffer = castPtr bufferPtr
>     --dumpBuffer (castPtr buffer)
>     century100 <- byteToInt buffer 0
>     year100 <- byteToInt buffer 1
>     month <- byteToInt buffer 2
>     day <- byteToInt buffer 3
>     hour <- byteToInt buffer 4
>     minute <- byteToInt buffer 5
>     second <- byteToInt buffer 6
>     return $ CalendarTime
>       { ctYear = makeYear century100 year100
>       , ctMonth = toEnum (month - 1)
>       , ctDay = day
>       , ctHour = hour - 1
>       , ctMin = minute - 1
>       , ctSec = second - 1
>       , ctPicosec = 0
>       , ctWDay = Sunday
>       , ctYDay = -1
>       , ctTZName = "UTC"
>       , ctTZ = 0
>       , ctIsDST = False
>       }

> bufferToUTCTime :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe UTCTime)
> bufferToUTCTime nullind fptr = maybeBufferNull nullind Nothing $
>   withForeignPtr fptr $ \bufferPtr -> do
>     let buffer = castPtr bufferPtr
>     --dumpBuffer (castPtr buffer)
>     century100 <- byteToInt buffer 0
>     year100 <- byteToInt buffer 1
>     month <- byteToInt buffer 2
>     day <- byteToInt buffer 3
>     hour <- byteToInt buffer 4
>     minute <- byteToInt buffer 5
>     second <- byteToInt buffer 6
>     let year = makeYear century100 year100
>     return (mkUTCTime year month day (hour-1) (minute-1) (second-1))

> setBufferByte :: BufferPtr -> Int -> Word8 -> IO ()
> setBufferByte buf n v = pokeByteOff buf n v

> calTimeToBuffer :: BufferPtr -> CalendarTime -> IO ()
> calTimeToBuffer buf ct = do
>   setBufferByte buf 0 (makeCentByte (ctYear ct))
>   setBufferByte buf 1 (makeYearByte (ctYear ct))
>   setBufferByte buf 2 (fromIntegral ((fromEnum (ctMonth ct)) + 1))
>   setBufferByte buf 3 (fromIntegral (ctDay ct))
>   setBufferByte buf 4 (fromIntegral (ctHour ct + 1))
>   setBufferByte buf 5 (fromIntegral (ctMin ct + 1))
>   setBufferByte buf 6 (fromIntegral (ctSec ct + 1))

> utcTimeToBuffer :: BufferPtr -> UTCTime -> IO ()
> utcTimeToBuffer buf utc = do
>   let (LocalTime ltday time) = utcToLocalTime (hoursToTimeZone 0) utc
>   let (TimeOfDay hour minute second) = time
>   let (year, month, day) = toGregorian ltday
>   setBufferByte buf 0 (makeCentByte (fromIntegral year))
>   setBufferByte buf 1 (makeYearByte (fromIntegral year))
>   setBufferByte buf 2 (fromIntegral month)
>   setBufferByte buf 3 (fromIntegral day)
>   setBufferByte buf 4 (fromIntegral (hour+1))
>   setBufferByte buf 5 (fromIntegral (minute+1))
>   setBufferByte buf 6 (round (second+1))


> bufferPeekValue :: (Storable a) => BufferFPtr -> IO a
> bufferPeekValue buffer = do
>   v <- withForeignPtr buffer $ \bufferPtr -> peek $ castPtr bufferPtr
>   return v

> bufferToA :: (Storable a) => ForeignPtr CShort -> BufferFPtr -> IO (Maybe a)
> bufferToA nullind buffer = maybeBufferNull nullind Nothing (bufferPeekValue buffer)

> bufferToCInt :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe CInt)
> bufferToCInt = bufferToA

> bufferToInt :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe Int)
> bufferToInt nullind b = do
>   cint <- bufferToCInt nullind b
>   return $ maybe Nothing (Just . fromIntegral) cint

> bufferToCDouble :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe CDouble)
> bufferToCDouble = bufferToA

> bufferToDouble :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe Double)
> bufferToDouble nullind b = do
>   cdbl <- bufferToCDouble nullind b
>   return $ maybe Nothing (Just . realToFrac) cdbl

> bufferToStmtHandle :: BufferFPtr -> IO StmtHandle
> bufferToStmtHandle buffer = do
>   withForeignPtr buffer $ \bufferPtr -> do
>     v <- peek (castPtr bufferPtr)
>     return v