--- a/gameServer/OfficialServer/DBInteraction.hs Sun Jun 21 17:48:05 2009 +0000
+++ b/gameServer/OfficialServer/DBInteraction.hs Sun Jun 21 18:00:43 2009 +0000
@@ -42,7 +42,9 @@
-------------------------------------------------------------------
-pipeDbConnectionLoop queries coreChan hIn hOut accountsCache = do
+pipeDbConnectionLoop queries coreChan hIn hOut accountsCache =
+ Control.Exception.handle (\e -> warningM "Database" (show e) >> return accountsCache) $
+ do
q <- readChan queries
updatedCache <- case q of
CheckAccount clUid clNick _ -> do
@@ -66,12 +68,13 @@
return accountsCache
ClearCache -> return Map.empty
- SendStats {} -> do
- hPutStrLn hIn $ show q
- hFlush hIn
- return accountsCache
-
- return updatedCache
+ SendStats {} -> onException (
+ (hPutStrLn hIn $ show q) >>
+ hFlush hIn >>
+ return accountsCache)
+ (unGetChan queries q)
+
+ pipeDbConnectionLoop queries coreChan hIn hOut updatedCache
where
maybeException (Just a) = return a
maybeException Nothing = ioError (userError "Can't read")
@@ -79,21 +82,19 @@
pipeDbConnection accountsCache serverInfo = do
updatedCache <-
- Control.Exception.handle (\e -> warningM "Database" (show e) >> return accountsCache) $
- bracket
- (createProcess (proc "./OfficialServer/extdbinterface" []) {std_in = CreatePipe, std_out = CreatePipe})
- (\(_, _, _, processHandle) -> return accountsCache)
- (\(Just hIn, Just hOut, _, _) -> do
- hSetBuffering hIn LineBuffering
- hSetBuffering hOut LineBuffering
-
- hPutStrLn hIn $ dbHost serverInfo
- hPutStrLn hIn $ dbLogin serverInfo
- hPutStrLn hIn $ dbPassword serverInfo
- pipeDbConnectionLoop (dbQueries serverInfo) (coreChan serverInfo) hIn hOut accountsCache
- )
+ Control.Exception.handle (\e -> warningM "Database" (show e) >> return accountsCache) $ do
+ (Just hIn, Just hOut, _, _) <- createProcess (proc "./OfficialServer/extdbinterface" [])
+ {std_in = CreatePipe,
+ std_out = CreatePipe}
+ hSetBuffering hIn LineBuffering
+ hSetBuffering hOut LineBuffering
- threadDelay (5 * 10^6)
+ hPutStrLn hIn $ dbHost serverInfo
+ hPutStrLn hIn $ dbLogin serverInfo
+ hPutStrLn hIn $ dbPassword serverInfo
+ pipeDbConnectionLoop (dbQueries serverInfo) (coreChan serverInfo) hIn hOut accountsCache
+
+ threadDelay (3 * 10^6)
pipeDbConnection updatedCache serverInfo
dbConnectionLoop serverInfo =