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:
hallgren
2014-03-19 16:15:05 +00:00
parent fd8cf9af58
commit 6cc8557e6b
3 changed files with 8 additions and 2 deletions

View File

@@ -152,6 +152,7 @@ handle logLn documentroot state0 cache execute1 stateVar
-- "/start" ->
"/parse" -> parse (decoded qs)
"/version" -> return (ok200 gf_version)
"/flush" -> do PS.flushPGFCache cache; return (ok200 "flushed")
'/':rpath ->
-- This code runs without mutual exclusion, so it must *not*
-- use/change the cwd. Access files by absolute paths only.

View File

@@ -1,4 +1,4 @@
module Cache (Cache,newCache,readCache) where
module Cache (Cache,newCache,flushCache,readCache) where
import Control.Concurrent.MVar
import Data.Map (Map)
@@ -17,6 +17,9 @@ newCache load =
do objs <- newMVar Map.empty
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 c file =
do v <- modifyMVar (cacheObjects c) findEntry

View File

@@ -1,7 +1,7 @@
{-# LANGUAGE CPP #-}
module PGFService(cgiMain,cgiMain',getPath,
logFile,stderrToFile,
newPGFCache) where
newPGFCache,flushPGFCache) where
import PGF (PGF)
import qualified PGF
@@ -51,10 +51,12 @@ newPGFCache = do pgfCache <- newCache PGF.readPGF
pc <- newMVar Map.empty
return (pgf,pc)
return (pgfCache,cCache)
flushPGFCache (c1,c2) = flushCache c1 >> flushCache c2
#else
type Caches = (Cache PGF,())
newPGFCache = do pgfCache <- newCache PGF.readPGF
return (pgfCache,())
flushPGFCache (c1,_) = flushCache c1
#endif
getPath =