# HG changeset patch
# User unc0rr
# Date 1243272819 0
# Node ID 1ac0e10e546f7f04dbc2954e85fd7f685c9abd00
# Parent  dec7ead2d17853ec35d2615bbfa1bcf73b0fd97c
Add caching for accounts information (entries are stored in memory forever)

diff -r dec7ead2d178 -r 1ac0e10e546f gameServer/OfficialServer/DBInteraction.hs
--- a/gameServer/OfficialServer/DBInteraction.hs	Mon May 25 15:24:27 2009 +0000
+++ b/gameServer/OfficialServer/DBInteraction.hs	Mon May 25 17:33:39 2009 +0000
@@ -10,6 +10,7 @@
 import Control.Concurrent
 import Control.Exception
 import Control.Monad
+import qualified Data.Map as Map
 import Monad
 import Maybe
 import System.Log.Logger
@@ -39,26 +40,39 @@
 -------------------------------------------------------------------
 
 
-pipeDbConnectionLoop queries coreChan hIn hOut = do
+pipeDbConnectionLoop queries coreChan hIn hOut accountsCache = do
 	q <- readChan queries
-	do
-		hPutStrLn hIn $ show q
-		hFlush hIn
+	updatedCache <- case q of
+		CheckAccount clUid clNick _ -> do
+			let cacheEntry = clNick `Map.lookup` accountsCache
+			if isNothing cacheEntry then
+				do
+					hPutStrLn hIn $ show q
+					hFlush hIn
+
+					(clId, accountInfo) <- hGetLine hOut >>= (maybeException . maybeRead)
+
+					writeChan coreChan $ ClientAccountInfo (clId, accountInfo)
+
+					return $ Map.insert clNick accountInfo accountsCache
+				`onException`
+					(unGetChan queries q)
+				else
+				do
+					writeChan coreChan $ ClientAccountInfo (clUid, fromJust cacheEntry)
+					return accountsCache
 	
-		response <- hGetLine hOut >>= (maybeException . maybeRead)
-
-		writeChan coreChan $ ClientAccountInfo response
-		`onException`
-			(unGetChan queries q)
+	return updatedCache
 	where
 		maybeException (Just a) = return a
 		maybeException Nothing = ioError (userError "Can't read")
 
 
-pipeDbConnection serverInfo = forever $ do
-	Control.Exception.handle (\e -> warningM "Database" $ show e) $ do
+pipeDbConnection accountsCache serverInfo = do
+	updatedCache <-
+		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 }
+				createProcess (proc "./OfficialServer/extdbinterface" []) {std_in = CreatePipe, std_out = CreatePipe}
 
 			hSetBuffering hIn LineBuffering
 			hSetBuffering hOut LineBuffering
@@ -66,12 +80,12 @@
 			hPutStrLn hIn $ dbHost serverInfo
 			hPutStrLn hIn $ dbLogin serverInfo
 			hPutStrLn hIn $ dbPassword serverInfo
-			pipeDbConnectionLoop (dbQueries serverInfo) (coreChan serverInfo) hIn hOut
+			pipeDbConnectionLoop (dbQueries serverInfo) (coreChan serverInfo) hIn hOut accountsCache
 
 	threadDelay (5 * 10^6)
-
+	pipeDbConnection updatedCache serverInfo
 
-dbConnectionLoop = pipeDbConnection
+dbConnectionLoop = pipeDbConnection Map.empty
 #else
 dbConnectionLoop = fakeDbConnection
 #endif
@@ -81,4 +95,4 @@
 		forkIO $ dbConnectionLoop serverInfo
 		else
 		--forkIO $ fakeDbConnection serverInfo
-		forkIO $ pipeDbConnection serverInfo
+		forkIO $ pipeDbConnection Map.empty serverInfo
diff -r dec7ead2d178 -r 1ac0e10e546f gameServer/OfficialServer/extdbinterface.hs
--- a/gameServer/OfficialServer/extdbinterface.hs	Mon May 25 15:24:27 2009 +0000
+++ b/gameServer/OfficialServer/extdbinterface.hs	Mon May 25 17:33:39 2009 +0000
@@ -1,6 +1,6 @@
 module Main where
 
-import Prelude hiding (catch);
+import Prelude hiding (catch)
 import Control.Monad
 import Control.Exception
 import System.IO