gameServer/OfficialServer/DBInteraction.hs
changeset 4943 21d6b2b79cfe
parent 4932 f11d80bac7ed
child 4944 e43a3da2fc22
--- a/gameServer/OfficialServer/DBInteraction.hs	Wed Feb 16 12:07:30 2011 +0300
+++ b/gameServer/OfficialServer/DBInteraction.hs	Wed Feb 16 12:49:12 2011 +0300
@@ -28,17 +28,30 @@
 localAddressList = ["127.0.0.1", "0:0:0:0:0:0:0:1", "0:0:0:0:0:ffff:7f00:1"]
 
 fakeDbConnection :: forall b. ServerInfo -> IO b
-fakeDbConnection serverInfo = forever $ do
-    q <- readChan $ dbQueries serverInfo
+fakeDbConnection si = forever $ do
+    q <- readChan $ dbQueries si
     case q of
         CheckAccount clId clUid _ clHost ->
-            writeChan (coreChan serverInfo) $ ClientAccountInfo clId clUid (if clHost `L.elem` localAddressList then Admin else Guest)
+            writeChan (coreChan si) $ ClientAccountInfo clId clUid (if clHost `L.elem` localAddressList then Admin else Guest)
         ClearCache -> return ()
         SendStats {} -> return ()
 
 dbConnectionLoop :: forall b. ServerInfo -> IO b
 #if defined(OFFICIAL_SERVER)
-pipeDbConnectionLoop queries coreChan hIn hOut accountsCache =
+flushRequests :: ServerInfo -> IO ()
+flushRequests si = do
+    e <- isEmptyChan $ dbQueries si
+    unless e $ do
+        q <- readChan $ dbQueries si
+        case q of
+            CheckAccount clId clUid _ clHost ->
+                writeChan (coreChan si) $ ClientAccountInfo clId clUid (if clHost `L.elem` localAddressList then Admin else Guest)
+            ClearCache -> return ()
+            SendStats {} -> return ()
+        flushRequests si
+
+pipeDbConnectionLoop :: Chan DBQuery -> Chan CoreMessage -> Handle -> Handle -> Map.Map ByteString (UTCTime, AccountInfo) -> IO (Map.Map ByteString (UTCTime, AccountInfo))
+pipeDbConnectionLoop queries cChan hIn hOut accountsCache =
     Exception.handle (\(e :: Exception.IOException) -> warningM "Database" (show e) >> return accountsCache) $
     do
     q <- readChan queries
@@ -53,14 +66,16 @@
 
                     (clId', clUid', accountInfo) <- SIO.hGetLine hOut >>= (maybeException . maybeRead)
 
-                    writeChan coreChan $ ClientAccountInfo clId' clUid' accountInfo
+                    writeChan cChan $ ClientAccountInfo clId' clUid' accountInfo
 
                     return $ Map.insert clNick (currentTime, accountInfo) accountsCache
                 `Exception.onException`
-                    (unGetChan queries q)
+                    (unGetChan queries q
+                    >> writeChan cChan (ClientAccountInfo clId clUid Guest)
+                    )
                 else
                 do
-                    writeChan coreChan $ ClientAccountInfo clId clUid (snd $ fromJust cacheEntry)
+                    writeChan cChan $ ClientAccountInfo clId clUid (snd $ fromJust cacheEntry)
                     return accountsCache
 
         ClearCache -> return Map.empty
@@ -71,15 +86,15 @@
                 `Exception.onException`
                 (unGetChan queries q)
 
-    pipeDbConnectionLoop queries coreChan hIn hOut updatedCache
+    pipeDbConnectionLoop queries cChan hIn hOut updatedCache
     where
         maybeException (Just a) = return a
         maybeException Nothing = ioError (userError "Can't read")
 
-
-pipeDbConnection accountsCache si = do
-    updatedCache <-
-        Exception.handle (\(e :: Exception.IOException) -> warningM "Database" (show e) >> return accountsCache) $ do
+pipeDbConnection :: forall b. Map.Map ByteString (UTCTime, AccountInfo) -> ServerInfo -> Int -> IO b
+pipeDbConnection accountsCache si errNum = do
+    (updatedCache, newErrNum) <-
+        Exception.handle (\(e :: Exception.IOException) -> warningM "Database" (show e) >> return (accountsCache, errNum + 1)) $ do
             (Just hIn, Just hOut, _, _) <- createProcess (proc "./OfficialServer/extdbinterface" [])
                     {std_in = CreatePipe,
                     std_out = CreatePipe}
@@ -89,14 +104,16 @@
             B.hPutStrLn hIn $ dbHost si
             B.hPutStrLn hIn $ dbLogin si
             B.hPutStrLn hIn $ dbPassword si
-            pipeDbConnectionLoop (dbQueries si) (coreChan si) hIn hOut accountsCache
+            c <- pipeDbConnectionLoop (dbQueries si) (coreChan si) hIn hOut accountsCache
+            return (c, 0)
 
-    threadDelay (3 * 10^6)
-    pipeDbConnection updatedCache si
+    when (newErrNum > 1) $ flushRequests si
+    threadDelay (3000000)
+    pipeDbConnection updatedCache si newErrNum
 
 dbConnectionLoop si =
         if (not . B.null $ dbHost si) then
-            pipeDbConnection Map.empty si
+            pipeDbConnection Map.empty si 0
         else
             fakeDbConnection si
 #else