[htoolkit-cvs] HSQL/Oracle/Database/HSQL Oracle.hsc,1.5,1.6

[<kr_...@us...>]

Update of /cvsroot/htoolkit/HSQL/Oracle/Database/HSQL
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7020/Database/HSQL

Modified Files:
	Oracle.hsc 
Log Message:
tables & describe methods for Oracle


Index: Oracle.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/Oracle/Database/HSQL/Oracle.hsc,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** Oracle.hsc	12 Dec 2005 15:21:56 -0000	1.5
--- Oracle.hsc	15 Dec 2005 13:11:38 -0000	1.6
***************
*** 23,26 ****
--- 23,27 ----
  import Control.Concurrent.MVar
  import Control.Exception(throwDyn)
+ import Data.Word
  
  #include <HsOCI.h>
***************
*** 33,36 ****
--- 34,38 ----
  type OCIParam  = OCIHandle
  type OCIDefine = OCIHandle
+ type OCIDescribe=OCIHandle
  
  type OCIEnvRef = ForeignPtr ()
***************
*** 50,55 ****
  foreign import ccall "OCIDefineByPos" ociDefineByPos :: OCIStmt -> Ptr OCIDefine -> OCIError -> CInt -> Ptr a -> CInt -> CShort -> Ptr CShort -> Ptr CShort -> Ptr CShort -> 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
--- 52,58 ----
  foreign import ccall "OCIDefineByPos" ociDefineByPos :: OCIStmt -> Ptr OCIDefine -> OCIError -> CInt -> Ptr a -> CInt -> CShort -> Ptr CShort -> Ptr CShort -> Ptr CShort -> CInt -> IO CInt
  
! foreign import ccall "OCIParamGet" ociParamGet :: OCIHandle -> 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 "OCIDescribeAny" ociDescribeAny :: OCISvcCtx -> OCIError -> Ptr () -> CInt -> Word8 -> Word8 -> Word8 -> OCIDescribe -> IO CInt
  
  foreign import ccall "OCIDescriptorFree" ociDescriptorFree :: OCIHandle -> CInt -> IO CInt
***************
*** 128,133 ****
      			, connExecute    = execute myEnvironment svcCtx err
      			, connQuery      = query connection myEnvironment svcCtx err
!     			, connTables     = tables connection svcCtx
!     			, connDescribe   = describe connection svcCtx
      			, connBeginTransaction = beginTransaction myEnvironment svcCtx err
      			, connCommitTransaction = commitTransaction myEnvironment svcCtx err 
--- 131,136 ----
      			, connExecute    = execute myEnvironment svcCtx err
      			, connQuery      = query connection myEnvironment svcCtx err
!     			, connTables     = tables env svcCtx err
!     			, connDescribe   = describe env svcCtx err
      			, connBeginTransaction = beginTransaction myEnvironment svcCtx err
      			, connCommitTransaction = commitTransaction myEnvironment svcCtx err 
***************
*** 177,204 ****
              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, isNull) buffer) nullPtr (#const OCI_ATTR_IS_NULL) err >>= handleSqlResult err
-             (isNull :: (#type ub1)) <- (#peek FIELD_DEF, isNull) 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)
-             return (colName,mkSqlType dtype dsize dprec dscale,toBool (fromIntegral isNull))
- 
            sqlType2Size :: FieldDef -> CInt
            sqlType2Size (_,tp,_) =
--- 180,188 ----
              res <- ociParamGet stmt (#const OCI_HTYPE_STMT) err ((#ptr FIELD_DEF, par) buffer) counter
              if res == (#const OCI_SUCCESS)
!               then do field  <- getFieldDef err buffer
                        fields <- getFieldDefs stmt (counter+1) buffer
                        return (field:fields)
                else return []
  
            sqlType2Size :: FieldDef -> CInt
            sqlType2Size (_,tp,_) =
***************
*** 228,232 ****
      mkSqlType :: (#type OCITypeCode) -> (#type ub2) -> (#type ub1) -> (#type ub1) -> SqlType
      mkSqlType (#const SQLT_CHR)       size _    _     = SqlVarChar (fromIntegral size)
!   --  mkSqlType (#const SQLT_STR)       size _    _     = SqlVarChar (fromIntegral size)
      mkSqlType (#const SQLT_NUM)       _    prec scale = SqlNumeric (fromIntegral prec) (fromIntegral scale)
      mkSqlType (#const SQLT_INT)       _    _    _     = SqlInteger
--- 212,216 ----
      mkSqlType :: (#type OCITypeCode) -> (#type ub2) -> (#type ub1) -> (#type ub1) -> SqlType
      mkSqlType (#const SQLT_CHR)       size _    _     = SqlVarChar (fromIntegral size)
!     mkSqlType (#const SQLT_AFC)       size _    _     = SqlChar    (fromIntegral size)
      mkSqlType (#const SQLT_NUM)       _    prec scale = SqlNumeric (fromIntegral prec) (fromIntegral scale)
      mkSqlType (#const SQLT_INT)       _    _    _     = SqlInteger
***************
*** 239,245 ****
      mkSqlType tp                      _    _    _     = SqlUnknown (fromIntegral tp)
  
!     tables connection svcCtx = undefined
!     describe connection svcCtx = undefined
!     
      beginTransaction myEnvironment svcCtx err =
        ociTransStart svcCtx err 0 (#const OCI_TRANS_READWRITE) >>= handleSqlResult err
--- 223,310 ----
      mkSqlType tp                      _    _    _     = SqlUnknown (fromIntegral tp)
  
!     tables env svcCtx err =
!       withCStringLen "COREDB_SYSTEM" $ \(cstr,clen) ->
!       alloca $ \pDescr ->
!       alloca $ \pParam ->
!       alloca $ \pColl -> do
!         ociHandleAlloc env pDescr (#const OCI_HTYPE_DESCRIBE) 0 nullPtr >>= handleSqlResult err
!         descr <- peek pDescr
!         ociDescribeAny svcCtx err (castPtr cstr) (fromIntegral clen) (#const OCI_OTYPE_NAME) (#const OCI_DEFAULT) (#const OCI_PTYPE_SCHEMA) descr >>= handleSqlResult err
!         ociAttrGet descr (#const OCI_HTYPE_DESCRIBE) pParam nullPtr (#const OCI_ATTR_PARAM) err >>= handleSqlResult err
! 	param <- peek pParam
! 	ociAttrGet param (#const OCI_DTYPE_PARAM) pColl nullPtr (#const OCI_ATTR_LIST_OBJECTS) err >>= handleSqlResult err
! 	coll <- peek pColl
! 	names <- allocaBytes (#const (sizeof(FIELD_DEF))) (getTableNames coll 1)
! 	ociDescriptorFree coll  (#const OCI_DTYPE_PARAM)
!         ociDescriptorFree param (#const OCI_DTYPE_PARAM)
!         ociHandleFree descr (#const OCI_HTYPE_DESCRIBE) >>= handleSqlResult err
!         return names
!       where
!         getTableNames coll index buffer = do
!           res <- ociParamGet coll (#const OCI_DTYPE_PARAM) err ((#ptr FIELD_DEF, par) buffer) index
!           par <- (#peek FIELD_DEF, par) buffer
!           if res == (#const OCI_SUCCESS)
!             then do
!               ociAttrGet par (#const OCI_DTYPE_PARAM) ((#ptr FIELD_DEF, colName) buffer) ((#ptr FIELD_DEF, colNameLen) buffer) (#const OCI_ATTR_OBJ_NAME) err >>= handleSqlResult err
!               pName <- (#peek FIELD_DEF, colName) buffer
! 	      (nameLen :: (#type ub4)) <- (#peek FIELD_DEF, colNameLen) buffer
! 	      name <- peekCStringLen (pName, fromIntegral nameLen)
! 	      ociAttrGet par (#const OCI_DTYPE_PARAM) ((#ptr FIELD_DEF, dtype) buffer) nullPtr (#const OCI_ATTR_PTYPE) err >>= handleSqlResult err
! 	      ptype <- (#peek FIELD_DEF, dtype) buffer
!               ociDescriptorFree par (#const OCI_DTYPE_PARAM)
!               names <- getTableNames coll (index+1) buffer
!               return $! (if ptype == ((#const OCI_PTYPE_TABLE) :: (#type ub1))
!                            then name:names
!                            else      names)
!             else return []
! 
!     describe env svcCtx err tblName =
!       withCStringLen tblName $ \(cstr,clen) ->
!       alloca $ \pDescr ->
!       alloca $ \pParam ->
!       alloca $ \pColl ->
!       alloca $ \pNumcols -> do
!         ociHandleAlloc env pDescr (#const OCI_HTYPE_DESCRIBE) 0 nullPtr >>= handleSqlResult err
!         descr <- peek pDescr
!         ociDescribeAny svcCtx err (castPtr cstr) (fromIntegral clen) (#const OCI_OTYPE_NAME) (#const OCI_DEFAULT) (#const OCI_PTYPE_TABLE) descr >>= handleSqlResult err
!         ociAttrGet descr (#const OCI_HTYPE_DESCRIBE) pParam nullPtr (#const OCI_ATTR_PARAM) err >>= handleSqlResult err
! 	param <- peek pParam
! 	ociAttrGet param (#const OCI_DTYPE_PARAM) pNumcols nullPtr (#const OCI_ATTR_NUM_COLS) err >>= handleSqlResult err
!         numcols <- peek (pNumcols :: Ptr (#type ub2))
!         ociAttrGet param (#const OCI_DTYPE_PARAM) pColl nullPtr (#const OCI_ATTR_LIST_COLUMNS) err >>= handleSqlResult err
!         coll <- peek pColl
!         fieldDefs <- allocaBytes (#const (sizeof(FIELD_DEF))) (getFieldDefs coll 1 (fromIntegral numcols))
!         ociDescriptorFree coll  (#const OCI_DTYPE_PARAM)
!         ociDescriptorFree param (#const OCI_DTYPE_PARAM)
!         ociHandleFree descr (#const OCI_HTYPE_DESCRIBE) >>= handleSqlResult err
!         return fieldDefs
!       where
!         getFieldDefs coll index numcols buffer
!           | index <= numcols = do
!                ociParamGet coll (#const OCI_DTYPE_PARAM) err ((#ptr FIELD_DEF, par) buffer) index >>= handleSqlResult err
! 	       fieldDef  <- getFieldDef err buffer
!                fieldDefs <- getFieldDefs coll (index+1) numcols buffer
!                return (fieldDef:fieldDefs)
!           | otherwise = return []
! 
!     getFieldDef err 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, isNull) buffer) nullPtr (#const OCI_ATTR_IS_NULL) err >>= handleSqlResult err
!       (isNull :: (#type ub1)) <- (#peek FIELD_DEF, isNull) 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)
!       return (colName,mkSqlType dtype dsize dprec dscale,toBool (fromIntegral isNull))
!             
      beginTransaction myEnvironment svcCtx err =
        ociTransStart svcCtx err 0 (#const OCI_TRANS_READWRITE) >>= handleSqlResult err