use queue when upgrading, flushing every so often

Added a cheap way to query the size of a queue.

runQueueAt is not the default yet only because there may be some code that
expects to be able to queue some suff, do something else, and run the whole
queue at the end.

10240 is an arbitrary size for the queue. If we assume annexed
filenames are between 10 and 255 characters long, then the queue will
build up between 100kb and 2550kb long commands. The max command line
length on linux is somewhere above 20k, so this is a fairly good balance --
the queue will buffer only a few megabytes of stuff and a minimal number
of commands will be run by xargs.

Also, insert queue items strictly, this should save memory.
This commit is contained in:
Joey Hess 2011-03-16 15:10:15 -04:00
parent 0f8edc99ee
commit bc21502b9a
4 changed files with 34 additions and 18 deletions

View file

@ -16,6 +16,7 @@ module Annex (
gitRepo, gitRepo,
queue, queue,
queueRun, queueRun,
queueRunAt,
setConfig, setConfig,
repoConfig repoConfig
) where ) where
@ -109,6 +110,13 @@ queueRun = do
liftIO $ GitQueue.run g q liftIO $ GitQueue.run g q
put state { repoqueue = GitQueue.empty } put state { repoqueue = GitQueue.empty }
{- Runs the queue if the specified number of items have been queued. -}
queueRunAt :: Integer -> Annex ()
queueRunAt n = do
state <- get
let q = repoqueue state
when (GitQueue.size q >= n) queueRun
{- Changes a git config setting in both internal state and .git/config -} {- Changes a git config setting in both internal state and .git/config -}
setConfig :: String -> String -> Annex () setConfig :: String -> String -> Annex ()
setConfig k value = do setConfig k value = do

View file

@ -99,7 +99,7 @@ startup = do
shutdown :: Annex Bool shutdown :: Annex Bool
shutdown = do shutdown = do
q <- Annex.getState Annex.repoqueue q <- Annex.getState Annex.repoqueue
unless (q == GitQueue.empty) $ do unless (0 == GitQueue.size q) $ do
showSideAction "Recording state in git..." showSideAction "Recording state in git..."
Annex.queueRun Annex.queueRun

View file

@ -9,6 +9,7 @@ module GitQueue (
Queue, Queue,
empty, empty,
add, add,
size,
run run
) where ) where
@ -31,22 +32,28 @@ data Action = Action {
{- A queue of actions to perform (in any order) on a git repository, {- A queue of actions to perform (in any order) on a git repository,
- with lists of files to perform them on. This allows coalescing - with lists of files to perform them on. This allows coalescing
- similar git commands. -} - similar git commands. -}
type Queue = M.Map Action [FilePath] data Queue = Queue Integer (M.Map Action [FilePath])
deriving (Show, Eq)
{- Constructor for empty queue. -} {- Constructor for empty queue. -}
empty :: Queue empty :: Queue
empty = M.empty empty = Queue 0 M.empty
{- Adds an action to a queue. -} {- Adds an action to a queue. -}
add :: Queue -> String -> [CommandParam] -> FilePath -> Queue add :: Queue -> String -> [CommandParam] -> FilePath -> Queue
add queue subcommand params file = M.insertWith (++) action [file] queue add (Queue n m) subcommand params file = Queue (n + 1) m'
where where
action = Action subcommand params action = Action subcommand params
m' = M.insertWith' (++) action [file] m
{- Number of items in a queue. -}
size :: Queue -> Integer
size (Queue n _) = n
{- Runs a queue on a git repository. -} {- Runs a queue on a git repository. -}
run :: Git.Repo -> Queue -> IO () run :: Git.Repo -> Queue -> IO ()
run repo queue = do run repo (Queue _ m) = do
forM_ (M.toList queue) $ uncurry $ runAction repo forM_ (M.toList m) $ uncurry $ runAction repo
return () return ()
{- Runs an Action on a list of files in a git repository. {- Runs an Action on a list of files in a git repository.

View file

@ -66,9 +66,10 @@ upgrade = do
updateSymlinks updateSymlinks
moveLocationLogs moveLocationLogs
Annex.queueRun
-- add new line to auto-merge hashed location logs -- add new line to auto-merge hashed location logs
-- this commits, so has to come after the upgrade -- this commits, so has to come after the upgrade
g <- Annex.gitRepo
liftIO $ Command.Init.gitAttributesWrite g liftIO $ Command.Init.gitAttributesWrite g
setVersion setVersion
@ -92,18 +93,18 @@ updateSymlinks :: Annex ()
updateSymlinks = do updateSymlinks = do
g <- Annex.gitRepo g <- Annex.gitRepo
files <- liftIO $ Git.inRepo g [Git.workTree g] files <- liftIO $ Git.inRepo g [Git.workTree g]
forM_ files $ (fixlink g) forM_ files $ fixlink
where where
fixlink g f = do fixlink f = do
r <- lookupFile1 f r <- lookupFile1 f
case r of case r of
Nothing -> return () Nothing -> return ()
Just (k, _) -> do Just (k, _) -> do
link <- calcGitLink f k link <- calcGitLink f k
liftIO $ do liftIO $ removeFile f
removeFile f liftIO $ createSymbolicLink link f
createSymbolicLink link f Annex.queue "add" [Param "--"] f
Git.run g "add" [Param "--", File f] Annex.queueRunAt 1024
moveLocationLogs :: Annex () moveLocationLogs :: Annex ()
moveLocationLogs = do moveLocationLogs = do
@ -127,11 +128,11 @@ moveLocationLogs = do
-- logs that have been pulled from elsewhere -- logs that have been pulled from elsewhere
old <- liftIO $ readLog f old <- liftIO $ readLog f
new <- liftIO $ readLog dest new <- liftIO $ readLog dest
liftIO $ do liftIO $ writeLog dest (old++new)
writeLog dest (old++new) Annex.queue "add" [Param "--"] dest
Git.run g "add" [Param "--", File dest] Annex.queue "add" [Param "--"] f
Git.run g "add" [Param "--", File f] Annex.queue "rm" [Param "--quiet", Param "-f", Param "--"] f
Git.run g "rm" [Param "--quiet", Param "-f", Param "--", File f] Annex.queueRunAt 1024
oldlog2key :: FilePath -> Maybe (FilePath, Key) oldlog2key :: FilePath -> Maybe (FilePath, Key)
oldlog2key l = oldlog2key l =