/watch works in testing environment
authorunc0rr
Tue, 03 Sep 2013 22:35:57 +0400
changeset 9448 04e0acfa7c2c
parent 9446 4fd5df03deb8
child 9450 2084b1b7839c
/watch works in testing environment
gameServer/Actions.hs
gameServer/HWProtoCore.hs
gameServer/HWProtoLobbyState.hs
gameServer/Utils.hs
--- a/gameServer/Actions.hs	Tue Sep 03 00:05:38 2013 +0400
+++ b/gameServer/Actions.hs	Tue Sep 03 22:35:57 2013 +0400
@@ -17,7 +17,7 @@
 import Control.DeepSeq
 import Data.Unique
 import Control.Arrow
-import Control.Exception
+import Control.Exception as E
 import System.Process
 import Network.Socket
 import System.Random
@@ -714,5 +714,24 @@
 #endif
 
 processAction (ShowReplay name) = do
-    return ()
+    c <- client's sendChan
+    cl <- client's id
+
+    let fileName = B.concat ["checked/", if B.isPrefixOf "replays/" name then B.drop 8 name else name]
+
+    checkInfo <- liftIO $ E.handle (\(e :: SomeException) ->
+                    warningM "REPLAYS" (B.unpack $ B.concat ["Problems reading ", fileName, ": ", B.pack $ show e]) >> return Nothing) $ do
+            (t, p1, p2, msgs) <- liftM read $ readFile (B.unpack fileName)
+            return $ Just (t, Map.fromList p1, Map.fromList p2, reverse msgs)
 
+    let (teams, params1, params2, roundMsgs) = fromJust checkInfo
+
+    when (isJust checkInfo) $ do
+        mapM_ processAction $ concat [
+            [AnswerClients [c] ["JOINED", nick cl]]
+            , answerFullConfigParams cl params1 params2
+            , answerAllTeams cl teams
+            , [AnswerClients [c]  ["RUN_GAME"]]
+            , [AnswerClients [c] $ "EM" : roundMsgs]
+            , [AnswerClients [c] ["KICKED"]]
+            ]
--- a/gameServer/HWProtoCore.hs	Tue Sep 03 00:05:38 2013 +0400
+++ b/gameServer/HWProtoCore.hs	Tue Sep 03 22:35:57 2013 +0400
@@ -50,7 +50,7 @@
             rnc <- liftM snd ask
             let chans = map (sendChan . client rnc) $ allClients rnc
             return [AnswerClients chans ["CHAT", "[global notice]", p] | isAdministrator cl]
-        h "WATCH" = return . QueryReplay
+        h "WATCH" f = return [QueryReplay f]
         h c p = return [Warning $ B.concat ["Unknown cmd: /", c, p]]
 
 handleCmd cmd = do
--- a/gameServer/HWProtoLobbyState.hs	Tue Sep 03 00:05:38 2013 +0400
+++ b/gameServer/HWProtoLobbyState.hs	Tue Sep 03 22:35:57 2013 +0400
@@ -14,16 +14,6 @@
 import EngineInteraction
 
 
-answerAllTeams :: ClientInfo -> [TeamInfo] -> [Action]
-answerAllTeams cl = concatMap toAnswer
-    where
-        clChan = sendChan cl
-        toAnswer team =
-            [AnswerClients [clChan] $ teamToNet team,
-            AnswerClients [clChan] ["TEAM_COLOR", teamname team, teamcolor team],
-            AnswerClients [clChan] ["HH_NUM", teamname team, showB $ hhnum team]]
-
-
 handleCmd_lobby :: CmdHandler
 
 
--- a/gameServer/Utils.hs	Tue Sep 03 00:05:38 2013 +0400
+++ b/gameServer/Utils.hs	Tue Sep 03 22:35:57 2013 +0400
@@ -157,5 +157,15 @@
         toAnswer cl (paramName, paramStrs) = AnswerClients [sendChan cl] $ "CFG" : paramName : paramStrs
 
 
+answerAllTeams :: ClientInfo -> [TeamInfo] -> [Action]
+answerAllTeams cl = concatMap toAnswer
+    where
+        clChan = sendChan cl
+        toAnswer team =
+            [AnswerClients [clChan] $ teamToNet team,
+            AnswerClients [clChan] ["TEAM_COLOR", teamname team, teamcolor team],
+            AnswerClients [clChan] ["HH_NUM", teamname team, showB $ hhnum team]]
+
+
 loc :: B.ByteString -> B.ByteString
 loc = id