26 import System.IO |
26 import System.IO |
27 import Data.Maybe |
27 import Data.Maybe |
28 import Database.MySQL.Simple |
28 import Database.MySQL.Simple |
29 import Database.MySQL.Simple.QueryResults |
29 import Database.MySQL.Simple.QueryResults |
30 import Database.MySQL.Simple.Result |
30 import Database.MySQL.Simple.Result |
31 import Data.List (lookup) |
31 import Data.List (lookup, elem) |
32 import qualified Data.ByteString.Char8 as B |
32 import qualified Data.ByteString.Char8 as B |
33 import Data.Word |
33 import Data.Word |
|
34 import Data.Int |
34 -------------------------- |
35 -------------------------- |
35 import CoreTypes |
36 import CoreTypes |
36 import Utils |
37 import Utils |
37 |
38 |
38 |
39 |
49 "INSERT INTO achievements (time, typeid, userid, value, filename, location, protocol) \ |
50 "INSERT INTO achievements (time, typeid, userid, value, filename, location, protocol) \ |
50 \ VALUES (?, (SELECT id FROM achievement_types WHERE name = ?), (SELECT uid FROM users WHERE name = ?), \ |
51 \ VALUES (?, (SELECT id FROM achievement_types WHERE name = ?), (SELECT uid FROM users WHERE name = ?), \ |
51 \ ?, ?, ?, ?)" |
52 \ ?, ?, ?, ?)" |
52 |
53 |
53 dbQueryGamesHistory = |
54 dbQueryGamesHistory = |
54 "? ? ?" |
55 "INSERT INTO rating_games (script, protocol, filename, time) \ |
|
56 \ VALUES (?, ?, ?, ?)" |
|
57 |
|
58 dbQueryGamesHistoryPlaces = "INSERT INTO rating_players (userid, gameid, place) \ |
|
59 \ VALUES ((SELECT uid FROM users WHERE name = ?), LAST_INSERT_ID(), ?)" |
55 |
60 |
56 dbQueryReplayFilename = "SELECT filename FROM achievements WHERE id = ?" |
61 dbQueryReplayFilename = "SELECT filename FROM achievements WHERE id = ?" |
57 |
62 |
58 |
63 |
59 dbInteractionLoop dbConn = forever $ do |
64 dbInteractionLoop dbConn = forever $ do |
85 hFlush stdout |
90 hFlush stdout |
86 |
91 |
87 SendStats clients rooms -> |
92 SendStats clients rooms -> |
88 void $ execute dbConn dbQueryStats (clients, rooms) |
93 void $ execute dbConn dbQueryStats (clients, rooms) |
89 StoreAchievements p fileName teams script info -> |
94 StoreAchievements p fileName teams script info -> |
90 mapM_ (uncurry (execute dbConn)) $ parseStats p fileName teams script info |
95 sequence_ $ parseStats dbConn p fileName teams script info |
91 |
96 |
92 |
97 |
93 --readTime = read . B.unpack . B.take 19 . B.drop 8 |
98 --readTime = read . B.unpack . B.take 19 . B.drop 8 |
94 readTime = B.take 19 . B.drop 8 |
99 readTime = B.take 19 . B.drop 8 |
95 |
100 |
96 parseStats :: |
101 parseStats :: |
97 Word16 |
102 Connection |
|
103 -> Word16 |
98 -> B.ByteString |
104 -> B.ByteString |
99 -> [(B.ByteString, B.ByteString)] |
105 -> [(B.ByteString, B.ByteString)] |
100 -> B.ByteString |
106 -> B.ByteString |
101 -> [B.ByteString] |
107 -> [B.ByteString] |
102 -> [(Query, (B.ByteString, B.ByteString, B.ByteString, Int, B.ByteString, B.ByteString, Int))] |
108 -> [IO Int64] |
103 parseStats p fileName teams script = ps |
109 parseStats dbConn p fileName teams script = ps |
104 where |
110 where |
105 time = readTime fileName |
111 time = readTime fileName |
|
112 ps :: [B.ByteString] -> [IO Int64] |
106 ps [] = [] |
113 ps [] = [] |
107 ps ("DRAW" : bs) = ps bs |
114 ps ("DRAW" : bs) = execute dbConn dbQueryGamesHistory (script, (fromIntegral p) :: Int, fileName, time) |
108 ps ("WINNERS" : n : bs) = ps $ drop (readInt_ n) bs |
115 : executeMany dbConn dbQueryGamesHistoryPlaces (map drawParams teams) |
109 ps ("ACHIEVEMENT" : typ : teamname : location : value : bs) = (dbQueryAchievement, |
116 : ps bs |
|
117 ps ("WINNERS" : n : bs) = let winNum = readInt_ n in execute dbConn dbQueryGamesHistory (script, (fromIntegral p) :: Int, fileName, time) |
|
118 : executeMany dbConn dbQueryGamesHistoryPlaces (map (placeParams (take winNum bs)) teams) |
|
119 : ps (drop winNum bs) |
|
120 ps ("ACHIEVEMENT" : typ : teamname : location : value : bs) = execute dbConn dbQueryAchievement |
110 ( time |
121 ( time |
111 , typ |
122 , typ |
112 , fromMaybe "" (lookup teamname teams) |
123 , fromMaybe "" (lookup teamname teams) |
113 , readInt_ value |
124 , (readInt_ value) :: Int |
114 , fileName |
125 , fileName |
115 , location |
126 , location |
116 , fromIntegral p |
127 , (fromIntegral p) :: Int |
117 )) : ps bs |
128 ) : ps bs |
118 ps (b:bs) = ps bs |
129 ps (b:bs) = ps bs |
119 |
130 drawParams t = (snd t, 0 :: Int) |
|
131 placeParams winners t = (snd t, if (fst t) `elem` winners then 1 else 2 :: Int) |
120 |
132 |
121 dbConnectionLoop mySQLConnectionInfo = |
133 dbConnectionLoop mySQLConnectionInfo = |
122 Control.Exception.handle (\(e :: SomeException) -> hPutStrLn stderr $ show e) $ |
134 Control.Exception.handle (\(e :: SomeException) -> hPutStrLn stderr $ show e) $ |
123 bracket |
135 bracket |
124 (connect mySQLConnectionInfo) |
136 (connect mySQLConnectionInfo) |