Send stats every minute
authorunc0rr
Fri, 19 Jun 2009 17:56:52 +0000
changeset 2173 98cde8645e21
parent 2172 80d34c0b9dfe
child 2174 9132de4acf05
Send stats every minute
gameServer/CoreTypes.hs
gameServer/ServerCore.hs
--- a/gameServer/CoreTypes.hs	Fri Jun 19 17:55:42 2009 +0000
+++ b/gameServer/CoreTypes.hs	Fri Jun 19 17:56:52 2009 +0000
@@ -160,7 +160,7 @@
 	Accept ClientInfo
 	| ClientMessage (Int, [String])
 	| ClientAccountInfo (Int, AccountInfo)
-	| TimerAction
+	| TimerAction Int
 
 type Clients = IntMap.IntMap ClientInfo
 type Rooms = IntMap.IntMap RoomInfo
--- a/gameServer/ServerCore.hs	Fri Jun 19 17:55:42 2009 +0000
+++ b/gameServer/ServerCore.hs	Fri Jun 19 17:56:52 2009 +0000
@@ -16,10 +16,11 @@
 import OfficialServer.DBInteraction
 
 
-timerLoop :: Chan CoreMessage -> IO()
-timerLoop messagesChan = forever $ do
+timerLoop :: Int -> Chan CoreMessage -> IO()
+timerLoop tick messagesChan = do
 	threadDelay (30 * 10^6) -- 30 seconds
-	writeChan messagesChan TimerAction
+	writeChan messagesChan $ TimerAction tick
+	timerLoop (tick + 1) messagesChan
 
 firstAway (_, a, b, c) = (a, b, c)
 
@@ -56,10 +57,10 @@
 					debugM "Clients" "Got info for dead client"
 					return (serverInfo, clients, rooms)
 
-			TimerAction ->
+			TimerAction tick ->
 				liftM firstAway $
-					foldM processAction (0, serverInfo, clients, rooms)
-						[PingAll, StatsAction]
+					foldM processAction (0, serverInfo, clients, rooms) $
+						PingAll : if even tick then [StatsAction] else []
 
 
 	{-			let hadRooms = (not $ null rooms) && (null mrooms)
@@ -80,7 +81,7 @@
 
 	return ()
 	
-	forkIO $ timerLoop $ coreChan serverInfo
+	forkIO $ timerLoop 0 $ coreChan serverInfo
 
 	startDBConnection $ serverInfo