[htoolkit-cvs] HSQL/Oracle/Database/HSQL Oracle.hsc,1.3,1.4

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

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

Modified Files:
	Oracle.hsc 
Log Message:
The query/fetch/getFieldValue functions seems to work


Index: Oracle.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/Oracle/Database/HSQL/Oracle.hsc,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** Oracle.hsc	18 Oct 2005 11:43:28 -0000	1.3
--- Oracle.hsc	29 Oct 2005 12:16:38 -0000	1.4
***************
*** 32,35 ****
--- 32,36 ----
  type OCIStmt   = OCIHandle
  type OCIParam  = OCIHandle
+ type OCIDefine = OCIHandle
  
  type OCIEnvRef = ForeignPtr ()
***************
*** 47,50 ****
--- 48,52 ----
  foreign import ccall "OCIStmtExecute" ociStmtExecute :: OCISvcCtx -> OCIStmt -> OCIError -> CInt -> CInt -> OCIHandle -> OCIHandle -> CInt -> IO CInt
  foreign import ccall "OCIStmtFetch2" ociStmtFetch2 :: OCIStmt -> OCIError -> CInt -> CInt -> CInt -> CInt -> IO CInt
+ 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
***************
*** 57,60 ****
--- 59,64 ----
  foreign import ccall "OCITransRollback" ociTransRollback :: OCISvcCtx -> OCIError -> CInt -> IO CInt
  
+ foreign import ccall "strlen" strlen :: CString -> IO CInt
+ 
  -----------------------------------------------------------------------------------------
  -- keeper of OCIEnv
***************
*** 156,161 ****
  	ociStmtExecute svcCtx stmt err 0 0 nullPtr nullPtr (#const OCI_DEFAULT) >>= handleSqlResult err
  	fields <- allocaBytes (#const (sizeof(FIELD_DEF))) (getFieldDefs stmt 1)
! 	buffer <- mallocBytes (fetchBufferSize fields)
! 	definePositions buffer fields
  	refFalse <- newMVar False
          let statement = Statement
--- 160,166 ----
  	ociStmtExecute svcCtx stmt err 0 0 nullPtr nullPtr (#const OCI_DEFAULT) >>= handleSqlResult err
  	fields <- allocaBytes (#const (sizeof(FIELD_DEF))) (getFieldDefs stmt 1)
! 	let offsets_arr_size :: CInt = fromIntegral (length fields * sizeOf offsets_arr_size)
! 	buffer <- mallocBytes (fromIntegral (foldr ((+) . sqlType2Size) offsets_arr_size fields))
! 	definePositions stmt err buffer 0 offsets_arr_size fields
  	refFalse <- newMVar False
          let statement = Statement
***************
*** 163,167 ****
  		, stmtClose  = closeStatement stmt buffer err
  		, stmtFetch  = fetch stmt err
! 		, stmtGetCol = getColValue stmt buffer
  		, stmtFields = fields
  		, stmtClosed = refFalse
--- 168,172 ----
  		, stmtClose  = closeStatement stmt buffer err
  		, stmtFetch  = fetch stmt err
! 		, stmtGetCol = getColValue buffer
  		, stmtFields = fields
  		, stmtClosed = refFalse
***************
*** 194,225 ****
              colName <- peekCStringLen (pColName, fromIntegral colNameLen)
              ociDescriptorFree par (#const OCI_DTYPE_PARAM)
-             print (dtype,dsize,dprec,dscale)
              return (colName,mkSqlType dtype dsize dprec dscale,toBool (fromIntegral isNull))
  
!           fetchBufferSize []                = 0
!           fetchBufferSize ((_,tp,_):fields) = undefined + fetchBufferSize fields
!           
!           definePositions buffer [] = return ()
!           definePositions buffer (field:fields) = do
!             undefined
!             definePositions buffer fields
  
      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_VARCHAR2)     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_REAL)         _    _    _     = SqlReal
!     mkSqlType (#const OCI_TYPECODE_FLOAT)        _    _    _     = SqlFloat
!     mkSqlType (#const OCI_TYPECODE_DOUBLE)       _    _    _     = SqlDouble
!     mkSqlType (#const OCI_TYPECODE_DATE)         _    _    _     = SqlDate
!     mkSqlType (#const OCI_TYPECODE_TIME)         _    _    _     = SqlTime
!     mkSqlType (#const OCI_TYPECODE_TIME_TZ)      _    _    _     = SqlTimeTZ
!     mkSqlType (#const OCI_TYPECODE_TIMESTAMP)    _    _    _     = SqlTimeStamp
!     mkSqlType (#const SQLT_LNG)                  _    _    _     = SqlText
!     mkSqlType tp                                 _    _    _     = SqlUnknown (fromIntegral tp)
  
      tables connection svcCtx = undefined
--- 199,241 ----
              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,_) =
!             case tp of
!               SqlVarChar n   -> fromIntegral n+1
!               SqlNumeric p s -> fromIntegral (p+s+3) -- The value precision plus optional positions for '.', '-' and
!                                                      -- one position for the '\0' character at end of the string.
!               SqlInteger     -> 16 -- 12 digits are enough (maxBound :: Int) has 10 digits.
!                                    -- in addition we may need one position for '-' and one
!                                    -- for the '\0' character at end of the string.
!               SqlFloat       -> 100
!               SqlDate        -> 100
! 	      SqlTime        -> 100
! 	      SqlTimeTZ      -> 100
! 	      SqlTimeStamp   -> 100
! 	      SqlText        -> 100
! 	      SqlUnknown _   -> 0
! 
!           definePositions stmt err buffer pos offset [] = return ()
!           definePositions stmt err buffer pos offset (field:fields) =
!             alloca $ \pDef -> do
!               let size = sqlType2Size field
!               poke (castPtr buffer `advancePtr` fromIntegral pos) offset
!               ociDefineByPos stmt pDef err (pos+1) (buffer `plusPtr` fromIntegral offset) size (#const SQLT_STR) nullPtr nullPtr nullPtr (#const OCI_DEFAULT)
!               definePositions stmt err buffer (pos+1) (offset+size) fields
  
      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
!     mkSqlType (#const SQLT_FLT)       _    _    _     = SqlFloat
!     mkSqlType (#const SQLT_DATE)      _    _    _     = SqlDate
!     mkSqlType (#const SQLT_TIME)      _    _    _     = SqlTime
!     mkSqlType (#const SQLT_TIME_TZ)   _    _    _     = SqlTimeTZ
!     mkSqlType (#const SQLT_TIMESTAMP) _    _    _     = SqlTimeStamp
!     mkSqlType (#const SQLT_LNG)       _    _    _     = SqlText
!     mkSqlType tp                      _    _    _     = SqlUnknown (fromIntegral tp)
  
      tables connection svcCtx = undefined
***************
*** 244,246 ****
        return (res /= (#const OCI_NO_DATA))
  
!     getColValue stmt buffer = undefined
--- 260,267 ----
        return (res /= (#const OCI_NO_DATA))
  
!     getColValue :: Ptr () -> Int -> FieldDef -> (SqlType -> CString -> Int -> IO (Maybe a)) -> IO (Maybe a)
!     getColValue buffer colNumber (name,sqlType,nullable) f = do
!       (offset :: CInt) <- peek (castPtr buffer `advancePtr` colNumber)
!       let valuePtr = castPtr buffer `plusPtr` fromIntegral offset      
!       valueLen <- strlen valuePtr
!       f sqlType valuePtr (fromIntegral valueLen)