gameServer/OfficialServer/extdbinterface.hs
changeset 11268 096811aa3c55
parent 11246 09a2d3988569
child 11275 13ce106c8836
--- a/gameServer/OfficialServer/extdbinterface.hs	Sun Nov 01 15:08:39 2015 -0500
+++ b/gameServer/OfficialServer/extdbinterface.hs	Mon Nov 02 23:23:06 2015 +0300
@@ -28,9 +28,10 @@
 import Database.MySQL.Simple
 import Database.MySQL.Simple.QueryResults
 import Database.MySQL.Simple.Result
-import Data.List (lookup)
+import Data.List (lookup, elem)
 import qualified Data.ByteString.Char8 as B
 import Data.Word
+import Data.Int
 --------------------------
 import CoreTypes
 import Utils
@@ -51,7 +52,11 @@
     \ ?, ?, ?, ?)"
 
 dbQueryGamesHistory =
-    "? ? ?"
+    "INSERT INTO rating_games (script, protocol, filename, time) \
+    \ VALUES (?, ?, ?, ?)"
+
+dbQueryGamesHistoryPlaces = "INSERT INTO rating_players (userid, gameid, place) \
+    \ VALUES ((SELECT uid FROM users WHERE name = ?), LAST_INSERT_ID(), ?)"
 
 dbQueryReplayFilename = "SELECT filename FROM achievements WHERE id = ?"
 
@@ -87,36 +92,43 @@
         SendStats clients rooms ->
                 void $ execute dbConn dbQueryStats (clients, rooms)
         StoreAchievements p fileName teams script info ->
-            mapM_ (uncurry (execute dbConn)) $ parseStats p fileName teams script info
+            sequence_ $ parseStats dbConn p fileName teams script info
 
 
 --readTime = read . B.unpack . B.take 19 . B.drop 8
 readTime = B.take 19 . B.drop 8
 
 parseStats :: 
-    Word16 
+    Connection
+    -> Word16 
     -> B.ByteString 
     -> [(B.ByteString, B.ByteString)] 
     -> B.ByteString
     -> [B.ByteString]
-    -> [(Query, (B.ByteString, B.ByteString, B.ByteString, Int, B.ByteString, B.ByteString, Int))]
-parseStats p fileName teams script = ps
+    -> [IO Int64]
+parseStats dbConn p fileName teams script = ps
     where
     time = readTime fileName
+    ps :: [B.ByteString] -> [IO Int64]
     ps [] = []
-    ps ("DRAW" : bs) = ps bs
-    ps ("WINNERS" : n : bs) = ps $ drop (readInt_ n) bs
-    ps ("ACHIEVEMENT" : typ : teamname : location : value : bs) = (dbQueryAchievement, 
+    ps ("DRAW" : bs) = execute dbConn dbQueryGamesHistory (script, (fromIntegral p) :: Int, fileName, time)
+        : executeMany dbConn dbQueryGamesHistoryPlaces (map drawParams teams)
+        : ps bs
+    ps ("WINNERS" : n : bs) = let winNum = readInt_ n in execute dbConn dbQueryGamesHistory (script, (fromIntegral p) :: Int, fileName, time)
+        : executeMany dbConn dbQueryGamesHistoryPlaces (map (placeParams (take winNum bs)) teams)
+        : ps (drop winNum bs)
+    ps ("ACHIEVEMENT" : typ : teamname : location : value : bs) = execute dbConn dbQueryAchievement
         ( time
         , typ
         , fromMaybe "" (lookup teamname teams)
-        , readInt_ value
+        , (readInt_ value) :: Int
         , fileName
         , location
-        , fromIntegral p
-        )) : ps bs
+        , (fromIntegral p) :: Int
+        ) : ps bs
     ps (b:bs) = ps bs
-
+    drawParams t = (snd t, 0 :: Int)
+    placeParams winners t = (snd t, if (fst t) `elem` winners then 1 else 2 :: Int)
 
 dbConnectionLoop mySQLConnectionInfo =
     Control.Exception.handle (\(e :: SomeException) -> hPutStrLn stderr $ show e) $