--- a/gameServer/CoreTypes.hs Mon Feb 23 20:15:02 2009 +0000
+++ b/gameServer/CoreTypes.hs Mon Feb 23 20:25:07 2009 +0000
@@ -10,6 +10,7 @@
import Data.Sequence(Seq, empty)
import Network
+
data ClientInfo =
ClientInfo
{
@@ -104,10 +105,6 @@
roomsNumber :: Int
}
-data DBQuery =
- HasRegistered String
- | CheckPassword String
-
data ServerInfo =
ServerInfo
{
@@ -119,8 +116,8 @@
dbHost :: String,
dbLogin :: String,
dbPassword :: String,
- stats :: TMVar StatisticsInfo
- --dbQueries :: TChan DBQuery
+ stats :: TMVar StatisticsInfo,
+ dbQueries :: Chan DBQuery
}
instance Show ServerInfo where
@@ -144,6 +141,10 @@
-- | CoreMessage String
-- | TimerTick
+data DBQuery =
+ HasRegistered String
+ | CheckPassword String
+
type Clients = IntMap.IntMap ClientInfo
type Rooms = IntMap.IntMap RoomInfo
--- a/gameServer/OfficialServer/DBInteraction.hs Mon Feb 23 20:15:02 2009 +0000
+++ b/gameServer/OfficialServer/DBInteraction.hs Mon Feb 23 20:25:07 2009 +0000
@@ -6,32 +6,30 @@
import Database.HDBC
import Database.HDBC.MySQL
-
import System.IO
import Control.Concurrent
-import Control.Concurrent.STM
import Control.Exception
-
-data DBQuery =
- HasRegistered String
- | CheckPassword String
+import Monad
+------------------------
+import CoreTypes
dbInteractionLoop queries dbConn = do
- q <- atomically $ readTChan queries
+ q <- readChan queries
case q of
HasRegistered queryStr -> putStrLn queryStr
CheckPassword queryStr -> putStrLn queryStr
dbInteractionLoop queries dbConn
-dbConnectionLoop queries = do
+dbConnectionLoop serverInfo = do
Control.Exception.handle (\e -> print e) $ handleSqlError $
bracket
- (connectMySQL defaultMySQLConnectInfo { mysqlHost = "192.168.50.5", mysqlDatabase = "glpi" })
+ (connectMySQL defaultMySQLConnectInfo {mysqlHost = dbHost serverInfo, mysqlDatabase = "hedge_main", mysqlUser = dbLogin serverInfo, mysqlPassword = dbPassword serverInfo })
(disconnect)
- (dbInteractionLoop queries)
+ (dbInteractionLoop $ dbQueries serverInfo)
threadDelay (15 * 10^6)
- dbConnectionLoop queries
+ dbConnectionLoop serverInfo
-startDBConnection queries = forkIO $ dbConnectionLoop queries
+startDBConnection serverInfo =
+ when (not . null $ dbHost serverInfo) ((forkIO $ dbConnectionLoop serverInfo) >> return ())
--- a/gameServer/ServerCore.hs Mon Feb 23 20:15:02 2009 +0000
+++ b/gameServer/ServerCore.hs Mon Feb 23 20:25:07 2009 +0000
@@ -13,6 +13,7 @@
import Utils
import HWProtoCore
import Actions
+import OfficialServer.DBInteraction
reactCmd :: ServerInfo -> Int -> [String] -> Clients -> Rooms -> IO (ServerInfo, Clients, Rooms)
reactCmd serverInfo clID cmd clients rooms = do
@@ -64,7 +65,7 @@
{- forkIO $ messagesLoop messagesChan
forkIO $ timerLoop messagesChan-}
--- startDBConnection $ dbQueries serverInfo
+ startDBConnection $ serverInfo
mainLoop coreChan serverInfo IntMap.empty (IntMap.singleton 0 newRoom)
--- a/gameServer/hedgewars-server.hs Mon Feb 23 20:15:02 2009 +0000
+++ b/gameServer/hedgewars-server.hs Mon Feb 23 20:25:07 2009 +0000
@@ -48,9 +48,9 @@
setupLoggers
stats <- atomically $ newTMVar (StatisticsInfo 0 0)
- --dbQueriesChan <- atomically newTChan
+ dbQueriesChan <- newChan
coreChan <- newChan
- serverInfo <- getOpts $ newServerInfo stats -- dbQueriesChan
+ serverInfo <- getOpts $ newServerInfo stats dbQueriesChan
bracket
(Network.listenOn $ Network.PortNumber $ listenPort serverInfo)