packages feed

odbc 0.2.5 → 0.2.6

raw patch · 7 files changed

+75/−40 lines, 7 filesnew-uploader

Files

CHANGELOG view
@@ -1,4 +1,11 @@-0.2.3:+0.2.6:+	* Add support for SQLSTATE+	* Fix copying issues for error messages+	* Add support for GHC 9.0+0.2.5:+	* Add binding of parameters for text/binary+	* Fix null uniqueidentifier returning non-null value+	* Include column names in output 	* Support WCHAR  0.2.2:
README.md view
@@ -155,3 +155,4 @@ * Spencer Janssen * Yo Eight * Marco Z+* Rakesh Emmadi
cbits/odbc.c view
@@ -13,7 +13,7 @@  #define FALSE 0 #define TRUE 1-#define MAXBUFLEN 512+#define MAXBUFLEN 1024  // Just a way of grouping together these two dependent resources. It's // probably not a good idea to free up an environment before freeing a@@ -23,12 +23,18 @@   SQLHENV *env;   SQLHDBC *dbc;   char *error;+  char *sqlState;+  // Allocated once in odbc_AllocEnvAndDbc and freed once in odbc_FreeEnvAndDbc. } EnvAndDbc;  char *odbc_error(EnvAndDbc *envAndDbc){   return envAndDbc->error; } +char *odbc_sqlState(EnvAndDbc *envAndDbc){+  return envAndDbc->sqlState;+}+ void odbc_ProcessLogMessages(EnvAndDbc *envAndDbc, SQLSMALLINT plm_handle_type, SQLHANDLE plm_handle, char *logstring, int ConnInd);  ////////////////////////////////////////////////////////////////////////////////@@ -100,7 +106,9 @@         EnvAndDbc *envAndDbc = malloc(sizeof *envAndDbc);         envAndDbc->env = env;         envAndDbc->dbc = dbc;-        envAndDbc->error = NULL;+        envAndDbc->error = malloc(SQL_MAX_MESSAGE_LENGTH);+        // SQLSTATE is a five-character code, see https://docs.microsoft.com/en-us/sql/odbc/reference/appendixes/appendix-a-odbc-error-codes?view=sql-server-ver15+        envAndDbc->sqlState = malloc(6);         return envAndDbc;       }     }@@ -109,6 +117,7 @@  void odbc_FreeEnvAndDbc(EnvAndDbc *envAndDbc){   free(envAndDbc->error);+  free(envAndDbc->sqlState);   odbc_SQLFreeDbc(envAndDbc->dbc);   odbc_SQLFreeEnv(envAndDbc->env);   free(envAndDbc);@@ -264,33 +273,28 @@ // Logs  void odbc_ProcessLogMessages(EnvAndDbc *envAndDbc, SQLSMALLINT plm_handle_type, SQLHANDLE plm_handle, char *logstring, int ConnInd) {-  RETCODE plm_retcode = SQL_SUCCESS;-  UCHAR plm_szSqlState[MAXBUFLEN] = "";+  // It has been fully tested that trying anything beyond 1 produces+  // the same string.+  SQLSMALLINT plg_record_number = 1;+  // The subtract-1 leaves space for zero-termination.+  SQLSMALLINT copy_this_many_bytes = MAXBUFLEN - 1;++  // These are not interesting for our use-case, but needed by+  // SQLGetDiagRec:   SDWORD plm_pfNativeError = 0L;   SWORD plm_pcbErrorMsg = 0;-  SQLSMALLINT plm_cRecNmbr = 1; -  // Temporary buffer for each message-  char *msg[MAXBUFLEN];--  // Reset the error buffer-  free(envAndDbc->error);-  envAndDbc->error = NULL;-  unsigned long errors_strlen = 0;--  while (plm_retcode != SQL_NO_DATA_FOUND) {-    plm_retcode = SQLGetDiagRec(plm_handle_type, plm_handle, plm_cRecNmbr,-                                plm_szSqlState, &plm_pfNativeError, (SQLCHAR *)msg,-                                MAXBUFLEN - 1, &plm_pcbErrorMsg);-    unsigned long msg_strlen = strlen((const char*)msg);-    // If there is something to copy, copy it onto the error buffer.-    if (msg_strlen > 0) {-      envAndDbc->error = realloc(envAndDbc->error, errors_strlen + msg_strlen + 1);-      strncpy(envAndDbc->error + errors_strlen, (const char*) msg, msg_strlen);-      errors_strlen += msg_strlen;-    }-    plm_cRecNmbr++;-  }+  // Copy the error into: envAndDbc->error+  //+  // This may fail, but in that case there's no useful error message.+  SQLGetDiagRec(plm_handle_type,+                plm_handle,+                plg_record_number,+                (SQLCHAR *)envAndDbc->sqlState,+                &plm_pfNativeError,+                (SQLCHAR *)envAndDbc->error,+                copy_this_many_bytes,+                &plm_pcbErrorMsg); }  ////////////////////////////////////////////////////////////////////////////////
odbc.cabal view
@@ -5,7 +5,7 @@              suite runs on OS X, Windows and Linux. copyright: FP Complete 2018 maintainer: chrisdone@fpcomplete.com-version:             0.2.5+version:             0.2.6 license:             BSD3 license-file:        LICENSE build-type:          Simple
src/Database/ODBC/Internal.hs view
@@ -81,8 +81,9 @@ -- throw this exception type. data ODBCException   = UnsuccessfulReturnCode !String-                           !Int16-                           !String+                           !Int16 -- ^ Return code+                           !String -- ^ Error message+                           !(Maybe String) -- ^ SQL state code, see https://docs.microsoft.com/en-us/sql/odbc/reference/appendixes/appendix-a-odbc-error-codes?view=sql-server-ver15     -- ^ An ODBC operation failed with the given return code.   | AllocationReturnedNull !String     -- ^ Allocating an ODBC resource failed.@@ -407,10 +408,11 @@  -- | Run the function with a statement. withStmt :: Ptr EnvAndDbc -> (forall s. SQLHSTMT s -> IO a) -> IO a-withStmt hdbc =+withStmt hdbc cont =   bracket     (assertNotNull "odbc_SQLAllocStmt" (odbc_SQLAllocStmt hdbc))     odbc_SQLFreeStmt+    cont  -- | Run an action in a bound thread. This is neccessary due to the -- interaction with signals in ODBC and GHC's runtime.@@ -520,12 +522,14 @@                    case state' of                      Stop state'' -> pure state''                      Continue state'' -> loop state''-              | otherwise ->+              | otherwise -> do+                sqlState <- fetchSqlState dbc                 throwIO                   (UnsuccessfulReturnCode                      "odbc_SQLFetch"                      (coerce retcode0)-                     "Unexpected return code")+                     "Unexpected return code"+                     sqlState)   if cols > 0     then loop state0     else pure state0@@ -566,12 +570,14 @@                      sequence                        (zipWith (getData dbc stmt) [SQLUSMALLINT 1 ..] types)                    loop (rows . (fields :))-              | otherwise ->+              | otherwise -> do+                sqlState <- fetchSqlState dbc                 throwIO                   (UnsuccessfulReturnCode                      "odbc_SQLFetch"                      (coerce retcode0)-                     "Unexpected return code")+                     "Unexpected return code"+                     sqlState)   if cols > 0     then loop id     else pure []@@ -978,7 +984,8 @@         if nullPtr == ptr           then pure "No error message given from ODBC."           else peekCString ptr-      throwIO (UnsuccessfulReturnCode label (coerce retcode) string)+      sqlState <- fetchSqlState dbc+      throwIO (UnsuccessfulReturnCode label (coerce retcode) string sqlState)  -- | Check that the RETCODE is successful or no data. assertSuccessOrNoData :: Ptr EnvAndDbc -> String -> IO RETCODE -> IO RETCODE@@ -993,8 +1000,18 @@         if nullPtr == ptr           then pure ""           else peekCString ptr-      throwIO (UnsuccessfulReturnCode label (coerce retcode) string)+      sqlState <- fetchSqlState dbc+      throwIO (UnsuccessfulReturnCode label (coerce retcode) string sqlState) +-- | Fetch SQLSTATE, an alphanumeric code which provides detailed information about the cause of a warning or error+-- see https://docs.microsoft.com/en-us/sql/odbc/reference/appendixes/appendix-a-odbc-error-codes?view=sql-server-ver15+fetchSqlState :: Ptr EnvAndDbc -> IO (Maybe String)+fetchSqlState dbc = do+  ptr <- odbc_sqlState dbc+  if nullPtr == ptr+    then pure Nothing+    else Just <$> peekCString ptr+ -------------------------------------------------------------------------------- -- Foreign types --@@ -1061,6 +1078,9 @@  foreign import ccall "odbc odbc_error"   odbc_error :: Ptr EnvAndDbc -> IO (Ptr CChar)++foreign import ccall "odbc odbc_sqlState"+  odbc_sqlState :: Ptr EnvAndDbc -> IO (Ptr CChar)  foreign import ccall "odbc odbc_AllocEnvAndDbc"   odbc_AllocEnvAndDbc :: IO (Ptr EnvAndDbc)
src/Database/ODBC/SQLServer.hs view
@@ -467,7 +467,10 @@       map         (\case            ValuePart v-             | Just {} <- valueToParam v -> TextPart "?"+             | Just {} <- valueToParam v ->+               case v of+                 TextValue t -> TextPart "CAST(? AS NVARCHAR(MAX))"+                 _ -> TextPart "?"            p -> p)         parts     params =
test/Main.hs view
@@ -118,7 +118,7 @@         shouldThrow           (Internal.exec c "SELECT 1; SELECT nothing FROM doesntexist")           (\case-             Internal.UnsuccessfulReturnCode "odbc_SQLMoreResults" (-1) _ ->+             Internal.UnsuccessfulReturnCode "odbc_SQLMoreResults" (-1) _ _ ->                True              _ -> False)) @@ -527,7 +527,7 @@       error         "Need ODBC_TEST_CONNECTION_STRING environment variable.\n\         \Example:\n\-        \ODBC_TEST_CONNECTION_STRING='DRIVER={ODBC Driver 13 for SQL Server};SERVER=127.0.0.1;Uid=SA;Pwd=Passw0rd;Encrypt=no'"+        \ODBC_TEST_CONNECTION_STRING='DRIVER={ODBC Driver 17 for SQL Server};SERVER=127.0.0.1;Uid=SA;Pwd=Passw0rd;Encrypt=no'"  -- | I had trouble passing in environment variables via Docker on -- Travis without the value coming in with quotes around it.