X-Git-Url: http://www.average.org/gitweb/?p=pulsecounter.git;a=blobdiff_plain;f=linux%2Fquery.cgi;fp=linux%2Fquery.cgi;h=0000000000000000000000000000000000000000;hp=a629c7948c9f39dc8b9468f68dde33b01f0b8059;hb=57ab1d5776f832c3df5c8b2514f34e282b39fbd9;hpb=4908f6680e4a15c2a8bc60814902427b25fdb6c6 diff --git a/linux/query.cgi b/linux/query.cgi deleted file mode 100755 index a629c79..0000000 --- a/linux/query.cgi +++ /dev/null @@ -1,84 +0,0 @@ -#!/usr/bin/env runhaskell - -{-# LANGUAGE OverloadedStrings #-} - -module Main where - -import Control.Monad -import Data.Maybe -import Data.List -import System.Locale -import System.Time -import Network.CGI -import Database.MySQL.Simple - -main = runCGI $ handleErrors cgiMain - -cgiMain :: CGI CGIResult -cgiMain = do - conf <- liftIO $ readConf "/etc/watermeter.db" - conn <- liftIO $ connect defaultConnectInfo { connectHost = host conf - , connectUser = user conf - , connectPassword = pass conf - , connectDatabase = dbnm conf - } - today <- liftIO getClockTime - let tomorrow = addToClockTime (noTimeDiff {tdDay = 1}) today - daystart x = (toUTCTime x) { ctHour = 0, ctMin = 0 - , ctSec = 0, ctPicosec = 0} - dtstr x = formatCalendarTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" x - dlo = dtstr $ daystart today - dhi = dtstr $ daystart tomorrow - ilo <- getInput "lo" - ihi <- getInput "hi" - -- _ <- liftIO $ putStrLn $ " dlo=" ++ show dlo ++ " ilo=" ++ show ilo - -- ++ " dhi=" ++ show dhi ++ " ihi=" ++ show ihi - let slo = fromMaybe dlo ilo :: String - shi = fromMaybe dhi ihi :: String - [(olo, ohi)] <- liftIO $ query conn "select to_seconds(?), to_seconds(?);" - [slo, shi] - cold <- liftIO $ query conn - "select to_seconds(timestamp) as time, value+adj as value from \ - \(select c.timestamp timestamp, c.value value, \ - \(select sum(value) from coldadj a where a.timestamp <= c.timestamp \ - \) adj from coldcnt c \ - \where timestamp between ? and ? order by timestamp \ - \) t;" (slo, shi) - hot <- liftIO $ query conn - "select to_seconds(timestamp) as time, value+adj as value from \ - \(select c.timestamp timestamp, c.value value, \ - \(select sum(value) from hotadj a where a.timestamp <= c.timestamp \ - \) adj from hotcnt c \ - \where timestamp between ? and ? order by timestamp \ - \) t;" (slo, shi) - _ <- liftIO $ close conn - setHeader "Content-type" "application/json" - output $ "{\"range\": {\"lo\": " ++ show (olo :: Int) - ++ ", \"hi\": " ++ show (ohi :: Int) - ++ "}, \"cold\": [" ++ showjson cold - ++ "], \"hot\": [" ++ showjson hot ++ "]}\n" - -showjson :: [(Int, Double)] -> String -showjson l = intercalate "," $ map (\(t, c) -> "[" ++ show t ++ "," ++ show (floor c) ++ "]") l - -data Conf = Conf { host :: String - , user :: String - , pass :: String - , dbnm :: String - } - -readConf :: String -> IO Conf -readConf fn = - readFile fn >>= return . (foldr parseLine (Conf "" "" "" "")) . lines - where - parseLine :: String -> Conf -> Conf - parseLine l sum = - case words l of - [k, v] -> - case k of - "host" -> sum { host = v } - "user" -> sum { user = v } - "password" -> sum { pass = v } - "database" -> sum { dbnm = v } - _ -> error $ "bad key in config line \"" ++ l ++ "\"" - _ -> error $ "bad config line \"" ++ l ++ "\""