--- a/gameServer/Actions.hs Thu Jun 18 17:48:06 2009 +0000
+++ b/gameServer/Actions.hs Fri Jun 19 17:55:42 2009 +0000
@@ -44,6 +44,7 @@
| Dump
| AddClient ClientInfo
| PingAll
+ | StatsAction
type CmdHandler = Int -> Clients -> Rooms -> [String] -> [Action]
@@ -385,3 +386,8 @@
processAction (clientUID client, serverInfo, clients, rooms) $ ByeClient "Ping timeout"
else
return (clID, serverInfo, clients, rooms)
+
+
+processAction (clID, serverInfo, clients, rooms) (StatsAction) = do
+ writeChan (dbQueries serverInfo) $ SendStats (size clients) (size rooms - 1)
+ return (clID, serverInfo, clients, rooms)
--- a/gameServer/CoreTypes.hs Thu Jun 18 17:48:06 2009 +0000
+++ b/gameServer/CoreTypes.hs Fri Jun 19 17:55:42 2009 +0000
@@ -153,6 +153,7 @@
data DBQuery =
CheckAccount Int String String
| ClearCache
+ | SendStats Int Int
deriving (Show, Read)
data CoreMessage =
--- a/gameServer/OfficialServer/DBInteraction.hs Thu Jun 18 17:48:06 2009 +0000
+++ b/gameServer/OfficialServer/DBInteraction.hs Fri Jun 19 17:55:42 2009 +0000
@@ -66,6 +66,10 @@
return accountsCache
ClearCache -> return Map.empty
+ SendStats {} -> do
+ hPutStrLn hIn $ show q
+ hFlush hIn
+ return accountsCache
return updatedCache
where
--- a/gameServer/OfficialServer/extdbinterface.hs Thu Jun 18 17:48:06 2009 +0000
+++ b/gameServer/OfficialServer/extdbinterface.hs Fri Jun 19 17:55:42 2009 +0000
@@ -11,29 +11,38 @@
import CoreTypes
-dbQueryString =
+dbQueryAccount =
"select users.pass, users_roles.rid from users left join users_roles on users.uid = users_roles.uid where users.name = ?"
+dbQueryStats =
+ "UPDATE gameserver_stats SET players = ?, rooms = ?, last_update = UNIX_TIMESTAMP()"
+
dbInteractionLoop dbConn = forever $ do
q <- (getLine >>= return . read)
- response <- case q of
+ case q of
CheckAccount clUid clNick _ -> do
- statement <- prepare dbConn dbQueryString
+ statement <- prepare dbConn dbQueryAccount
execute statement [SqlString $ clNick]
passAndRole <- fetchRow statement
finish statement
- if isJust passAndRole then
- return $ (
- clUid,
- HasAccount
- (fromSql $ head $ fromJust $ passAndRole)
- ((fromSql $ last $ fromJust $ passAndRole) == (Just (3 :: Int)))
- )
+ let response =
+ if isJust passAndRole then
+ (
+ clUid,
+ HasAccount
+ (fromSql $ head $ fromJust $ passAndRole)
+ ((fromSql $ last $ fromJust $ passAndRole) == (Just (3 :: Int)))
+ )
else
- return $ (clUid, Guest)
+ (clUid, Guest)
+ putStrLn (show response)
- putStrLn (show response)
+ SendStats clients rooms -> do
+ statement <- prepare dbConn dbQueryStats
+ execute statement [SqlInt32 $ fromIntegral rooms, SqlInt32 $ fromIntegral clients]
+ finish statement
+
hFlush stdout
dbConnectionLoop mySQLConnectionInfo =
--- a/gameServer/ServerCore.hs Thu Jun 18 17:48:06 2009 +0000
+++ b/gameServer/ServerCore.hs Fri Jun 19 17:55:42 2009 +0000
@@ -57,10 +57,10 @@
return (serverInfo, clients, rooms)
TimerAction ->
- liftM firstAway $ processAction
- (0, serverInfo, clients, rooms)
- PingAll
-
+ liftM firstAway $
+ foldM processAction (0, serverInfo, clients, rooms)
+ [PingAll, StatsAction]
+
{- let hadRooms = (not $ null rooms) && (null mrooms)
in unless ((not $ isDedicated serverInfo) && ((null clientsIn) || hadRooms)) $