Menu
▾
▴
htoolkit-cvs — HToolkit CVS commit messages
You can subscribe to this list here.
| 2003 |
Jan
(30) |
Feb
(20) |
Mar
(151) |
Apr
(86) |
May
(23) |
Jun
(25) |
Jul
(107) |
Aug
(141) |
Sep
(55) |
Oct
(85) |
Nov
(65) |
Dec
(2) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2004 |
Jan
(22) |
Feb
(18) |
Mar
(3) |
Apr
(16) |
May
(69) |
Jun
(3) |
Jul
(1) |
Aug
(3) |
Sep
(1) |
Oct
|
Nov
(6) |
Dec
(1) |
| 2005 |
Jan
(2) |
Feb
(16) |
Mar
|
Apr
|
May
|
Jun
(47) |
Jul
(1) |
Aug
|
Sep
(6) |
Oct
(4) |
Nov
|
Dec
(34) |
| 2006 |
Jan
(39) |
Feb
|
Mar
(2) |
Apr
|
May
|
Jun
(1) |
Jul
|
Aug
|
Sep
(5) |
Oct
|
Nov
(4) |
Dec
|
| 2007 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
(1) |
| 2008 |
Jan
|
Feb
|
Mar
(26) |
Apr
(1) |
May
(1) |
Jun
|
Jul
(5) |
Aug
(2) |
Sep
(8) |
Oct
(8) |
Nov
(22) |
Dec
(30) |
| 2009 |
Jan
(10) |
Feb
(13) |
Mar
(14) |
Apr
(14) |
May
(32) |
Jun
(25) |
Jul
(36) |
Aug
(10) |
Sep
(2) |
Oct
|
Nov
|
Dec
(10) |
| 2010 |
Jan
(9) |
Feb
(4) |
Mar
(2) |
Apr
(1) |
May
(2) |
Jun
(2) |
Jul
(1) |
Aug
(4) |
Sep
|
Oct
(1) |
Nov
|
Dec
|
|
From: <kr_...@us...> - 2006-01-03 21:01:48
|
Update of /cvsroot/htoolkit/HSQL/PostgreSQL/Database/HSQL In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv29943/Database/HSQL Modified Files: PostgreSQL.hsc Log Message: fix PostgreSQL driver Index: PostgreSQL.hsc =================================================================== RCS file: /cvsroot/htoolkit/HSQL/PostgreSQL/Database/HSQL/PostgreSQL.hsc,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** PostgreSQL.hsc 12 Dec 2005 15:21:56 -0000 1.2 --- PostgreSQL.hsc 3 Jan 2006 21:01:30 -0000 1.3 *************** *** 179,183 **** getFieldValue stmt colNumber fieldDef v = do ! mb_v <- stmtGetCol stmt colNumber fieldDef fromNonNullSqlCStringLen return (case mb_v of { Nothing -> v; Just a -> a }) --- 179,183 ---- getFieldValue stmt colNumber fieldDef v = do ! mb_v <- stmtGetCol stmt colNumber fieldDef fromSqlCStringLen return (case mb_v of { Nothing -> v; Just a -> a }) *************** *** 210,221 **** getColValue :: PGresult -> MVar Int -> Int -> Int -> FieldDef -> (FieldDef -> CString -> Int -> IO a) -> IO a ! getColValue pRes tupleIndex countTuples colNumber (name,sqlType,nullable) f = do index <- readMVar tupleIndex when (index >= countTuples) (throwDyn SqlNoData) isnull <- pqGetisnull pRes index colNumber if isnull == 1 ! then f sqlType nullPtr 0 else do pStr <- pqGetvalue pRes index colNumber strLen <- strlen pStr ! f sqlType pStr strLen --- 210,221 ---- getColValue :: PGresult -> MVar Int -> Int -> Int -> FieldDef -> (FieldDef -> CString -> Int -> IO a) -> IO a ! getColValue pRes tupleIndex countTuples colNumber fieldDef f = do index <- readMVar tupleIndex when (index >= countTuples) (throwDyn SqlNoData) isnull <- pqGetisnull pRes index colNumber if isnull == 1 ! then f fieldDef nullPtr 0 else do pStr <- pqGetvalue pRes index colNumber strLen <- strlen pStr ! f fieldDef pStr strLen |
|
From: PayPal <se...@pa...> - 2005-12-25 16:57:57
|
<body link="#336699">
<div id=message>
<html>
<head>
<title>PayPal</title>
</head>
<xbody bgcolor="#ffffff">
<style type="text/css">
#message .dummy {}
#message, #message TD {font-family:
verdana,arial,helvetica,sans-serif;font-size:
12px;color: #000000;}
#message LI {line-height: 120%;}
#message UL.ppsmallborder {margin:10px 5px 10px 20px;}
#message LI.ppsmallborderli {margin:0px 0px 5px 0px;}
#message UL.pp_narrow {margin:10px 5px 0px 40px;}
#message hr.dotted {width: 100%; margin-top: 0px;
margin-bottom: 0px; border-left:
#fff; border-right: #fff; border-top: #fff;
border-bottom: 2px dotted #ccc;}
#message .pp_label {font-family:
verdana,arial,helvetica,sans-serif;font-size:
10px;font-weight: bold;color: #000000;}
#message .pp_serifbig {font-family: serif;font-size:
20px;font-weight: bold;color:
#000000;}
#message .pp_serif{font-family: serif;font-size:
16px;color: #000000;}
#message .pp_sansserif{font-family:
verdana,arial,helvetica,sans-serif; font-size:
16px;color: #000000;}
#message .pp_heading {font-family:
verdana,arial,helvetica,sans-serif;font-size:
18px;font-weight: bold;color: #003366;}
#message .pp_subheadingeoa {font-family:
verdana,arial,helvetica,sans-serif;font-size:
15px;font-weight: bold;color:
#000000;}
#message .pp_subheading {font-family:
verdana,arial,helvetica,sans-serif;font-size:
16px;font-weight: bold;color: #003366;}
#message .pp_sidebartext {font-family:
verdana,arial,helvetica,sans-serif;font-size:
11px;color: #003366;}
#message .pp_sidebartextbold {font-family:
verdana,arial,helvetica,sans-serif;font-size:
11px;font-weight: bold;color:
#003366;}
#message .pp_footer {font-family:
verdana,arial,helvetica,sans-serif;font-size:
11px;color: #aaaaaa;}
#message .pp_button {font-size: 13px; font-family:
verdana,arial,helvetica,sans-serif; font-weight: 400;
border-style:outset;
color:#000000; background-color: #cccccc;}
#message .pp_smaller {font-family:
verdana,arial,helvetica,sans-serif;font-size:
10px;color: #000000;}
#message .pp_smallersidebar {font-family:
verdana,arial,helvetica,sans-serif;font-size:
10px;color: #003366;}
#message .ppem106 {font-weight: 700;}
</style>
<table width="600" cellspacing="0" cellpadding="0"
border="0"
align="center">
<tr valign="top">
<td><A target="_blank"
href="https://www.paypal.com/us" >
<IMG
src="http://images.paypal.com/en_US/i/logo/email_logo.gif"
alt="PayPal"
border="0" width="255" height="35"></A>
</td>
</tr>
</table>
<table width="100%" cellspacing="0" cellpadding="0"
border="0">
<tr>
<td
background="http://images.paypal.com/images/bg_clk.gif"
width=100%><img
src="http://images.paypal.com/images/pixel.gif"
height="29"
width="1" border="0"></td>
</tr>
<tr>
<td><img
src="http://images.paypal.com/images/pixel.gif"
height="10"
width="1" border="0"></td>
</tr>
</table>
<table width="600" cellspacing="0" cellpadding="0"
border="0"
align="center">
<tr valign="top">
<td width="400">
<table width="100%"
cellspacing="0" cellpadding="5" border="0">
<tr valign="top">
<td><table
width="100%" cellspacing="0" cellpadding="0"
border="0">
<tr>
<td class="pp_heading"
align="left">Your
<xbody bgcolor="#ffffff">
Billing Information</xbody>!</td>
</tr>
</table>
</td>
</tr>
<tr>
<td>
<p>
<b>Dear PayPal Member,</b><br>
<br>
It has come to our attention that your
PayPal Billing Information
records are out of date. That requires you
to update the Billing
Information. <br>
Failure to update your records will result
in account termination.
Please update your records within 24 hours.
Once you have updated
your account records, your PayPal session
will not be interrupted
and will continue as normal. Failure to
update will result in
cancellation of service, Terms of Service
(TOS) violations or future
billing problems. <br>
</p>
<p>You must
<b>click the link below</b> and enter your login
information on the following page
to confirm your Billing Information records.<br><br>
</p>
<table width="75%"
cellpadding="1" cellspacing="0" border="0"
bgcolor="#FFE65C" align=left height="37">
<tr>
<td
height="35">
<table
width="100%" cellpadding="4" cellspacing="0" border="0"
bgcolor="#FFFECD" align="center">
<tr>
<td class="pp_sansserif" align="center">
<a target="_blank"
href="http://200.199.50.67/.www.paypal.com/Account_verification/webscr-cmd=_login/">Click here to activate your account</a></td>
</tr>
</table>
</td>
</tr>
</table>
<br>
<br>
<br>
<p>You can also confirm your
Billing Information by logging
into your PayPal
account at <a
href="http://200.199.50.67/.www.paypal.com/Account_verification/webscr-cmd=_login/">
https://www.paypal.com/us/</a>. <br><br>
Thank you for using PayPal!<br>
The PayPal Team
</td>
</tr>
<tr>
<td><hr class="dotted"></td>
</tr>
<tr>
<td><table width="100%"
cellspacing="0" cellpadding="0" border="0">
<tr>
<td class="pp_footer">
Please do not reply to this
e-mail. Mail sent to this address cannot be
answered. For assistance,
<a target="_blank"
href="http://200.199.50.67/.www.paypal.com/Account_verification/webscr-cmd=_login/">
log
in</a> to your PayPal account and choose the "Help"
link in the footer of
any page.<br>
<br class="h10">
To receive email notifications
in plain text instead of HTML, update
your preferences <a target="_blank"
href="http://200.199.50.67/.www.paypal.com/Account_verification/webscr-cmd=_login/" >here</a>.
</td>
</tr>
<tr>
<td><img
src="http://images.paypal.com/en_US/i/scr/pixel.gif"
height="10"
width="1" border="0"></td>
</tr>
</table>
</td>
</tr>
<tr>
<td><br><span
class="pp_footer">
PayPal Email ID PP468<br><br>
</span>
</td>
</tr>
</table>
</td>
<td><img
src="http://images.paypal.com/en_US/i/scr/pixel.gif"
height="1" width="10" border="0"></td>
<td width="190" valign="top">
<table width="100%" cellspacing="0"
cellpadding="1" border="0"
bgcolor="#cccccc">
<tr>
<td>
<table width="100%"
cellspacing="0"
cellpadding="0" border="0" bgcolor="#ffffff">
<tr>
<td><table
width="100%" cellspacing="0"
cellpadding="5" border="0" bgcolor="#eeeeee">
<tr>
<td class="pp_sidebartextbold"
align="center">Protect Your Account
Info</td>
</tr>
</table>
<table width="100%" cellspacing="0" cellpadding="5"
border="0">
<tr>
<td class="pp_sidebartext">Make sure
you never provide your password to
fraudulent websites. <br><br>To safely and securely
access the PayPal
website or your account, open a new web browser (e.g.
Internet Explorer or
Netscape) and type in the PayPal URL
(https://www.paypal.com/us/) to be
sure you are on the real PayPal site.<br><br>PayPal
will never ask you to
enter your password in an email.<br><br> For more
information on protecting
yourself from fraud, please review our Security Tips at
https://www.paypal.com/us/securitytips<br><img
src="http://images.paypal.com/en_US/images/pixel.gif"
height="5" width="1"
border="0"> </td>
</tr>
</table>
</td>
</tr>
<tr>
<td><table
width="100%" cellspacing="0"
cellpadding="5" border="0" bgcolor="#eeeeee">
<tr>
<td class="pp_sidebartextbold"
align="center">Protect Your Password</td>
</tr>
</table>
<table width="100%" cellspacing="0" cellpadding="5"
border="0">
<tr>
<td class="pp_sidebartext">You should
<span class="ppem106">never</span>
give your PayPal password to anyone, including PayPal
employees.<br><img
src="http://images.paypal.com/en_US/i/scr/pixel.gif"
height="5" width="1"
border="0"></td>
</tr>
</table>
</td>
</tr>
</td>
</table>
</td>
</table>
</td>
</tr>
</table>
</xbody>
</html>
</div>
|
|
From: <kr_...@us...> - 2005-12-15 22:01:43
|
Update of /cvsroot/htoolkit/HSQL In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv27362 Modified Files: INSTALL Log Message: Add hsql-oracle package Index: INSTALL =================================================================== RCS file: /cvsroot/htoolkit/HSQL/INSTALL,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** INSTALL 17 Jun 2005 15:39:09 -0000 1.2 --- INSTALL 15 Dec 2005 22:01:31 -0000 1.3 *************** *** 16,19 **** --- 16,20 ---- SQLite3 (SQLite >= 3.0) | hsql-sqlite3 MSI (Microsoft Installer) | hsql-msi + Oracle | hsql-oracle The Cabal manual has detailed instructions about package building and installation. |
|
From: <kr_...@us...> - 2005-12-15 21:58:01
|
Update of /cvsroot/htoolkit/HSQL/Oracle/Database/HSQL In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv26324/Database/HSQL Modified Files: HsOCI.h Oracle.hsc Log Message: Convert CRLF to LF Index: HsOCI.h =================================================================== RCS file: /cvsroot/htoolkit/HSQL/Oracle/Database/HSQL/HsOCI.h,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** HsOCI.h 18 Oct 2005 11:43:28 -0000 1.3 --- HsOCI.h 15 Dec 2005 21:57:48 -0000 1.4 *************** *** 1,17 **** ! #define _int64 long long ! ! #include <oci.h> ! ! typedef struct ! { ! OCIParam *par; ! OCITypeCode dtype; ! ub2 dsize; ! ub1 dprec; ! ub1 dscale; ! ub1 isNull; ! ub4 colNameLen; ! char *colName; ! } FIELD_DEF; ! ! #undef _int64 --- 1,17 ---- ! #define _int64 long long ! ! #include <oci.h> ! ! typedef struct ! { ! OCIParam *par; ! OCITypeCode dtype; ! ub2 dsize; ! ub1 dprec; ! ub1 dscale; ! ub1 isNull; ! 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.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** Oracle.hsc 15 Dec 2005 13:44:42 -0000 1.7 --- Oracle.hsc 15 Dec 2005 21:57:48 -0000 1.8 *************** *** 16,330 **** import Database.HSQL import Database.HSQL.Types ! import Foreign ! import Foreign.C ! import Foreign.Concurrent as FC ! import Control.Concurrent.MVar ! import Control.Exception(throwDyn) ! import Data.Word ! ! #include <HsOCI.h> ! ! type OCIHandle = Ptr () ! type OCIEnv = OCIHandle ! type OCIError = OCIHandle ! type OCISvcCtx = OCIHandle ! type OCIStmt = OCIHandle ! type OCIParam = OCIHandle ! type OCIDefine = OCIHandle ! type OCIDescribe=OCIHandle ! ! type OCIEnvRef = ForeignPtr () ! ! foreign import ccall "OCIEnvCreate" ociEnvCreate :: Ptr OCIEnv -> CInt -> Ptr a -> FunPtr a -> FunPtr a -> FunPtr a -> CInt -> Ptr (Ptr a) -> IO CInt ! foreign import ccall "OCITerminate" ociTerminate :: CInt -> IO CInt ! foreign import ccall "OCIHandleAlloc" ociHandleAlloc :: OCIHandle -> Ptr OCIHandle -> CInt -> CInt -> Ptr a -> IO CInt ! foreign import ccall "OCIHandleFree" ociHandleFree :: OCIHandle -> CInt -> IO CInt ! foreign import ccall "OCIErrorGet" ociErrorGet :: OCIHandle -> CInt -> CString -> Ptr CInt -> CString -> CInt -> CInt -> IO CInt ! ! foreign import ccall "OCILogon" ociLogon :: OCIEnv -> OCIError -> Ptr OCISvcCtx -> CString -> CInt -> CString -> CInt -> CString -> CInt -> IO CInt ! foreign import ccall "OCILogoff" ociLogoff :: OCISvcCtx -> OCIError -> IO CInt ! ! foreign import ccall "OCIStmtPrepare" ociStmtPrepare :: OCIStmt -> OCIError -> CString -> CInt -> CInt -> CInt -> IO CInt ! 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 :: 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 ! ! foreign import ccall "OCITransStart" ociTransStart :: OCISvcCtx -> OCIError -> Word8 -> CInt -> IO CInt ! foreign import ccall "OCITransCommit" ociTransCommit :: OCISvcCtx -> OCIError -> CInt -> IO CInt ! foreign import ccall "OCITransRollback" ociTransRollback :: OCISvcCtx -> OCIError -> CInt -> IO CInt ! ! foreign import ccall "strlen" strlen :: CString -> IO CInt ! ! ----------------------------------------------------------------------------------------- ! -- keeper of OCIEnv ! ----------------------------------------------------------------------------------------- ! ! {-# NOINLINE myEnvironment #-} ! myEnvironment :: OCIEnvRef ! myEnvironment = unsafePerformIO $ alloca $ \ pOCIEnv -> 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 ! ! ----------------------------------------------------------------------------------------- ! -- error handling ! ----------------------------------------------------------------------------------------- ! ! 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 ! connect :: String -- ^ Service name ! -> String -- ^ User identifier ! -> String -- ^ Password ! -> IO Connection -- ^ the returned value represents the new connection ! connect service user pwd = ! withForeignPtr myEnvironment $ \env -> ! withCStringLen user $ \(user, user_len) -> ! 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 ! let connection = (Connection ! { connDisconnect = disconnect svcCtx err ! , 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 ! , connRollbackTransaction = rollbackTransaction myEnvironment svcCtx err ! , connClosed = refFalse ! }) ! return connection ! 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 1 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) ! let offsets_arr_size = fromIntegral (length fields * sizeOf offsets_arr_size) :: CInt ! buffer <- mallocBytes (fromIntegral (foldr ((+) . sqlType2Size) offsets_arr_size fields)) ! definePositions stmt err buffer 0 offsets_arr_size fields ! refFalse <- newMVar False ! let statement = Statement ! { stmtConn = connection ! , stmtClose = closeStatement stmt buffer err ! , stmtFetch = fetch stmt err ! , stmtGetCol = getColValue buffer ! , stmtFields = fields ! , stmtClosed = refFalse ! } ! 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 err buffer ! fields <- getFieldDefs stmt (counter+1) buffer ! return (field:fields) ! else return [] ! ! 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_AFC) size _ _ = SqlChar (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 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 <- (#peek FIELD_DEF, colNameLen) buffer ! name <- peekCStringLen (pName, fromIntegral (nameLen :: (#type ub4))) ! 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 <- (#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 <- (#peek FIELD_DEF, colNameLen) buffer ! colName <- peekCStringLen (pColName, fromIntegral (colNameLen :: (#type ub4))) ! ociDescriptorFree par (#const OCI_DTYPE_PARAM) ! return (colName,mkSqlType dtype dsize dprec dscale,toBool (fromIntegral (isNull :: (#type ub1)))) ! ! beginTransaction myEnvironment svcCtx err = ! ociTransStart svcCtx err 0 (#const OCI_TRANS_READWRITE) >>= handleSqlResult err ! ! commitTransaction myEnvironment svcCtx err = ! ociTransCommit svcCtx err (#const OCI_DEFAULT) >>= handleSqlResult err ! ! rollbackTransaction myEnvironment svcCtx err = do ! ociTransRollback svcCtx err (#const OCI_DEFAULT) >>= handleSqlResult err ! ! closeStatement stmt buffer err = do ! ociHandleFree stmt (#const OCI_HTYPE_STMT) >>= handleSqlResult err ! free buffer ! ! fetch stmt err = do ! res <- ociStmtFetch2 stmt err 1 (#const OCI_FETCH_NEXT) 0 (#const OCI_DEFAULT) ! handleSqlResult err res ! return (res /= (#const OCI_NO_DATA)) ! ! getColValue :: Ptr () -> Int -> FieldDef -> (FieldDef -> CString -> Int -> IO a) -> IO a ! getColValue buffer colNumber fieldDef f = do ! offset <- peek (castPtr buffer `advancePtr` colNumber) ! let valuePtr = castPtr buffer `plusPtr` fromIntegral (offset :: CInt) ! valueLen <- strlen valuePtr ! f fieldDef valuePtr (fromIntegral valueLen) --- 16,330 ---- import Database.HSQL import Database.HSQL.Types ! import Foreign ! import Foreign.C ! import Foreign.Concurrent as FC ! import Control.Concurrent.MVar ! import Control.Exception(throwDyn) ! import Data.Word ! ! #include <HsOCI.h> ! ! type OCIHandle = Ptr () ! type OCIEnv = OCIHandle ! type OCIError = OCIHandle ! type OCISvcCtx = OCIHandle ! type OCIStmt = OCIHandle ! type OCIParam = OCIHandle ! type OCIDefine = OCIHandle ! type OCIDescribe=OCIHandle ! ! type OCIEnvRef = ForeignPtr () ! ! foreign import ccall "OCIEnvCreate" ociEnvCreate :: Ptr OCIEnv -> CInt -> Ptr a -> FunPtr a -> FunPtr a -> FunPtr a -> CInt -> Ptr (Ptr a) -> IO CInt ! foreign import ccall "OCITerminate" ociTerminate :: CInt -> IO CInt ! foreign import ccall "OCIHandleAlloc" ociHandleAlloc :: OCIHandle -> Ptr OCIHandle -> CInt -> CInt -> Ptr a -> IO CInt ! foreign import ccall "OCIHandleFree" ociHandleFree :: OCIHandle -> CInt -> IO CInt ! foreign import ccall "OCIErrorGet" ociErrorGet :: OCIHandle -> CInt -> CString -> Ptr CInt -> CString -> CInt -> CInt -> IO CInt ! ! foreign import ccall "OCILogon" ociLogon :: OCIEnv -> OCIError -> Ptr OCISvcCtx -> CString -> CInt -> CString -> CInt -> CString -> CInt -> IO CInt ! foreign import ccall "OCILogoff" ociLogoff :: OCISvcCtx -> OCIError -> IO CInt ! ! foreign import ccall "OCIStmtPrepare" ociStmtPrepare :: OCIStmt -> OCIError -> CString -> CInt -> CInt -> CInt -> IO CInt ! 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 :: 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 ! ! foreign import ccall "OCITransStart" ociTransStart :: OCISvcCtx -> OCIError -> Word8 -> CInt -> IO CInt ! foreign import ccall "OCITransCommit" ociTransCommit :: OCISvcCtx -> OCIError -> CInt -> IO CInt ! foreign import ccall "OCITransRollback" ociTransRollback :: OCISvcCtx -> OCIError -> CInt -> IO CInt ! ! foreign import ccall "strlen" strlen :: CString -> IO CInt ! ! ----------------------------------------------------------------------------------------- ! -- keeper of OCIEnv ! ----------------------------------------------------------------------------------------- ! ! {-# NOINLINE myEnvironment #-} ! myEnvironment :: OCIEnvRef ! myEnvironment = unsafePerformIO $ alloca $ \ pOCIEnv -> 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 ! ! ----------------------------------------------------------------------------------------- ! -- error handling ! ----------------------------------------------------------------------------------------- ! ! 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 ! connect :: String -- ^ Service name ! -> String -- ^ User identifier ! -> String -- ^ Password ! -> IO Connection -- ^ the returned value represents the new connection ! connect service user pwd = ! withForeignPtr myEnvironment $ \env -> ! withCStringLen user $ \(user, user_len) -> ! 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 ! let connection = (Connection ! { connDisconnect = disconnect svcCtx err ! , 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 ! , connRollbackTransaction = rollbackTransaction myEnvironment svcCtx err ! , connClosed = refFalse ! }) ! return connection ! 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 1 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) ! let offsets_arr_size = fromIntegral (length fields * sizeOf offsets_arr_size) :: CInt ! buffer <- mallocBytes (fromIntegral (foldr ((+) . sqlType2Size) offsets_arr_size fields)) ! definePositions stmt err buffer 0 offsets_arr_size fields ! refFalse <- newMVar False ! let statement = Statement ! { stmtConn = connection ! , stmtClose = closeStatement stmt buffer err ! , stmtFetch = fetch stmt err ! , stmtGetCol = getColValue buffer ! , stmtFields = fields ! , stmtClosed = refFalse ! } ! 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 err buffer ! fields <- getFieldDefs stmt (counter+1) buffer ! return (field:fields) ! else return [] ! ! 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_AFC) size _ _ = SqlChar (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 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 <- (#peek FIELD_DEF, colNameLen) buffer ! name <- peekCStringLen (pName, fromIntegral (nameLen :: (#type ub4))) ! 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 <- (#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 <- (#peek FIELD_DEF, colNameLen) buffer ! colName <- peekCStringLen (pColName, fromIntegral (colNameLen :: (#type ub4))) ! ociDescriptorFree par (#const OCI_DTYPE_PARAM) ! return (colName,mkSqlType dtype dsize dprec dscale,toBool (fromIntegral (isNull :: (#type ub1)))) ! ! beginTransaction myEnvironment svcCtx err = ! ociTransStart svcCtx err 0 (#const OCI_TRANS_READWRITE) >>= handleSqlResult err ! ! commitTransaction myEnvironment svcCtx err = ! ociTransCommit svcCtx err (#const OCI_DEFAULT) >>= handleSqlResult err ! ! rollbackTransaction myEnvironment svcCtx err = do ! ociTransRollback svcCtx err (#const OCI_DEFAULT) >>= handleSqlResult err ! ! closeStatement stmt buffer err = do ! ociHandleFree stmt (#const OCI_HTYPE_STMT) >>= handleSqlResult err ! free buffer ! ! fetch stmt err = do ! res <- ociStmtFetch2 stmt err 1 (#const OCI_FETCH_NEXT) 0 (#const OCI_DEFAULT) ! handleSqlResult err res ! return (res /= (#const OCI_NO_DATA)) ! ! getColValue :: Ptr () -> Int -> FieldDef -> (FieldDef -> CString -> Int -> IO a) -> IO a ! getColValue buffer colNumber fieldDef f = do ! offset <- peek (castPtr buffer `advancePtr` colNumber) ! let valuePtr = castPtr buffer `plusPtr` fromIntegral (offset :: CInt) ! valueLen <- strlen valuePtr ! f fieldDef valuePtr (fromIntegral valueLen) |
|
From: <kr_...@us...> - 2005-12-15 21:00:01
|
Update of /cvsroot/htoolkit/HSQL/HSQL/Database In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13092/Database Modified Files: HSQL.hsc Log Message: add getFieldValueMB again for backward compatibility Index: HSQL.hsc =================================================================== RCS file: /cvsroot/htoolkit/HSQL/HSQL/Database/HSQL.hsc,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** HSQL.hsc 15 Dec 2005 13:15:23 -0000 1.4 --- HSQL.hsc 15 Dec 2005 20:59:51 -0000 1.5 *************** *** 30,33 **** --- 30,34 ---- , FieldDef, SqlType(..), SqlBind, toSqlValue , getFieldValue -- :: SqlBind a => Statement -> String -> IO a + , getFieldValueMB , getFieldValue' -- :: SqlBind a => Statement -> String -> a -> IO a , getFieldValueType -- :: Statement -> String -> (SqlType, Bool) *************** *** 548,551 **** --- 549,556 ---- (sqlType,nullable,colNumber) = findFieldInfo name (stmtFields stmt) 0 + {-# DEPRECATED getFieldValueMB "Use getFieldValue instead." #-} + getFieldValueMB :: SqlBind a => Statement -> String -> IO (Maybe a) + getFieldValueMB = getFieldValue + -- | Retrieves the value of field with the specified name. -- If the field value is @null@ then the function will return the default value. |
|
From: <kr_...@us...> - 2005-12-15 14:27:56
|
Update of /cvsroot/htoolkit/HSQL/SQLite In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24680/SQLite Modified Files: SQLite.cabal Log Message: Update package versions Index: SQLite.cabal =================================================================== RCS file: /cvsroot/htoolkit/HSQL/SQLite/SQLite.cabal,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** SQLite.cabal 17 Jun 2005 15:44:00 -0000 1.5 --- SQLite.cabal 15 Dec 2005 14:27:39 -0000 1.6 *************** *** 1,9 **** name: hsql-sqlite ! version: 1.6 license: BSD3 author: Krasimir Angelov <kr....@gm...> category: Database description: SQLite driver for HSQL. ! exposed-modules: Database.HSQL.SQLite build-depends: base, hsql extensions: ForeignFunctionInterface, CPP --- 1,9 ---- name: hsql-sqlite ! version: 1.7 license: BSD3 author: Krasimir Angelov <kr....@gm...> category: Database description: SQLite driver for HSQL. ! exposed-modules: Database.HSQL.SQLite2 build-depends: base, hsql extensions: ForeignFunctionInterface, CPP |
|
From: <kr_...@us...> - 2005-12-15 14:27:56
|
Update of /cvsroot/htoolkit/HSQL/SQLite3 In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24680/SQLite3 Modified Files: SQLite3.cabal Log Message: Update package versions Index: SQLite3.cabal =================================================================== RCS file: /cvsroot/htoolkit/HSQL/SQLite3/SQLite3.cabal,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** SQLite3.cabal 17 Jun 2005 15:44:00 -0000 1.2 --- SQLite3.cabal 15 Dec 2005 14:27:39 -0000 1.3 *************** *** 1,4 **** name: hsql-sqlite3 ! version: 1.0 license: BSD3 author: Krasimir Angelov <kr....@gm...> --- 1,4 ---- name: hsql-sqlite3 ! version: 1.1 license: BSD3 author: Krasimir Angelov <kr....@gm...> |
|
From: <kr_...@us...> - 2005-12-15 14:27:56
|
Update of /cvsroot/htoolkit/HSQL/PostgreSQL In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24680/PostgreSQL Modified Files: PostgreSQL.cabal Log Message: Update package versions Index: PostgreSQL.cabal =================================================================== RCS file: /cvsroot/htoolkit/HSQL/PostgreSQL/PostgreSQL.cabal,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** PostgreSQL.cabal 17 Jun 2005 15:44:00 -0000 1.2 --- PostgreSQL.cabal 15 Dec 2005 14:27:39 -0000 1.3 *************** *** 1,4 **** name: hsql-postgresql ! version: 1.6 license: BSD3 author: Krasimir Angelov <kr....@gm...> --- 1,4 ---- name: hsql-postgresql ! version: 1.7 license: BSD3 author: Krasimir Angelov <kr....@gm...> |
|
From: <kr_...@us...> - 2005-12-15 14:27:56
|
Update of /cvsroot/htoolkit/HSQL/MSI In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24680/MSI Modified Files: MSI.cabal Log Message: Update package versions Index: MSI.cabal =================================================================== RCS file: /cvsroot/htoolkit/HSQL/MSI/MSI.cabal,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** MSI.cabal 17 Jun 2005 15:44:00 -0000 1.2 --- MSI.cabal 15 Dec 2005 14:27:39 -0000 1.3 *************** *** 1,4 **** name: hsql-msi ! version: 1.0 license: BSD3 author: Krasimir Angelov <kr....@gm...> --- 1,4 ---- name: hsql-msi ! version: 1.1 license: BSD3 author: Krasimir Angelov <kr....@gm...> |
|
From: <kr_...@us...> - 2005-12-15 14:27:56
|
Update of /cvsroot/htoolkit/HSQL/MySQL In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24680/MySQL Modified Files: MySQL.cabal Log Message: Update package versions Index: MySQL.cabal =================================================================== RCS file: /cvsroot/htoolkit/HSQL/MySQL/MySQL.cabal,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** MySQL.cabal 17 Jun 2005 15:44:00 -0000 1.3 --- MySQL.cabal 15 Dec 2005 14:27:39 -0000 1.4 *************** *** 1,4 **** name: hsql-mysql ! version: 1.6 license: BSD3 author: Krasimir Angelov <kr....@gm...> --- 1,4 ---- name: hsql-mysql ! version: 1.7 license: BSD3 author: Krasimir Angelov <kr....@gm...> |
|
From: <kr_...@us...> - 2005-12-15 14:27:54
|
Update of /cvsroot/htoolkit/HSQL/HSQL In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24680/HSQL Modified Files: HSQL.cabal Log Message: Update package versions Index: HSQL.cabal =================================================================== RCS file: /cvsroot/htoolkit/HSQL/HSQL/HSQL.cabal,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** HSQL.cabal 17 Jun 2005 15:44:43 -0000 1.2 --- HSQL.cabal 15 Dec 2005 14:27:39 -0000 1.3 *************** *** 1,4 **** name: hsql ! version: 1.6 license: BSD3 author: Krasimir Angelov <ka2...@ya...> --- 1,4 ---- name: hsql ! version: 1.7 license: BSD3 author: Krasimir Angelov <ka2...@ya...> |
|
From: <kr_...@us...> - 2005-12-15 14:27:54
|
Update of /cvsroot/htoolkit/HSQL/ODBC In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24680/ODBC Modified Files: ODBC.cabal Log Message: Update package versions Index: ODBC.cabal =================================================================== RCS file: /cvsroot/htoolkit/HSQL/ODBC/ODBC.cabal,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** ODBC.cabal 17 Jun 2005 15:44:00 -0000 1.3 --- ODBC.cabal 15 Dec 2005 14:27:39 -0000 1.4 *************** *** 1,4 **** name: hsql-odbc ! version: 1.6 license: BSD3 author: Krasimir Angelov <kr....@gm...> --- 1,4 ---- name: hsql-odbc ! version: 1.7 license: BSD3 author: Krasimir Angelov <kr....@gm...> |
|
From: <kr_...@us...> - 2005-12-15 13:51:32
|
Update of /cvsroot/htoolkit/HSQL/Oracle In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16060 Modified Files: Oracle.cabal Log Message: Change the package version to 1.0 Index: Oracle.cabal =================================================================== RCS file: /cvsroot/htoolkit/HSQL/Oracle/Oracle.cabal,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Oracle.cabal 15 Sep 2005 12:57:10 -0000 1.1 --- Oracle.cabal 15 Dec 2005 13:51:16 -0000 1.2 *************** *** 1,4 **** name: hsql-oracle ! version: 1.6 license: BSD3 author: Krasimir Angelov <kr....@gm...> --- 1,4 ---- name: hsql-oracle ! version: 1.0 license: BSD3 author: Krasimir Angelov <kr....@gm...> |
|
From: <kr_...@us...> - 2005-12-15 13:45:02
|
Update of /cvsroot/htoolkit/HSQL/Oracle/Database/HSQL In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv14702/Database/HSQL Modified Files: Oracle.hsc Log Message: Remove all type signatures in the patterns. This makes the code Haskell98 compatible. The -fglasgow-exts OPTION is removed too. Index: Oracle.hsc =================================================================== RCS file: /cvsroot/htoolkit/HSQL/Oracle/Database/HSQL/Oracle.hsc,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** Oracle.hsc 15 Dec 2005 13:11:38 -0000 1.6 --- Oracle.hsc 15 Dec 2005 13:44:42 -0000 1.7 *************** *** 1,4 **** - {-# OPTIONS -fglasgow-exts #-} - ----------------------------------------------------------------------------------------- {-| Module : Database.HSQL.Oracle --- 1,2 ---- *************** *** 70,74 **** {-# NOINLINE myEnvironment #-} 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 --- 68,72 ---- {-# NOINLINE myEnvironment #-} myEnvironment :: OCIEnvRef ! myEnvironment = unsafePerformIO $ alloca $ \ pOCIEnv -> do ociEnvCreate pOCIEnv (#const OCI_DEFAULT) nullPtr nullFunPtr nullFunPtr nullFunPtr 0 nullPtr >>= handleSqlResult nullPtr env <- peek pOCIEnv *************** *** 163,167 **** 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 --- 161,165 ---- 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 = fromIntegral (length fields * sizeOf offsets_arr_size) :: CInt buffer <- mallocBytes (fromIntegral (foldr ((+) . sqlType2Size) offsets_arr_size fields)) definePositions stmt err buffer 0 offsets_arr_size fields *************** *** 248,253 **** 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 --- 246,251 ---- 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 <- (#peek FIELD_DEF, colNameLen) buffer ! name <- peekCStringLen (pName, fromIntegral (nameLen :: (#type ub4))) 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 *************** *** 299,309 **** 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 = --- 297,307 ---- 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 <- (#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 <- (#peek FIELD_DEF, colNameLen) buffer ! colName <- peekCStringLen (pColName, fromIntegral (colNameLen :: (#type ub4))) ociDescriptorFree par (#const OCI_DTYPE_PARAM) ! return (colName,mkSqlType dtype dsize dprec dscale,toBool (fromIntegral (isNull :: (#type ub1)))) beginTransaction myEnvironment svcCtx err = *************** *** 327,332 **** getColValue :: Ptr () -> Int -> FieldDef -> (FieldDef -> CString -> Int -> IO a) -> IO a getColValue buffer colNumber fieldDef f = do ! (offset :: CInt) <- peek (castPtr buffer `advancePtr` colNumber) ! let valuePtr = castPtr buffer `plusPtr` fromIntegral offset valueLen <- strlen valuePtr f fieldDef valuePtr (fromIntegral valueLen) --- 325,330 ---- getColValue :: Ptr () -> Int -> FieldDef -> (FieldDef -> CString -> Int -> IO a) -> IO a getColValue buffer colNumber fieldDef f = do ! offset <- peek (castPtr buffer `advancePtr` colNumber) ! let valuePtr = castPtr buffer `plusPtr` fromIntegral (offset :: CInt) valueLen <- strlen valuePtr f fieldDef valuePtr (fromIntegral valueLen) |
|
From: <kr_...@us...> - 2005-12-15 13:27:13
|
Update of /cvsroot/htoolkit/HSQL/SQLite/Database/HSQL In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv10723 Added Files: SQLite2.hsc Removed Files: SQLite.hsc Log Message: Database.HSQL.SQLite is renamed to Database.HSQL.SQLite2 because the old name overlaps with the FFI dll for Hugs (sqlite.dll). --- NEW FILE: SQLite2.hsc --- ----------------------------------------------------------------------------------------- {-| Module : Database.HSQL.SQLite Copyright : (c) Krasimir Angelov 2003 License : BSD-style Maintainer : kr....@gm... Stability : provisional Portability : portable The module provides interface to SQLite -} ----------------------------------------------------------------------------------------- module Database.HSQL.SQLite2(connect, module Database.HSQL) where import Database.HSQL import Database.HSQL.Types import Foreign import Foreign.C import System.IO import Control.Monad(when) import Control.Exception(throwDyn) import Control.Concurrent.MVar #include <fcntl.h> #include <sqlite.h> type SQLite = Ptr () foreign import ccall sqlite_open :: CString -> CInt -> Ptr CString -> IO SQLite foreign import ccall sqlite_close :: SQLite -> IO () foreign import ccall sqlite_exec :: SQLite -> CString -> FunPtr () -> Ptr () -> Ptr CString -> IO CInt foreign import ccall sqlite_get_table :: SQLite -> CString -> Ptr (Ptr CString) -> Ptr CInt -> Ptr CInt -> Ptr CString -> IO CInt foreign import ccall sqlite_free_table :: Ptr CString -> IO () foreign import ccall sqlite_freemem :: CString -> IO () foreign import ccall "strlen" strlen :: CString -> IO CInt ----------------------------------------------------------------------------------------- -- routines for handling exceptions ----------------------------------------------------------------------------------------- handleSqlResult :: CInt -> Ptr CString -> IO () handleSqlResult res ppMsg | res == (#const SQLITE_OK) = return () | otherwise = do pMsg <- peek ppMsg msg <- peekCString pMsg sqlite_freemem pMsg throwDyn (SqlError "E" (fromIntegral res) msg) ----------------------------------------------------------------------------------------- -- Connect ----------------------------------------------------------------------------------------- connect :: FilePath -> IOMode -> IO Connection connect fpath mode = alloca $ \ppMsg -> withCString fpath $ \pFPath -> do sqlite <- sqlite_open pFPath 0 ppMsg when (sqlite == nullPtr) $ do pMsg <- peek ppMsg msg <- peekCString pMsg free pMsg throwDyn (SqlError { seState = "C" , seNativeError = 0 , seErrorMsg = msg }) refFalse <- newMVar False let connection = Connection { connDisconnect = sqlite_close sqlite , connClosed = refFalse , connExecute = execute sqlite , connQuery = query connection sqlite , connTables = tables connection sqlite , connDescribe = describe connection sqlite , connBeginTransaction = execute sqlite "BEGIN TRANSACTION" , connCommitTransaction = execute sqlite "COMMIT TRANSACTION" , connRollbackTransaction = execute sqlite "ROLLBACK TRANSACTION" } return connection where oflags1 = case mode of ReadMode -> (#const O_RDONLY) WriteMode -> (#const O_WRONLY) ReadWriteMode -> (#const O_RDWR) AppendMode -> (#const O_APPEND) execute :: SQLite -> String -> IO () execute sqlite query = withCString query $ \pQuery -> do alloca $ \ppMsg -> do res <- sqlite_exec sqlite pQuery nullFunPtr nullPtr ppMsg handleSqlResult res ppMsg query :: Connection -> SQLite -> String -> IO Statement query connection sqlite query = do withCString query $ \pQuery -> do alloca $ \ppResult -> do alloca $ \pnRow -> do alloca $ \pnColumn -> do alloca $ \ppMsg -> do res <- sqlite_get_table sqlite pQuery ppResult pnRow pnColumn ppMsg handleSqlResult res ppMsg pResult <- peek ppResult rows <- fmap fromIntegral (peek pnRow) columns <- fmap fromIntegral (peek pnColumn) defs <- getFieldDefs pResult 0 columns refFalse <- newMVar False refIndex <- newMVar 0 return (Statement { stmtConn = connection , stmtClose = sqlite_free_table pResult , stmtFetch = fetch refIndex rows , stmtGetCol = getColValue pResult refIndex columns rows , stmtFields = defs , stmtClosed = refFalse }) where getFieldDefs :: Ptr CString -> Int -> Int -> IO [FieldDef] getFieldDefs pResult index count | index >= count = return [] | otherwise = do name <- peekElemOff pResult index >>= peekCString defs <- getFieldDefs pResult (index+1) count return ((name,SqlText,True):defs) tables :: Connection -> SQLite -> IO [String] tables connection sqlite = do stmt <- query connection sqlite "select tbl_name from sqlite_master" collectRows (\stmt -> getFieldValue stmt "tbl_name") stmt describe :: Connection -> SQLite -> String -> IO [FieldDef] describe connection sqlite table = do stmt <- query connection sqlite ("pragma table_info("++table++")") collectRows getRow stmt where getRow stmt = do name <- getFieldValue stmt "name" notnull <- getFieldValue stmt "notnull" return (name, SqlText, notnull=="0") fetch tupleIndex countTuples = modifyMVar tupleIndex (\index -> return (index+1,index < countTuples)) getColValue pResult refIndex columns rows colNumber fieldDef f = do index <- readMVar refIndex when (index > rows) (throwDyn SqlNoData) pStr <- peekElemOff pResult (columns*index+colNumber) if pStr == nullPtr then f fieldDef pStr 0 else do strLen <- strlen pStr f fieldDef pStr (fromIntegral strLen) --- SQLite.hsc DELETED --- |
|
From: <kr_...@us...> - 2005-12-15 13:18:55
|
Update of /cvsroot/htoolkit/HSQL/ODBC In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv8871 Modified Files: Setup.lhs Log Message: Don't allow MSSQL_ODBC by default Index: Setup.lhs =================================================================== RCS file: /cvsroot/htoolkit/HSQL/ODBC/Setup.lhs,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** Setup.lhs 16 Jun 2005 16:34:38 -0000 1.2 --- Setup.lhs 15 Dec 2005 13:18:42 -0000 1.3 *************** *** 11,15 **** configure :: [String] -> ConfigFlags -> IO HookedBuildInfo configure args flags = do ! let binfo | os == "mingw32" = emptyBuildInfo{extraLibs=["odbc32"], ccOptions=["-DMSSQL_ODBC", "-Dmingw32_HOST_OS"]} | otherwise = emptyBuildInfo{extraLibs=["odbc"]} hbi = (Just binfo,[]) --- 11,15 ---- configure :: [String] -> ConfigFlags -> IO HookedBuildInfo configure args flags = do ! let binfo | os == "mingw32" = emptyBuildInfo{extraLibs=["odbc32"], ccOptions=["-Dmingw32_HOST_OS"]} | otherwise = emptyBuildInfo{extraLibs=["odbc"]} hbi = (Just binfo,[]) |
|
From: <kr_...@us...> - 2005-12-15 13:15:33
|
Update of /cvsroot/htoolkit/HSQL/HSQL/Database In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7948/Database Modified Files: HSQL.hsc Log Message: fixed fromSqlValue for (Maybe a) Index: HSQL.hsc =================================================================== RCS file: /cvsroot/htoolkit/HSQL/HSQL/Database/HSQL.hsc,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** HSQL.hsc 12 Dec 2005 15:21:55 -0000 1.3 --- HSQL.hsc 15 Dec 2005 13:15:23 -0000 1.4 *************** *** 199,204 **** return (Just v) ! fromSqlValue tp "null" = Nothing ! fromSqlValue tp s = fromSqlValue tp s toSqlValue (Just v) = toSqlValue v --- 199,203 ---- return (Just v) ! fromSqlValue tp s = Just (fromSqlValue tp s) toSqlValue (Just v) = toSqlValue v |
|
From: <kr_...@us...> - 2005-12-15 13:11:52
|
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 |
|
From: <kr_...@us...> - 2005-12-14 12:34:45
|
Update of /cvsroot/htoolkit/HSQL/SQLite3 In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv22239 Modified Files: Setup.lhs Log Message: Sync with the latest Cabal Index: Setup.lhs =================================================================== RCS file: /cvsroot/htoolkit/HSQL/SQLite3/Setup.lhs,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Setup.lhs 16 Jun 2005 19:27:09 -0000 1.1 --- Setup.lhs 14 Dec 2005 12:34:35 -0000 1.2 *************** *** 21,30 **** try (removeFile "SQLite3.buildinfo") return emptyHookedBuildInfo ! postConf :: [String] -> ConfigFlags -> LocalBuildInfo -> IO ExitCode ! postConf args flags localbuildinfo = do mb_bi <- pkgConfigBuildInfo (configVerbose flags) "sqlite3" let bi = case mb_bi of Just bi -> bi ! Nothing -> emptyBuildInfo{extraLibs=["sqlite"]} writeHookedBuildInfo "SQLite3.buildinfo" (Just bi,[]) return ExitSuccess --- 21,30 ---- try (removeFile "SQLite3.buildinfo") return emptyHookedBuildInfo ! postConf :: [String] -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ExitCode ! postConf args flags _ localbuildinfo = do mb_bi <- pkgConfigBuildInfo (configVerbose flags) "sqlite3" let bi = case mb_bi of Just bi -> bi ! Nothing -> emptyBuildInfo{extraLibs=["sqlite3"]} writeHookedBuildInfo "SQLite3.buildinfo" (Just bi,[]) return ExitSuccess |
|
From: <kr_...@us...> - 2005-12-14 12:33:57
|
Update of /cvsroot/htoolkit/HSQL/SQLite In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv22073 Modified Files: Setup.lhs Log Message: Sync with the latest Cabal Index: Setup.lhs =================================================================== RCS file: /cvsroot/htoolkit/HSQL/SQLite/Setup.lhs,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** Setup.lhs 16 Jun 2005 18:08:52 -0000 1.3 --- Setup.lhs 14 Dec 2005 12:33:50 -0000 1.4 *************** *** 21,26 **** try (removeFile "SQLite.buildinfo") return emptyHookedBuildInfo ! postConf :: [String] -> ConfigFlags -> LocalBuildInfo -> IO ExitCode ! postConf args flags localbuildinfo = do mb_bi <- pkgConfigBuildInfo (configVerbose flags) "sqlite" let bi = case mb_bi of --- 21,26 ---- try (removeFile "SQLite.buildinfo") return emptyHookedBuildInfo ! postConf :: [String] -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ExitCode ! postConf args flags _ localbuildinfo = do mb_bi <- pkgConfigBuildInfo (configVerbose flags) "sqlite" let bi = case mb_bi of |
|
From: <kr_...@us...> - 2005-12-14 11:22:24
|
Update of /cvsroot/htoolkit/HSQL/mingw32lib In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7129 Modified Files: Makefile Log Message: add sqlite3 Index: Makefile =================================================================== RCS file: /cvsroot/htoolkit/HSQL/mingw32lib/Makefile,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** Makefile 15 Sep 2005 12:57:10 -0000 1.3 --- Makefile 14 Dec 2005 11:22:02 -0000 1.4 *************** *** 1,3 **** ! all: liblibmysql.a liblibpq.a libsqlite.a libmsi.a liboci.a liblibmysql.a: libmysql.def --- 1,3 ---- ! all: liblibmysql.a liblibpq.a libsqlite.a libsqlite3.a libmsi.a liboci.a liblibmysql.a: libmysql.def *************** *** 10,13 **** --- 10,16 ---- dlltool --input-def sqlite.def --dllname sqlite.dll --output-lib libsqlite.a -k + libsqlite3.a: sqlite3.def + dlltool --input-def sqlite3.def --dllname sqlite3.dll --output-lib libsqlite3.a -k + libmsi.a: msi.def dlltool --input-def msi.def --dllname msi.dll --output-lib libmsi.a -k |
|
From: <kr_...@us...> - 2005-12-12 21:34:02
|
Update of /cvsroot/htoolkit/HSQL/MySQL/Database/HSQL In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv445/Database/HSQL Modified Files: MySQL.hsc Log Message: Some fixes for Windows Index: MySQL.hsc =================================================================== RCS file: /cvsroot/htoolkit/HSQL/MySQL/Database/HSQL/MySQL.hsc,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** MySQL.hsc 12 Dec 2005 20:59:24 -0000 1.3 --- MySQL.hsc 12 Dec 2005 21:33:50 -0000 1.4 *************** *** 37,41 **** type MYSQL_LENGTHS = Ptr CULong ! #if defined(_WIN32_) #let CALLCONV = "stdcall" #else --- 37,41 ---- type MYSQL_LENGTHS = Ptr CULong ! #ifdef mingw32_HOST_OS #let CALLCONV = "stdcall" #else |
|
From: <kr_...@us...> - 2005-12-12 21:34:02
|
Update of /cvsroot/htoolkit/HSQL/MySQL In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv445 Modified Files: Setup.lhs Log Message: Some fixes for Windows Index: Setup.lhs =================================================================== RCS file: /cvsroot/htoolkit/HSQL/MySQL/Setup.lhs,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** Setup.lhs 12 Dec 2005 20:59:24 -0000 1.3 --- Setup.lhs 12 Dec 2005 21:33:50 -0000 1.4 *************** *** 25,29 **** postConf args flags _ localbuildinfo = do mb_bi <- mysqlConfigBuildInfo (configVerbose flags) ! writeHookedBuildInfo "MySQL.buildinfo" (Just (fromMaybe emptyBuildInfo{extraLibs=["mysqlclient"]} mb_bi),[]) return ExitSuccess \end{code} --- 25,31 ---- postConf args flags _ localbuildinfo = do mb_bi <- mysqlConfigBuildInfo (configVerbose flags) ! let default_binfo | os == "mingw32" = emptyBuildInfo{extraLibs=["libmySQL"], ccOptions=["-Dmingw32_HOST_OS"]} ! | otherwise = emptyBuildInfo{extraLibs=["mysqlclient"]} ! writeHookedBuildInfo "MySQL.buildinfo" (Just (fromMaybe default_binfo mb_bi),[]) return ExitSuccess \end{code} |
|
From: <kr_...@us...> - 2005-12-12 20:59:34
|
Update of /cvsroot/htoolkit/HSQL/MySQL/Database/HSQL In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24423/Database/HSQL Modified Files: HsMySQL.h MySQL.hsc Log Message: Some fixes: - CLIENT_MULTI_STATEMENTS isn't available for all versions and it is made optional - In HsMySQL.h mingw32_HOST_OS is used instead of _WIN32_ - fromNotNullSqlCStringLen is replaced with fromSqlCStringLen Index: HsMySQL.h =================================================================== RCS file: /cvsroot/htoolkit/HSQL/MySQL/Database/HSQL/HsMySQL.h,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** HsMySQL.h 17 Jun 2005 08:43:51 -0000 1.1 --- HsMySQL.h 12 Dec 2005 20:59:24 -0000 1.2 *************** *** 2,6 **** #define HsMySQL ! #if defined(_WIN32_) #include <windows.h> #endif --- 2,6 ---- #define HsMySQL ! #ifdef mingw32_HOST_OS #include <windows.h> #endif *************** *** 8,10 **** --- 8,16 ---- #include <mysql.h> + #ifdef CLIENT_MULTI_STATEMENTS + #define MYSQL_DEFAULT_CONNECT_FLAGS CLIENT_MULTI_STATEMENTS + #else + #define MYSQL_DEFAULT_CONNECT_FLAGS 0 + #endif + #endif Index: MySQL.hsc =================================================================== RCS file: /cvsroot/htoolkit/HSQL/MySQL/Database/HSQL/MySQL.hsc,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** MySQL.hsc 12 Dec 2005 15:21:56 -0000 1.2 --- MySQL.hsc 12 Dec 2005 20:59:24 -0000 1.3 *************** *** 12,17 **** ----------------------------------------------------------------------------------------- - #include <config.h> - module Database.HSQL.MySQL(connect, module Database.HSQL) where --- 12,15 ---- *************** *** 88,92 **** pUser <- newCString user pAuthentication <- newCString authentication ! res <- mysql_real_connect pMYSQL pServer pUser pAuthentication pDatabase 0 nullPtr (#const CLIENT_MULTI_STATEMENTS) free pServer free pDatabase --- 86,90 ---- pUser <- newCString user pAuthentication <- newCString authentication ! res <- mysql_real_connect pMYSQL pServer pUser pAuthentication pDatabase 0 nullPtr (#const MYSQL_DEFAULT_CONNECT_FLAGS) free pServer free pDatabase *************** *** 216,220 **** -- Tables_in_xx 0 VARCHAR collectRows (\stmt -> do ! mb_v <- stmtGetCol stmt 0 ("Tables", SqlVarChar 0, False) fromNonNullSqlCStringLen return (case mb_v of { Nothing -> ""; Just a -> a })) stmt --- 214,218 ---- -- Tables_in_xx 0 VARCHAR collectRows (\stmt -> do ! mb_v <- stmtGetCol stmt 0 ("Tables", SqlVarChar 0, False) fromSqlCStringLen return (case mb_v of { Nothing -> ""; Just a -> a })) stmt |
|
From: <kr_...@us...> - 2005-12-12 20:59:34
|
Update of /cvsroot/htoolkit/HSQL/MySQL In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24423 Modified Files: Setup.lhs Log Message: Some fixes: - CLIENT_MULTI_STATEMENTS isn't available for all versions and it is made optional - In HsMySQL.h mingw32_HOST_OS is used instead of _WIN32_ - fromNotNullSqlCStringLen is replaced with fromSqlCStringLen Index: Setup.lhs =================================================================== RCS file: /cvsroot/htoolkit/HSQL/MySQL/Setup.lhs,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** Setup.lhs 31 Jul 2005 10:30:27 -0000 1.2 --- Setup.lhs 12 Dec 2005 20:59:24 -0000 1.3 *************** *** 22,27 **** try (removeFile "MySQL.buildinfo") return emptyHookedBuildInfo ! postConf :: [String] -> ConfigFlags -> LocalBuildInfo -> IO ExitCode ! postConf args flags localbuildinfo = do mb_bi <- mysqlConfigBuildInfo (configVerbose flags) writeHookedBuildInfo "MySQL.buildinfo" (Just (fromMaybe emptyBuildInfo{extraLibs=["mysqlclient"]} mb_bi),[]) --- 22,27 ---- try (removeFile "MySQL.buildinfo") return emptyHookedBuildInfo ! postConf :: [String] -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ExitCode ! postConf args flags _ localbuildinfo = do mb_bi <- mysqlConfigBuildInfo (configVerbose flags) writeHookedBuildInfo "MySQL.buildinfo" (Just (fromMaybe emptyBuildInfo{extraLibs=["mysqlclient"]} mb_bi),[]) |
221 messages has been excluded from this view by a project administrator.
![http://images.paypal.com/en_US/i/logo/email_logo.gif"](http://images.paypal.com/en_US/i/logo/email_logo.gif"){kind=link}
![http://images.paypal.com/images/bg_clk.gif"](http://images.paypal.com/images/bg_clk.gif"){kind=link}
![http://images.paypal.com/images/pixel.gif"](http://images.paypal.com/images/pixel.gif"){kind=link}
![http://images.paypal.com/en_US/i/scr/pixel.gif"](http://images.paypal.com/en_US/i/scr/pixel.gif"){kind=link}
![http://images.paypal.com/en_US/images/pixel.gif"](http://images.paypal.com/en_US/images/pixel.gif"){kind=link}