gameServer/OfficialServer/extdbinterface.hs
branchwebgl
changeset 9950 2759212a27de
parent 9884 6e09ca662fa3
child 10017 de822cd3df3a
equal deleted inserted replaced
9521:8054d9d775fd 9950:2759212a27de
     9 import Data.Maybe
     9 import Data.Maybe
    10 import Database.HDBC
    10 import Database.HDBC
    11 import Database.HDBC.MySQL
    11 import Database.HDBC.MySQL
    12 import Data.List (lookup)
    12 import Data.List (lookup)
    13 import qualified Data.ByteString.Char8 as B
    13 import qualified Data.ByteString.Char8 as B
       
    14 import Data.Word
    14 --------------------------
    15 --------------------------
    15 import CoreTypes
    16 import CoreTypes
    16 import Utils
    17 import Utils
    17 
    18 
    18 
    19 
    24 
    25 
    25 dbQueryStats =
    26 dbQueryStats =
    26     "INSERT INTO gameserver_stats (players, rooms, last_update) VALUES (?, ?, UNIX_TIMESTAMP())"
    27     "INSERT INTO gameserver_stats (players, rooms, last_update) VALUES (?, ?, UNIX_TIMESTAMP())"
    27 
    28 
    28 dbQueryAchievement =
    29 dbQueryAchievement =
    29     "INSERT INTO achievements (time, typeid, userid, value, filename, location) \
    30     "INSERT INTO achievements (time, typeid, userid, value, filename, location, protocol) \
    30     \ VALUES (?, (SELECT id FROM achievement_types WHERE name = ?), (SELECT uid FROM users WHERE name = ?), \
    31     \ VALUES (?, (SELECT id FROM achievement_types WHERE name = ?), (SELECT uid FROM users WHERE name = ?), \
    31     \ ?, ?, ?)"
    32     \ ?, ?, ?, ?)"
    32 
    33 
    33 dbQueryReplayFilename = "SELECT filename FROM achievements WHERE id = ?"
    34 dbQueryReplayFilename = "SELECT filename FROM achievements WHERE id = ?"
    34 
    35 
    35 
    36 
    36 dbInteractionLoop dbConn = forever $ do
    37 dbInteractionLoop dbConn = forever $ do
    68                 hFlush stdout
    69                 hFlush stdout
    69 
    70 
    70         SendStats clients rooms ->
    71         SendStats clients rooms ->
    71                 run dbConn dbQueryStats [SqlInt32 $ fromIntegral clients, SqlInt32 $ fromIntegral rooms] >> return ()
    72                 run dbConn dbQueryStats [SqlInt32 $ fromIntegral clients, SqlInt32 $ fromIntegral rooms] >> return ()
    72 --StoreAchievements (B.pack fileName) (map toPair teams) info
    73 --StoreAchievements (B.pack fileName) (map toPair teams) info
    73         StoreAchievements fileName teams info -> 
    74         StoreAchievements p fileName teams info -> 
    74             mapM_ (run dbConn dbQueryAchievement) $ (parseStats fileName teams) info
    75             mapM_ (run dbConn dbQueryAchievement) $ (parseStats p fileName teams) info
    75 
    76 
    76 
    77 
    77 readTime = read . B.unpack . B.take 19 . B.drop 8
    78 readTime = read . B.unpack . B.take 19 . B.drop 8
    78 
    79 
    79 
    80 
    80 parseStats :: B.ByteString -> [(B.ByteString, B.ByteString)] -> [B.ByteString] -> [[SqlValue]]
    81 parseStats :: Word16 -> B.ByteString -> [(B.ByteString, B.ByteString)] -> [B.ByteString] -> [[SqlValue]]
    81 parseStats fileName teams = ps
    82 parseStats p fileName teams = ps
    82     where
    83     where
    83     time = readTime fileName
    84     time = readTime fileName
    84     ps [] = []
    85     ps [] = []
    85     ps ("DRAW" : bs) = ps bs
    86     ps ("DRAW" : bs) = ps bs
    86     ps ("WINNERS" : n : bs) = ps $ drop (readInt_ n) bs
    87     ps ("WINNERS" : n : bs) = ps $ drop (readInt_ n) bs
    89         , SqlByteString typ
    90         , SqlByteString typ
    90         , SqlByteString $ fromMaybe "" (lookup teamname teams)
    91         , SqlByteString $ fromMaybe "" (lookup teamname teams)
    91         , SqlInt32 (readInt_ value)
    92         , SqlInt32 (readInt_ value)
    92         , SqlByteString fileName
    93         , SqlByteString fileName
    93         , SqlByteString location
    94         , SqlByteString location
       
    95         , SqlInt32 $ fromIntegral p
    94         ] : ps bs
    96         ] : ps bs
    95     ps (b:bs) = ps bs
    97     ps (b:bs) = ps bs
    96 
    98 
    97 
    99 
    98 dbConnectionLoop mySQLConnectionInfo =
   100 dbConnectionLoop mySQLConnectionInfo =