# HG changeset patch
# User unc0rr
# Date 1245434142 0
# Node ID 80d34c0b9dfed917be190eb6e461b6a43303af95
# Parent  8208946331ba249455d0baa31bc10313ad18c3f0
Implement sending gameserver stats to webserver

diff -r 8208946331ba -r 80d34c0b9dfe gameServer/Actions.hs
--- 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)
diff -r 8208946331ba -r 80d34c0b9dfe gameServer/CoreTypes.hs
--- 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 =
diff -r 8208946331ba -r 80d34c0b9dfe gameServer/OfficialServer/DBInteraction.hs
--- 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
diff -r 8208946331ba -r 80d34c0b9dfe gameServer/OfficialServer/extdbinterface.hs
--- 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 =
diff -r 8208946331ba -r 80d34c0b9dfe gameServer/ServerCore.hs
--- 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)) $