Copyright | (c) 2004 Oleg Kiselyov, Alistair Bayley |
---|---|
License | BSD-style |
Maintainer | [email protected], [email protected] |
Stability | experimental |
Portability | non-portable |
Safe Haskell | Safe |
Language | Haskell2010 |
Database.Oracle.OCIFunctions
Description
- data OCIStruct = OCIStruct
- type OCIHandle = Ptr OCIStruct
- data OCIBuffer = OCIBuffer
- type BufferPtr = Ptr OCIBuffer
- type BufferFPtr = ForeignPtr OCIBuffer
- type ColumnResultBuffer = ForeignPtr OCIBuffer
- 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
- 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)
- data OCIException = OCIException CInt String
- catchOCI :: IO a -> (OCIException -> IO a) -> IO a
- throwOCI :: OCIException -> a
- mkCInt :: Int -> CInt
- mkCShort :: CInt -> CShort
- mkCUShort :: CInt -> CUShort
- cStrLen :: CStringLen -> CInt
- cStr :: CStringLen -> CString
- ociEnvCreate :: Ptr EnvHandle -> CInt -> Ptr a -> FunPtr a -> FunPtr a -> FunPtr a -> CInt -> Ptr (Ptr a) -> IO CInt
- ociHandleAlloc :: OCIHandle -> Ptr OCIHandle -> CInt -> CInt -> Ptr a -> IO CInt
- ociHandleFree :: OCIHandle -> CInt -> IO CInt
- ociErrorGet :: OCIHandle -> CInt -> CString -> Ptr CInt -> CString -> CInt -> CInt -> IO CInt
- ociParamGet :: OCIHandle -> CInt -> ErrorHandle -> Ptr OCIHandle -> CInt -> IO CInt
- ociAttrGet :: OCIHandle -> CInt -> BufferPtr -> Ptr CInt -> CInt -> ErrorHandle -> IO CInt
- ociAttrSet :: OCIHandle -> CInt -> BufferPtr -> CInt -> CInt -> ErrorHandle -> IO CInt
- ociLogon :: EnvHandle -> ErrorHandle -> Ptr ConnHandle -> CString -> CInt -> CString -> CInt -> CString -> CInt -> IO CInt
- ociLogoff :: ConnHandle -> ErrorHandle -> IO CInt
- ociSessionBegin :: ConnHandle -> ErrorHandle -> SessHandle -> CInt -> CInt -> IO CInt
- ociSessionEnd :: ConnHandle -> ErrorHandle -> SessHandle -> CInt -> IO CInt
- ociServerAttach :: ServerHandle -> ErrorHandle -> CString -> CInt -> CInt -> IO CInt
- ociServerDetach :: ServerHandle -> ErrorHandle -> CInt -> IO CInt
- ociTerminate :: CInt -> IO CInt
- ociTransStart :: ConnHandle -> ErrorHandle -> Word8 -> CInt -> IO CInt
- ociTransCommit :: ConnHandle -> ErrorHandle -> CInt -> IO CInt
- ociTransRollback :: ConnHandle -> ErrorHandle -> CInt -> IO CInt
- ociStmtPrepare :: StmtHandle -> ErrorHandle -> CString -> CInt -> CInt -> CInt -> IO CInt
- ociDefineByPos :: StmtHandle -> Ptr DefnHandle -> ErrorHandle -> CInt -> BufferPtr -> CInt -> CUShort -> Ptr CShort -> Ptr CUShort -> Ptr CUShort -> CInt -> IO CInt
- ociStmtExecute :: ConnHandle -> StmtHandle -> ErrorHandle -> CInt -> CInt -> OCIHandle -> OCIHandle -> CInt -> IO CInt
- ociStmtFetch :: StmtHandle -> ErrorHandle -> CInt -> CShort -> CInt -> IO CInt
- ociBindByPos :: StmtHandle -> Ptr BindHandle -> ErrorHandle -> CUInt -> BufferPtr -> CInt -> CUShort -> Ptr CShort -> Ptr CUShort -> Ptr CUShort -> CUInt -> Ptr CUInt -> CUInt -> IO CInt
- 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
- mkOCICallbackInBind :: OCICallbackInBind -> IO (FunPtr OCICallbackInBind)
- mkOCICallbackOutBind :: OCICallbackOutBind -> IO (FunPtr OCICallbackOutBind)
- getOCIErrorMsg2 :: OCIHandle -> CInt -> Ptr CInt -> CString -> CInt -> IO (CInt, String)
- getOCIErrorMsg :: OCIHandle -> CInt -> IO (CInt, String)
- fromEnumOCIErrorCode :: CInt -> String
- formatErrorCodeDesc :: CInt -> String -> String
- formatOCIMsg :: CInt -> String -> OCIHandle -> CInt -> IO (Int, String)
- formatMsgCommon :: OCIException -> OCIHandle -> CInt -> IO (Int, String)
- formatErrorMsg :: OCIException -> ErrorHandle -> IO (Int, String)
- formatEnvMsg :: OCIException -> EnvHandle -> IO (Int, String)
- testForError :: CInt -> String -> a -> IO a
- testForErrorWithPtr :: Storable a => CInt -> String -> Ptr a -> IO a
- envCreate :: IO EnvHandle
- handleAlloc :: CInt -> OCIHandle -> IO OCIHandle
- handleFree :: CInt -> OCIHandle -> IO ()
- setHandleAttr :: ErrorHandle -> OCIHandle -> CInt -> Ptr a -> CInt -> IO ()
- setHandleAttrString :: ErrorHandle -> OCIHandle -> CInt -> String -> CInt -> IO ()
- getHandleAttr :: Storable a => ErrorHandle -> OCIHandle -> CInt -> CInt -> IO a
- getParam :: ErrorHandle -> StmtHandle -> Int -> IO ParamHandle
- dbLogon :: String -> String -> String -> EnvHandle -> ErrorHandle -> IO ConnHandle
- dbLogoff :: ErrorHandle -> ConnHandle -> IO ()
- terminate :: IO ()
- serverDetach :: ErrorHandle -> ServerHandle -> IO ()
- serverAttach :: ErrorHandle -> ServerHandle -> String -> IO ()
- getSession :: ErrorHandle -> ConnHandle -> IO SessHandle
- sessionBegin :: ErrorHandle -> ConnHandle -> SessHandle -> CInt -> IO ()
- sessionEnd :: ErrorHandle -> ConnHandle -> SessHandle -> IO ()
- beginTrans :: ErrorHandle -> ConnHandle -> CInt -> IO ()
- commitTrans :: ErrorHandle -> ConnHandle -> IO ()
- rollbackTrans :: ErrorHandle -> ConnHandle -> IO ()
- stmtPrepare :: ErrorHandle -> StmtHandle -> String -> IO ()
- stmtExecute :: ErrorHandle -> ConnHandle -> StmtHandle -> Int -> IO ()
- defineByPos :: ErrorHandle -> StmtHandle -> Int -> Int -> CInt -> IO ColumnInfo
- substituteBindPlaceHolders :: String -> String
- sbph :: String -> Int -> Bool -> String -> String
- bindByPos :: ErrorHandle -> StmtHandle -> Int -> CShort -> BufferPtr -> Int -> CInt -> IO ()
- bindOutputByPos :: ErrorHandle -> StmtHandle -> Int -> BindBuffer -> Int -> CInt -> IO BindHandle
- stmtFetch :: ErrorHandle -> StmtHandle -> IO CInt
- maybeBufferNull :: ForeignPtr CShort -> Maybe a -> IO a -> IO (Maybe a)
- nullByte :: CChar
- cShort2Int :: CShort -> Int
- cUShort2Int :: CUShort -> Int
- cuCharToInt :: CUChar -> Int
- byteToInt :: Ptr CUChar -> Int -> IO Int
- bufferToString :: ColumnInfo -> IO (Maybe String)
- makeYear :: Int -> Int -> Int
- makeYearByte :: Int -> Word8
- makeCentByte :: Int -> Word8
- dumpBuffer :: Ptr Word8 -> IO ()
- bufferToCaltime :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe CalendarTime)
- bufferToUTCTime :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe UTCTime)
- setBufferByte :: BufferPtr -> Int -> Word8 -> IO ()
- calTimeToBuffer :: BufferPtr -> CalendarTime -> IO ()
- utcTimeToBuffer :: BufferPtr -> UTCTime -> IO ()
- bufferPeekValue :: Storable a => BufferFPtr -> IO a
- bufferToA :: Storable a => ForeignPtr CShort -> BufferFPtr -> IO (Maybe a)
- bufferToCInt :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe CInt)
- bufferToInt :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe Int)
- bufferToCDouble :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe CDouble)
- bufferToDouble :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe Double)
- bufferToStmtHandle :: BufferFPtr -> IO StmtHandle
Documentation
- Each handle type has its own data type, to prevent stupid errors i.e. using the wrong handle at the wrong time.
Constructors
OCIStruct |
type BufferFPtr = ForeignPtr OCIBuffer Source #
type ColumnResultBuffer = ForeignPtr OCIBuffer Source #
type BindBuffer = (ForeignPtr CShort, ForeignPtr OCIBuffer, ForeignPtr CUShort) Source #
type ContextPtr = Ptr Context Source #
data ErrorStruct Source #
Constructors
ErrorStruct |
type ErrorHandle = Ptr ErrorStruct Source #
data ServerStruct Source #
Constructors
ServerStruct |
type ServerHandle = Ptr ServerStruct Source #
data UserStruct Source #
Constructors
UserStruct |
type UserHandle = Ptr UserStruct Source #
data ConnStruct Source #
Constructors
ConnStruct |
type ConnHandle = Ptr ConnStruct Source #
data SessStruct Source #
Constructors
SessStruct |
type SessHandle = Ptr SessStruct Source #
data StmtStruct Source #
Constructors
StmtStruct |
type StmtHandle = Ptr StmtStruct Source #
data DefnStruct Source #
Constructors
DefnStruct |
type DefnHandle = Ptr DefnStruct Source #
data ParamStruct Source #
Constructors
ParamStruct |
type ParamHandle = Ptr ParamStruct Source #
data BindStruct Source #
Constructors
BindStruct |
type BindHandle = Ptr BindStruct Source #
type ColumnInfo = (DefnHandle, ColumnResultBuffer, ForeignPtr CShort, ForeignPtr CUShort) Source #
data OCIException Source #
Low-level, OCI library errors.
Constructors
OCIException CInt String |
Instances
throwOCI :: OCIException -> a Source #
cStrLen :: CStringLen -> CInt Source #
cStr :: CStringLen -> CString Source #
ociEnvCreate :: Ptr EnvHandle -> CInt -> Ptr a -> FunPtr a -> FunPtr a -> FunPtr a -> CInt -> Ptr (Ptr a) -> IO CInt Source #
ociErrorGet :: OCIHandle -> CInt -> CString -> Ptr CInt -> CString -> CInt -> CInt -> IO CInt Source #
ociLogon :: EnvHandle -> ErrorHandle -> Ptr ConnHandle -> CString -> CInt -> CString -> CInt -> CString -> CInt -> IO CInt Source #
ociLogoff :: ConnHandle -> ErrorHandle -> IO CInt Source #
ociSessionBegin :: ConnHandle -> ErrorHandle -> SessHandle -> CInt -> CInt -> IO CInt Source #
ociSessionEnd :: ConnHandle -> ErrorHandle -> SessHandle -> CInt -> IO CInt Source #
ociServerAttach :: ServerHandle -> ErrorHandle -> CString -> CInt -> CInt -> IO CInt Source #
ociServerDetach :: ServerHandle -> ErrorHandle -> CInt -> IO CInt Source #
ociTransStart :: ConnHandle -> ErrorHandle -> Word8 -> CInt -> IO CInt Source #
ociTransCommit :: ConnHandle -> ErrorHandle -> CInt -> IO CInt Source #
ociTransRollback :: ConnHandle -> ErrorHandle -> CInt -> IO CInt Source #
ociStmtPrepare :: StmtHandle -> ErrorHandle -> CString -> CInt -> CInt -> CInt -> IO CInt Source #
ociDefineByPos :: StmtHandle -> Ptr DefnHandle -> ErrorHandle -> CInt -> BufferPtr -> CInt -> CUShort -> Ptr CShort -> Ptr CUShort -> Ptr CUShort -> CInt -> IO CInt Source #
ociStmtExecute :: ConnHandle -> StmtHandle -> ErrorHandle -> CInt -> CInt -> OCIHandle -> OCIHandle -> CInt -> IO CInt Source #
ociStmtFetch :: StmtHandle -> ErrorHandle -> CInt -> CShort -> CInt -> IO CInt Source #
Arguments
:: StmtHandle | |
-> Ptr BindHandle | |
-> ErrorHandle | |
-> CUInt | position |
-> BufferPtr | buffer containing data |
-> CInt | max size of buffer |
-> CUShort | SQL data type |
-> Ptr CShort | null indicator ptr |
-> Ptr CUShort | input + output size, or array of sizes |
-> Ptr CUShort | array of return codes |
-> CUInt | max array elements |
-> Ptr CUInt | number of array elements |
-> CUInt | mode |
-> IO CInt |
ociBindDynamic :: BindHandle -> ErrorHandle -> ContextPtr -> FunPtr OCICallbackInBind -> ContextPtr -> FunPtr OCICallbackOutBind -> IO CInt Source #
type OCICallbackInBind = ContextPtr -> BindHandle -> CInt -> CInt -> Ptr BufferPtr -> CInt -> Ptr Word8 -> Ptr CShort -> IO CInt Source #
type OCICallbackOutBind = ContextPtr -> BindHandle -> CInt -> CInt -> Ptr BufferPtr -> Ptr CInt -> Ptr Word8 -> Ptr CShort -> Ptr (Ptr CShort) -> IO CInt Source #
getOCIErrorMsg2 :: OCIHandle -> CInt -> Ptr CInt -> CString -> CInt -> IO (CInt, String) Source #
This is just an auxiliary function for getOCIErrorMsg.
fromEnumOCIErrorCode :: CInt -> String Source #
formatOCIMsg :: CInt -> String -> OCIHandle -> CInt -> IO (Int, String) Source #
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.
formatMsgCommon :: OCIException -> OCIHandle -> CInt -> IO (Int, String) Source #
We have two format functions: formatEnvMsg
takes the EnvHandle
,
formatErrorMsg
takes the ErrorHandle
.
They're just type-safe wrappers for formatMsgCommon
.
formatErrorMsg :: OCIException -> ErrorHandle -> IO (Int, String) Source #
formatEnvMsg :: OCIException -> EnvHandle -> IO (Int, String) Source #
testForError :: CInt -> String -> a -> IO a Source #
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.
testForErrorWithPtr :: Storable a => CInt -> String -> Ptr a -> IO a Source #
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.
setHandleAttr :: ErrorHandle -> OCIHandle -> CInt -> Ptr a -> CInt -> IO () Source #
setHandleAttrString :: ErrorHandle -> OCIHandle -> CInt -> String -> CInt -> IO () Source #
getHandleAttr :: Storable a => ErrorHandle -> OCIHandle -> CInt -> CInt -> IO a Source #
getParam :: ErrorHandle -> StmtHandle -> Int -> IO ParamHandle Source #
dbLogon :: String -> String -> String -> EnvHandle -> ErrorHandle -> IO ConnHandle Source #
The OCI Logon function doesn't behave as you'd expect when the password is due to expire.
ociLogon
returns oci_SUCCESS_WITH_INFO
,
but the ConnHandle
returned is not valid.
In this case we have to change oci_SUCCESS_WITH_INFO
to 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.
dbLogoff :: ErrorHandle -> ConnHandle -> IO () Source #
serverDetach :: ErrorHandle -> ServerHandle -> IO () Source #
serverAttach :: ErrorHandle -> ServerHandle -> String -> IO () Source #
getSession :: ErrorHandle -> ConnHandle -> IO SessHandle Source #
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.
sessionBegin :: ErrorHandle -> ConnHandle -> SessHandle -> CInt -> IO () Source #
sessionEnd :: ErrorHandle -> ConnHandle -> SessHandle -> IO () Source #
beginTrans :: ErrorHandle -> ConnHandle -> CInt -> IO () Source #
commitTrans :: ErrorHandle -> ConnHandle -> IO () Source #
rollbackTrans :: ErrorHandle -> ConnHandle -> IO () Source #
stmtPrepare :: ErrorHandle -> StmtHandle -> String -> IO () Source #
With the OCI you do queries with these steps:
stmtExecute :: ErrorHandle -> ConnHandle -> StmtHandle -> Int -> IO () Source #
Arguments
:: 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 allocates memory for a single column value. The allocated components are:
substituteBindPlaceHolders :: String -> String Source #
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 ?.
Arguments
:: 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 () |
Arguments
:: ErrorHandle | |
-> StmtHandle | |
-> Int | Position |
-> BindBuffer | triple of (null-ind, payload, input-size) |
-> Int | buffer max size in bytes |
-> CInt | SQL Datatype (from Database.Oracle.OCIConstants) |
-> IO BindHandle |
stmtFetch :: ErrorHandle -> StmtHandle -> IO CInt Source #
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.
maybeBufferNull :: ForeignPtr CShort -> Maybe a -> IO a -> IO (Maybe a) Source #
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.
cShort2Int :: CShort -> Int Source #
cUShort2Int :: CUShort -> Int Source #
cuCharToInt :: CUChar -> Int Source #
bufferToString :: ColumnInfo -> IO (Maybe String) Source #
makeYear :: Int -> Int -> Int Source #
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.
makeYearByte :: Int -> Word8 Source #
makeCentByte :: Int -> Word8 Source #
bufferToCaltime :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe CalendarTime) Source #
bufferToUTCTime :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe UTCTime) Source #
calTimeToBuffer :: BufferPtr -> CalendarTime -> IO () Source #
bufferPeekValue :: Storable a => BufferFPtr -> IO a Source #
bufferToA :: Storable a => ForeignPtr CShort -> BufferFPtr -> IO (Maybe a) Source #
bufferToCInt :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe CInt) Source #
bufferToInt :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe Int) Source #
bufferToCDouble :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe CDouble) Source #
bufferToDouble :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe Double) Source #