Menu
▾
▴
[htoolkit-cvs] HSQL/Oracle/Database/HSQL HsOCI.h,1.1,1.2 Oracle.hsc,1.1,1.2
|
From: <kr_...@us...> - 2005-10-12 15:01:55
|
Update of /cvsroot/htoolkit/HSQL/Oracle/Database/HSQL In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4121/Database/HSQL Modified Files: HsOCI.h Oracle.hsc Log Message: more work on Oracle backen Index: HsOCI.h =================================================================== RCS file: /cvsroot/htoolkit/HSQL/Oracle/Database/HSQL/HsOCI.h,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** HsOCI.h 15 Sep 2005 12:57:10 -0000 1.1 --- HsOCI.h 12 Oct 2005 15:01:44 -0000 1.2 *************** *** 3,5 **** --- 3,16 ---- #include <oci.h> + typedef struct + { + OCIParam *par; + OCITypeCode dtype; + ub2 dsize; + ub1 dprec; + ub1 dscale; + ub4 colNameLen; + char *colName; + } FIELD_DEF; + #undef _int64 Index: Oracle.hsc =================================================================== RCS file: /cvsroot/htoolkit/HSQL/Oracle/Database/HSQL/Oracle.hsc,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Oracle.hsc 15 Sep 2005 12:57:10 -0000 1.1 --- Oracle.hsc 12 Oct 2005 15:01:44 -0000 1.2 *************** *** 22,25 **** --- 22,26 ---- import Foreign.Concurrent as FC import Control.Concurrent.MVar + import Control.Exception(throwDyn) #include <HsOCI.h> *************** *** 30,33 **** --- 31,35 ---- type OCISvcCtx = OCIHandle type OCIStmt = OCIHandle + type OCIParam = OCIHandle type OCIEnvRef = ForeignPtr () *************** *** 45,48 **** --- 47,55 ---- foreign import ccall "OCIStmtExecute" ociStmtExecute :: OCISvcCtx -> OCIStmt -> OCIError -> CInt -> CInt -> OCIHandle -> OCIHandle -> CInt -> IO CInt + foreign import ccall "OCIParamGet" ociParamGet :: OCIStmt -> CInt -> OCIError -> Ptr OCIParam -> CInt -> IO CInt + foreign import ccall "OCIAttrGet" ociAttrGet :: OCIParam -> CInt -> Ptr a -> Ptr CInt -> CInt -> OCIError -> IO CInt + + foreign import ccall "OCIDescriptorFree" ociDescriptorFree :: OCIHandle -> CInt -> IO CInt + ----------------------------------------------------------------------------------------- -- keeper of OCIEnv *************** *** 52,74 **** myEnvironment :: OCIEnvRef myEnvironment = unsafePerformIO $ alloca $ \ (pOCIEnv :: Ptr OCIEnv) -> do ! ociEnvCreate pOCIEnv (#const OCI_DEFAULT) nullPtr nullFunPtr nullFunPtr nullFunPtr 0 nullPtr >>= handleSqlResult env <- peek pOCIEnv FC.newForeignPtr env terminate where ! terminate = ociTerminate (#const OCI_DEFAULT) >>= handleSqlResult ! ! ----------------------------------------------------------------------------------------- ! -- allocate/deallocate handles ! ----------------------------------------------------------------------------------------- ! ! allocHandle :: CInt -> OCIHandle -> IO OCIHandle ! allocHandle handleType parent = ! alloca $ \pHandle -> do ! ociHandleAlloc parent pHandle handleType 0 nullPtr >>= handleSqlResult ! peek pHandle ! ! freeHandle :: CInt -> OCIHandle -> IO () ! freeHandle handleType handle = ! ociHandleFree handle handleType >>= handleSqlResult ----------------------------------------------------------------------------------------- --- 59,67 ---- myEnvironment :: OCIEnvRef myEnvironment = unsafePerformIO $ alloca $ \ (pOCIEnv :: Ptr OCIEnv) -> do ! ociEnvCreate pOCIEnv (#const OCI_DEFAULT) nullPtr nullFunPtr nullFunPtr nullFunPtr 0 nullPtr >>= handleSqlResult nullPtr env <- peek pOCIEnv FC.newForeignPtr env terminate where ! terminate = ociTerminate (#const OCI_DEFAULT) >>= handleSqlResult nullPtr ----------------------------------------------------------------------------------------- *************** *** 76,82 **** ----------------------------------------------------------------------------------------- ! handleSqlResult err ! | err == 0 = return () ! | otherwise = putStrLn ("ERROR: "++show err) -- | Makes a new connection to the Oracle service --- 69,99 ---- ----------------------------------------------------------------------------------------- ! handleSqlResult err res ! | res == (#const OCI_SUCCESS) || res == (#const OCI_NO_DATA) = return () ! | res == (#const OCI_SUCCESS_WITH_INFO) = do ! #ifdef DEBUG ! e <- getSqlError ! putTraceMsg (show e) ! #else ! return () ! #endif ! | res == (#const OCI_INVALID_HANDLE) = throwDyn SqlInvalidHandle ! | res == (#const OCI_STILL_EXECUTING) = throwDyn SqlStillExecuting ! | res == (#const OCI_NEED_DATA) = throwDyn SqlNeedData ! | res == (#const OCI_ERROR) = getSqlError >>= throwDyn ! | otherwise = error (show res) ! where ! stringBufferLen = 1024 ! ! getSqlError = ! alloca $ \pErrCode -> ! allocaBytes stringBufferLen $ \pErrMsg -> do ! rc <- ociErrorGet err 1 nullPtr pErrCode pErrMsg (fromIntegral stringBufferLen) (#const OCI_HTYPE_ERROR) ! if rc < 0 ! then return SqlNoData ! else do ! msg <- peekCString pErrMsg ! errCode <- peek pErrCode ! return (SqlError {seState="", seNativeError=fromIntegral errCode, seErrorMsg=msg}) -- | Makes a new connection to the Oracle service *************** *** 90,99 **** withCStringLen pwd $ \(pwd, pwd_len) -> withCStringLen service $ \(service, service_len) -> alloca $ \pSvcCtx -> do ! err <- allocHandle (#const OCI_HTYPE_ERROR) env res <- ociLogon env err pSvcCtx user (fromIntegral user_len) pwd (fromIntegral pwd_len) service (fromIntegral service_len) ! if res == (#const OCI_SUCCESS_WITH_INFO) ! then handleSqlResult (#const OCI_ERROR) ! else handleSqlResult res svcCtx <- peek pSvcCtx refFalse <- newMVar False --- 107,116 ---- withCStringLen pwd $ \(pwd, pwd_len) -> withCStringLen service $ \(service, service_len) -> + alloca $ \pError -> do alloca $ \pSvcCtx -> do ! ociHandleAlloc env pError (#const OCI_HTYPE_ERROR) 0 nullPtr >>= handleSqlResult nullPtr ! err <- peek pError res <- ociLogon env err pSvcCtx user (fromIntegral user_len) pwd (fromIntegral pwd_len) service (fromIntegral service_len) ! handleSqlResult err res svcCtx <- peek pSvcCtx refFalse <- newMVar False *************** *** 112,133 **** where disconnect svcCtx err = do ! ociLogoff svcCtx err >>= handleSqlResult ! freeHandle (#const OCI_HTYPE_ERROR) err execute envRef svcCtx err query = withForeignPtr envRef $ \env -> ! withCStringLen query $ \(query,query_len) -> do ! stmt <- allocHandle (#const OCI_HTYPE_STMT) env ! ociStmtPrepare stmt err query (fromIntegral query_len) (#const OCI_NTV_SYNTAX) (#const OCI_DEFAULT) >>= handleSqlResult ! ociStmtExecute svcCtx stmt err 1 0 nullPtr nullPtr (#const OCI_DEFAULT) >>= handleSqlResult ! freeHandle (#const OCI_HTYPE_STMT) stmt query connection envRef svcCtx err query = withForeignPtr envRef $ \env -> ! withCStringLen query $ \(query,query_len) -> do ! stmt <- allocHandle (#const OCI_HTYPE_STMT) env ! ociStmtPrepare stmt err query (fromIntegral query_len) (#const OCI_NTV_SYNTAX) (#const OCI_DEFAULT) >>= handleSqlResult ! ociStmtExecute svcCtx stmt err 1 0 nullPtr nullPtr (#const OCI_DEFAULT) >>= handleSqlResult ! let fields = [] refFalse <- newMVar False let statement = Statement --- 129,154 ---- where disconnect svcCtx err = do ! ociLogoff svcCtx err >>= handleSqlResult err ! ociHandleFree err (#const OCI_HTYPE_ERROR) >>= handleSqlResult err execute envRef svcCtx err query = withForeignPtr envRef $ \env -> ! withCStringLen query $ \(query,query_len) -> ! alloca $ \pStmt -> do ! ociHandleAlloc env pStmt (#const OCI_HTYPE_STMT) 0 nullPtr >>= handleSqlResult err ! stmt <- peek pStmt ! ociStmtPrepare stmt err query (fromIntegral query_len) (#const OCI_NTV_SYNTAX) (#const OCI_DEFAULT) >>= handleSqlResult err ! ociStmtExecute svcCtx stmt err 0 0 nullPtr nullPtr (#const OCI_DEFAULT) >>= handleSqlResult err ! ociHandleFree stmt (#const OCI_HTYPE_STMT) >>= handleSqlResult err query connection envRef svcCtx err query = withForeignPtr envRef $ \env -> ! withCStringLen query $ \(query,query_len) -> ! alloca $ \pStmt -> do ! ociHandleAlloc env pStmt (#const OCI_HTYPE_STMT) 0 nullPtr >>= handleSqlResult err ! stmt <- peek pStmt ! ociStmtPrepare stmt err query (fromIntegral query_len) (#const OCI_NTV_SYNTAX) (#const OCI_DEFAULT) >>= handleSqlResult err ! ociStmtExecute svcCtx stmt err 0 0 nullPtr nullPtr (#const OCI_DEFAULT) >>= handleSqlResult err ! fields <- allocaBytes (#const (sizeof(FIELD_DEF))) (getFieldDefs stmt 1) refFalse <- newMVar False let statement = Statement *************** *** 140,143 **** --- 161,204 ---- } return statement + where + getFieldDefs stmt counter buffer = do + res <- ociParamGet stmt (#const OCI_HTYPE_STMT) err ((#ptr FIELD_DEF, par) buffer) counter + if res == (#const OCI_SUCCESS) + then do field <- getFieldDef buffer + fields <- getFieldDefs stmt (counter+1) buffer + return (field:fields) + else return [] + + getFieldDef buffer = do + par <- (#peek FIELD_DEF, par) buffer + ociAttrGet par (#const OCI_DTYPE_PARAM) ((#ptr FIELD_DEF, dtype) buffer) nullPtr (#const OCI_ATTR_DATA_TYPE) err >>= handleSqlResult err + dtype <- (#peek FIELD_DEF, dtype) buffer + ociAttrGet par (#const OCI_DTYPE_PARAM) ((#ptr FIELD_DEF, dsize) buffer) nullPtr (#const OCI_ATTR_DATA_SIZE) err >>= handleSqlResult err + dsize <- (#peek FIELD_DEF, dsize) buffer + ociAttrGet par (#const OCI_DTYPE_PARAM) ((#ptr FIELD_DEF, dprec) buffer) nullPtr (#const OCI_ATTR_PRECISION) err >>= handleSqlResult err + dprec <- (#peek FIELD_DEF, dprec) buffer + ociAttrGet par (#const OCI_DTYPE_PARAM) ((#ptr FIELD_DEF, dscale) buffer) nullPtr (#const OCI_ATTR_SCALE) err >>= handleSqlResult err + dscale <- (#peek FIELD_DEF, dscale) buffer + ociAttrGet par (#const OCI_DTYPE_PARAM) ((#ptr FIELD_DEF, colName) buffer) ((#ptr FIELD_DEF, colNameLen) buffer) (#const OCI_ATTR_NAME) err >>= handleSqlResult err + pColName <- (#peek FIELD_DEF, colName) buffer + (colNameLen :: (#type ub4)) <- (#peek FIELD_DEF, colNameLen) buffer + colName <- peekCStringLen (pColName, fromIntegral colNameLen) + ociDescriptorFree par (#const OCI_DTYPE_PARAM) + print (dtype,dsize,dprec,dscale) + return (colName,mkSqlType dtype dsize dprec dscale,False) + + mkSqlType :: (#type OCITypeCode) -> (#type ub2) -> (#type ub1) -> (#type ub1) -> SqlType + mkSqlType (#const OCI_TYPECODE_CHAR) size _ _ = SqlChar (fromIntegral size) + mkSqlType (#const OCI_TYPECODE_VARCHAR) size _ _ = SqlVarChar (fromIntegral size) + mkSqlType (#const OCI_TYPECODE_DECIMAL) _ prec scale = SqlDecimal (fromIntegral prec) (fromIntegral scale) + mkSqlType (#const OCI_TYPECODE_NUMBER) _ prec scale = SqlNumeric (fromIntegral prec) (fromIntegral scale) + mkSqlType (#const OCI_TYPECODE_SMALLINT) _ _ _ = SqlSmallInt + mkSqlType (#const OCI_TYPECODE_INTEGER) _ _ _ = SqlInteger + mkSqlType (#const OCI_TYPECODE_FLOAT) _ _ _ = SqlFloat + mkSqlType (#const OCI_TYPECODE_DATE) _ _ _ = SqlDate + mkSqlType (#const OCI_TYPECODE_TIME) _ _ _ = SqlTime + mkSqlType (#const OCI_TYPECODE_TIMESTAMP) _ _ _ = SqlTimeStamp + mkSqlType (#const SQLT_LNG) _ _ _ = SqlText + mkSqlType tp _ _ _ = SqlUnknown (fromIntegral tp) tables connection svcCtx = undefined |
