48 dbQueryAchievement = |
48 dbQueryAchievement = |
49 "INSERT INTO achievements (time, typeid, userid, value, filename, location, protocol) \ |
49 "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 = ?), \ |
50 \ VALUES (?, (SELECT id FROM achievement_types WHERE name = ?), (SELECT uid FROM users WHERE name = ?), \ |
51 \ ?, ?, ?, ?)" |
51 \ ?, ?, ?, ?)" |
52 |
52 |
|
53 dbQueryGamesHistory = |
|
54 "? ? ?" |
|
55 |
53 dbQueryReplayFilename = "SELECT filename FROM achievements WHERE id = ?" |
56 dbQueryReplayFilename = "SELECT filename FROM achievements WHERE id = ?" |
54 |
57 |
55 |
58 |
56 dbInteractionLoop dbConn = forever $ do |
59 dbInteractionLoop dbConn = forever $ do |
57 q <- liftM read getLine |
60 q <- liftM read getLine |
81 print (clId, clUid, ReplayName fn) |
84 print (clId, clUid, ReplayName fn) |
82 hFlush stdout |
85 hFlush stdout |
83 |
86 |
84 SendStats clients rooms -> |
87 SendStats clients rooms -> |
85 void $ execute dbConn dbQueryStats (clients, rooms) |
88 void $ execute dbConn dbQueryStats (clients, rooms) |
86 StoreAchievements p fileName teams info -> |
89 StoreAchievements p fileName teams script info -> |
87 mapM_ (execute dbConn dbQueryAchievement) $ (parseStats p fileName teams) info |
90 mapM_ (uncurry (execute dbConn)) $ parseStats p fileName teams script info |
88 |
91 |
89 |
92 |
90 --readTime = read . B.unpack . B.take 19 . B.drop 8 |
93 --readTime = read . B.unpack . B.take 19 . B.drop 8 |
91 readTime = B.take 19 . B.drop 8 |
94 readTime = B.take 19 . B.drop 8 |
92 |
95 |
93 parseStats :: |
96 parseStats :: |
94 Word16 |
97 Word16 |
95 -> B.ByteString |
98 -> B.ByteString |
96 -> [(B.ByteString, B.ByteString)] |
99 -> [(B.ByteString, B.ByteString)] |
97 -> [B.ByteString] |
100 -> B.ByteString |
98 -> [(B.ByteString, B.ByteString, B.ByteString, Int, B.ByteString, B.ByteString, Int)] |
101 -> [B.ByteString] |
99 parseStats p fileName teams = ps |
102 -> [(Query, (B.ByteString, B.ByteString, B.ByteString, Int, B.ByteString, B.ByteString, Int))] |
|
103 parseStats p fileName teams script = ps |
100 where |
104 where |
101 time = readTime fileName |
105 time = readTime fileName |
102 ps [] = [] |
106 ps [] = [] |
103 ps ("DRAW" : bs) = ps bs |
107 ps ("DRAW" : bs) = ps bs |
104 ps ("WINNERS" : n : bs) = ps $ drop (readInt_ n) bs |
108 ps ("WINNERS" : n : bs) = ps $ drop (readInt_ n) bs |
105 ps ("ACHIEVEMENT" : typ : teamname : location : value : bs) = |
109 ps ("ACHIEVEMENT" : typ : teamname : location : value : bs) = (dbQueryAchievement, |
106 ( time |
110 ( time |
107 , typ |
111 , typ |
108 , fromMaybe "" (lookup teamname teams) |
112 , fromMaybe "" (lookup teamname teams) |
109 , readInt_ value |
113 , readInt_ value |
110 , fileName |
114 , fileName |
111 , location |
115 , location |
112 , fromIntegral p |
116 , fromIntegral p |
113 ) : ps bs |
117 )) : ps bs |
114 ps (b:bs) = ps bs |
118 ps (b:bs) = ps bs |
115 |
119 |
116 |
120 |
117 dbConnectionLoop mySQLConnectionInfo = |
121 dbConnectionLoop mySQLConnectionInfo = |
118 Control.Exception.handle (\(e :: SomeException) -> hPutStrLn stderr $ show e) $ |
122 Control.Exception.handle (\(e :: SomeException) -> hPutStrLn stderr $ show e) $ |