# HG changeset patch
# User unc0rr
# Date 1245607243 0
# Node ID f59f80e034b19f205415965a3814af2946f51718
# Parent  6336e37acf2d465c4be23a36d11f8991a9ae4ae8
Oops, fix database process interaction

diff -r 6336e37acf2d -r f59f80e034b1 gameServer/OfficialServer/DBInteraction.hs
--- 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 =
diff -r 6336e37acf2d -r f59f80e034b1 gameServer/OfficialServer/extdbinterface.hs
--- a/gameServer/OfficialServer/extdbinterface.hs	Sun Jun 21 17:48:05 2009 +0000
+++ b/gameServer/OfficialServer/extdbinterface.hs	Sun Jun 21 18:00:43 2009 +0000
@@ -19,6 +19,7 @@
 
 dbInteractionLoop dbConn = forever $ do
 	q <- (getLine >>= return . read)
+	hPutStrLn stderr $ show q
 	
 	case q of
 		CheckAccount clUid clNick _ -> do
@@ -37,13 +38,11 @@
 					else
 						(clUid, Guest)
 				putStrLn (show response)
+				hFlush stdout
 
-		SendStats clients rooms -> do
-				statement <- prepare dbConn dbQueryStats
-				execute statement [SqlInt32 $ fromIntegral clients, SqlInt32 $ fromIntegral rooms]
-				finish statement
+		SendStats clients rooms ->
+				run dbConn dbQueryStats [SqlInt32 $ fromIntegral clients, SqlInt32 $ fromIntegral rooms] >> return ()
 
-	hFlush stdout
 
 dbConnectionLoop mySQLConnectionInfo =
 	Control.Exception.handle (\e -> return ()) $ handleSqlError $
diff -r 6336e37acf2d -r f59f80e034b1 gameServer/ServerCore.hs
--- a/gameServer/ServerCore.hs	Sun Jun 21 17:48:05 2009 +0000
+++ b/gameServer/ServerCore.hs	Sun Jun 21 18:00:43 2009 +0000
@@ -17,10 +17,7 @@
 
 
 timerLoop :: Int -> Chan CoreMessage -> IO()
-timerLoop tick messagesChan = do
-	threadDelay (30 * 10^6) -- 30 seconds
-	writeChan messagesChan $ TimerAction tick
-	timerLoop (tick + 1) messagesChan
+timerLoop tick messagesChan = threadDelay (30 * 10^6) >> (writeChan messagesChan $ TimerAction tick) >> timerLoop (tick + 1) messagesChan
 
 firstAway (_, a, b, c) = (a, b, c)
 
@@ -85,4 +82,6 @@
 
 	startDBConnection $ serverInfo
 
-	mainLoop serverInfo IntMap.empty (IntMap.singleton 0 newRoom)
+	forkIO $ mainLoop serverInfo IntMap.empty (IntMap.singleton 0 newRoom)
+
+	forever $ threadDelay (60 * 60 * 10^6) >> putStrLn "***"
\ No newline at end of file