mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

use git-annex branch for location log

Browse source
This commit is contained in:
Joey Hess 2011-06-22 16:01:32 -04:00
parent 06c58922bd
commit 2e5c8ca6bf
2 changed files with 10 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
Content.hs
View file

@ -81,9 +81,7 @@ logStatusFor :: UUID -> Key -> LogStatus -> Annex ()
logStatusFor u key status = do logStatusFor u key status = do
g <- Annex.gitRepo g <- Annex.gitRepo
unless (Git.repoIsLocalBare g) $ do unless (Git.repoIsLocalBare g) $ do
logfile <- logChange g key u status logChange g key u status
rellogfile <- liftIO $ Git.workTreeFile g logfile
AnnexQueue.add "add" [Param "--"] rellogfile
{- Runs an action, passing it a temporary filename to download, {- Runs an action, passing it a temporary filename to download,
- and if the action succeeds, moves the temp file into - and if the action succeeds, moves the temp file into

24
LocationLog.hs
View file

@ -3,16 +3,12 @@
- git-annex keeps track of which repositories have the contents of annexed - git-annex keeps track of which repositories have the contents of annexed
- files. - files.
- -
- Location tracking information is stored in `.git-annex/key.log`.
- Repositories record their UUID and the date when they --get or --drop - Repositories record their UUID and the date when they --get or --drop
- a value. - a value.
- -
- A line of the log will look like: "date N UUID" - A line of the log will look like: "date N UUID"
- Where N=1 when the repo has the file, and 0 otherwise. - Where N=1 when the repo has the file, and 0 otherwise.
- -
- Git is configured to use a union merge for this file,
- so the lines may be in arbitrary order, but it will never conflict.
-
- Copyright 2010-2011 Joey Hess <joey@kitenet.net> - Copyright 2010-2011 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - Licensed under the GNU GPL version 3 or higher.
@ -39,6 +35,7 @@ import Data.Maybe
import Control.Monad.State (liftIO) import Control.Monad.State (liftIO)
import qualified GitRepo as Git import qualified GitRepo as Git
import qualified Branch
import Utility import Utility
import UUID import UUID
import Types import Types
@ -85,24 +82,21 @@ instance Read LogLine where
bad = ret $ LogLine 0 Undefined "" bad = ret $ LogLine 0 Undefined ""
ret v = [(v, "")] ret v = [(v, "")]
{- Log a change in the presence of a key's value in a repository, {- Log a change in the presence of a key's value in a repository. -}
- and returns the filename of the logfile. -} logChange :: Git.Repo -> Key -> UUID -> LogStatus -> Annex ()
logChange :: Git.Repo -> Key -> UUID -> LogStatus -> Annex FilePath
logChange repo key u s = do logChange repo key u s = do
when (null u) $ when (null u) $
error $ "unknown UUID for " ++ Git.repoDescribe repo ++ error $ "unknown UUID for " ++ Git.repoDescribe repo ++
" (have you run git annex init there?)" " (have you run git annex init there?)"
line <- logNow s u line <- logNow s u
let f = logFile repo key let f = logFile repo key
ls' <- readLog $ logFileOld repo key
ls <- readLog f ls <- readLog f
writeLog f (compactLog $ line:ls'++ls) writeLog f (compactLog $ line:ls)
return f
{- Reads a log file. {- Reads a log file.
- Note that the LogLines returned may be in any order. -} - Note that the LogLines returned may be in any order. -}
readLog :: FilePath -> Annex [LogLine] readLog :: FilePath -> Annex [LogLine]
readLog file = liftIO $ catch (return . parseLog =<< readFileStrict file) (const $ return []) readLog file = return . parseLog =<< Branch.get file
parseLog :: String -> [LogLine] parseLog :: String -> [LogLine]
parseLog s = filter parsable $ map read $ lines s parseLog s = filter parsable $ map read $ lines s
@ -110,9 +104,9 @@ parseLog s = filter parsable $ map read $ lines s
-- some lines may be unparseable, avoid them -- some lines may be unparseable, avoid them
parsable l = status l /= Undefined parsable l = status l /= Undefined
{- Writes a set of lines to a log file -} {- Stores a set of lines in a log file -}
writeLog :: FilePath -> [LogLine] -> Annex () writeLog :: FilePath -> [LogLine] -> Annex ()
writeLog file ls = liftIO $ safeWriteFile file (unlines $ map show ls) writeLog file ls = Branch.change file (unlines $ map show ls)
{- Generates a new LogLine with the current date. -} {- Generates a new LogLine with the current date. -}
logNow :: LogStatus -> UUID -> Annex LogLine logNow :: LogStatus -> UUID -> Annex LogLine
@ -125,8 +119,7 @@ logNow s u = do
keyLocations :: Git.Repo -> Key -> Annex [UUID] keyLocations :: Git.Repo -> Key -> Annex [UUID]
keyLocations thisrepo key = do keyLocations thisrepo key = do
ls <- readLog $ logFile thisrepo key ls <- readLog $ logFile thisrepo key
ls' <- readLog $ logFileOld thisrepo key return $ map uuid $ filterPresent ls
return $ map uuid $ filterPresent $ ls'++ls
{- Filters the list of LogLines to find ones where the value {- Filters the list of LogLines to find ones where the value
- is (or should still be) present. -} - is (or should still be) present. -}
@ -158,6 +151,7 @@ mapLog m l =
- (There may be duplicate keys in the list.) -} - (There may be duplicate keys in the list.) -}
loggedKeys :: Git.Repo -> Annex [Key] loggedKeys :: Git.Repo -> Annex [Key]
loggedKeys repo = do loggedKeys repo = do
error "FIXME.. does not look in git-annex branch yet"
exists <- liftIO $ doesDirectoryExist dir exists <- liftIO $ doesDirectoryExist dir
if exists if exists
then do then do