update the cache automatically when moving objects in or out

This commit is contained in:
Joey Hess 2012-12-08 13:13:36 -04:00
parent 78498719a0
commit 664765e757
2 changed files with 25 additions and 12 deletions

View file

@ -187,10 +187,10 @@ prepTmp key = do
- and not being copied into place. -} - and not being copied into place. -}
getViaTmpUnchecked :: Key -> (FilePath -> Annex Bool) -> Annex Bool getViaTmpUnchecked :: Key -> (FilePath -> Annex Bool) -> Annex Bool
getViaTmpUnchecked key action = do getViaTmpUnchecked key action = do
tmp <- prepTmp key tmpfile <- prepTmp key
ifM (action tmp) ifM (action tmpfile)
( do ( do
moveAnnex key tmp moveAnnex key tmpfile
logStatus key InfoPresent logStatus key InfoPresent
return True return True
, do , do
@ -267,6 +267,7 @@ moveAnnex key src = withObjectLoc key storeobject storedirect
) )
storedirect [] = storeobject =<< inRepo (gitAnnexLocation key) storedirect [] = storeobject =<< inRepo (gitAnnexLocation key)
storedirect (dest:fs) = do storedirect (dest:fs) = do
updateCache key src
thawContent src thawContent src
liftIO $ replaceFile dest $ moveFile src liftIO $ replaceFile dest $ moveFile src
liftIO $ forM_ fs $ \f -> replaceFile f $ createLink dest liftIO $ forM_ fs $ \f -> replaceFile f $ createLink dest
@ -305,7 +306,9 @@ removeAnnex key = withObjectLoc key remove removedirect
allowWrite $ parentDir file allowWrite $ parentDir file
removeFile file removeFile file
cleanObjectLoc key cleanObjectLoc key
removedirect fs = mapM_ resetfile fs removedirect fs = do
removeCache key
mapM_ resetfile fs
resetfile f = do resetfile f = do
l <- calcGitLink f key l <- calcGitLink f key
top <- fromRepo Git.repoPath top <- fromRepo Git.repoPath

View file

@ -8,8 +8,8 @@
module Annex.Content.Direct ( module Annex.Content.Direct (
associatedFiles, associatedFiles,
unmodifed, unmodifed,
getCache, updateCache,
showCache, removeCache
) where ) where
import Common.Annex import Common.Annex
@ -39,12 +39,22 @@ associatedFiles key = do
- expected mtime and inode. - expected mtime and inode.
-} -}
unmodifed :: Key -> FilePath -> Annex Bool unmodifed :: Key -> FilePath -> Annex Bool
unmodifed key file = do unmodifed key file = withCacheFile key $ \cachefile -> do
cachefile <- inRepo $ gitAnnexCache key curr <- getCache file
liftIO $ do old <- catchDefaultIO Nothing $ readCache <$> readFile cachefile
curr <- getCache file return $ isJust curr && curr == old
old <- catchDefaultIO Nothing $ readCache <$> readFile cachefile
return $ isJust curr && curr == old {- Stores a cache of attributes for a file that is associated with a key. -}
updateCache :: Key -> FilePath -> Annex ()
updateCache key file = withCacheFile key $ \cachefile ->
maybe noop (writeFile cachefile . showCache) =<< getCache file
{- Removes a cache. -}
removeCache :: Key -> Annex ()
removeCache key = withCacheFile key nukeFile
withCacheFile :: Key -> (FilePath -> IO a) -> Annex a
withCacheFile key a = liftIO . a =<< inRepo (gitAnnexCache key)
{- Cache a file's inode, size, and modification time to determine if it's {- Cache a file's inode, size, and modification time to determine if it's
- been changed. -} - been changed. -}