forked from GitHub/gf-core
gf -server: add a command to manually flush the PGF cache
This can be used if the cloud service seems slow, but it would probably be better to automatically expire unused PGFs from the cache after some time.
This commit is contained in:
@@ -152,6 +152,7 @@ handle logLn documentroot state0 cache execute1 stateVar
|
|||||||
-- "/start" ->
|
-- "/start" ->
|
||||||
"/parse" -> parse (decoded qs)
|
"/parse" -> parse (decoded qs)
|
||||||
"/version" -> return (ok200 gf_version)
|
"/version" -> return (ok200 gf_version)
|
||||||
|
"/flush" -> do PS.flushPGFCache cache; return (ok200 "flushed")
|
||||||
'/':rpath ->
|
'/':rpath ->
|
||||||
-- This code runs without mutual exclusion, so it must *not*
|
-- This code runs without mutual exclusion, so it must *not*
|
||||||
-- use/change the cwd. Access files by absolute paths only.
|
-- use/change the cwd. Access files by absolute paths only.
|
||||||
|
|||||||
@@ -1,4 +1,4 @@
|
|||||||
module Cache (Cache,newCache,readCache) where
|
module Cache (Cache,newCache,flushCache,readCache) where
|
||||||
|
|
||||||
import Control.Concurrent.MVar
|
import Control.Concurrent.MVar
|
||||||
import Data.Map (Map)
|
import Data.Map (Map)
|
||||||
@@ -17,6 +17,9 @@ newCache load =
|
|||||||
do objs <- newMVar Map.empty
|
do objs <- newMVar Map.empty
|
||||||
return $ Cache { cacheLoad = load, cacheObjects = objs }
|
return $ Cache { cacheLoad = load, cacheObjects = objs }
|
||||||
|
|
||||||
|
flushCache :: Cache a -> IO ()
|
||||||
|
flushCache c = modifyMVar_ (cacheObjects c) (const (return Map.empty))
|
||||||
|
|
||||||
readCache :: Cache a -> FilePath -> IO a
|
readCache :: Cache a -> FilePath -> IO a
|
||||||
readCache c file =
|
readCache c file =
|
||||||
do v <- modifyMVar (cacheObjects c) findEntry
|
do v <- modifyMVar (cacheObjects c) findEntry
|
||||||
|
|||||||
@@ -1,7 +1,7 @@
|
|||||||
{-# LANGUAGE CPP #-}
|
{-# LANGUAGE CPP #-}
|
||||||
module PGFService(cgiMain,cgiMain',getPath,
|
module PGFService(cgiMain,cgiMain',getPath,
|
||||||
logFile,stderrToFile,
|
logFile,stderrToFile,
|
||||||
newPGFCache) where
|
newPGFCache,flushPGFCache) where
|
||||||
|
|
||||||
import PGF (PGF)
|
import PGF (PGF)
|
||||||
import qualified PGF
|
import qualified PGF
|
||||||
@@ -51,10 +51,12 @@ newPGFCache = do pgfCache <- newCache PGF.readPGF
|
|||||||
pc <- newMVar Map.empty
|
pc <- newMVar Map.empty
|
||||||
return (pgf,pc)
|
return (pgf,pc)
|
||||||
return (pgfCache,cCache)
|
return (pgfCache,cCache)
|
||||||
|
flushPGFCache (c1,c2) = flushCache c1 >> flushCache c2
|
||||||
#else
|
#else
|
||||||
type Caches = (Cache PGF,())
|
type Caches = (Cache PGF,())
|
||||||
newPGFCache = do pgfCache <- newCache PGF.readPGF
|
newPGFCache = do pgfCache <- newCache PGF.readPGF
|
||||||
return (pgfCache,())
|
return (pgfCache,())
|
||||||
|
flushPGFCache (c1,_) = flushCache c1
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
getPath =
|
getPath =
|
||||||
|
|||||||
Reference in New Issue
Block a user