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

View file

@ -8,8 +8,8 @@
module Annex.Content.Direct (
associatedFiles,
unmodifed,
getCache,
showCache,
updateCache,
removeCache
) where
import Common.Annex
@ -39,12 +39,22 @@ associatedFiles key = do
- expected mtime and inode.
-}
unmodifed :: Key -> FilePath -> Annex Bool
unmodifed key file = do
cachefile <- inRepo $ gitAnnexCache key
liftIO $ do
curr <- getCache file
old <- catchDefaultIO Nothing $ readCache <$> readFile cachefile
return $ isJust curr && curr == old
unmodifed key file = withCacheFile key $ \cachefile -> do
curr <- getCache file
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
- been changed. -}