adding file presence calculation code

This commit is contained in:
Joey Hess 2010-10-09 22:46:35 -04:00
parent 9ae522bb76
commit 011118dbdf

View file

@ -5,12 +5,12 @@
- When you indicate you --want a file, git-annex will tell you which - When you indicate you --want a file, git-annex will tell you which
- repositories have the file's content. - repositories have the file's content.
- -
- Location tracking information is stored in `.git-annex/$filename.log`. - Location tracking information is stored in `.git-annex/filename.log`.
- Repositories record their name and the date when they --get or --drop - Repositories record their name and the date when they --get or --drop
- a file's content. (Git is configured to use a union merge for this file, - a file's content. (Git is configured to use a union merge for this file,
- so the lines may be in arbitrary order, but it will never conflict.) - so the lines may be in arbitrary order, but it will never conflict.)
- -
- A line of the log will look like: "date N reponame filename" - A line of the log will look like: "date N reponame"
- Where N=1 when the repo has the file, and 0 otherwise. - Where N=1 when the repo has the file, and 0 otherwise.
- -
-} -}
@ -19,8 +19,8 @@ module LocationLog where
import Data.DateTime import Data.DateTime
import System.IO import System.IO
import System.Posix.IO
import GitRepo import GitRepo
import Utility
data LogStatus = FilePresent | FileMissing | Undefined data LogStatus = FilePresent | FileMissing | Undefined
deriving (Eq) deriving (Eq)
@ -38,28 +38,26 @@ instance Read LogStatus where
data LogLine = LogLine { data LogLine = LogLine {
date :: DateTime, date :: DateTime,
status :: LogStatus, status :: LogStatus,
repo :: String, repo :: String
file :: String
} deriving (Eq) } deriving (Eq)
instance Show LogLine where instance Show LogLine where
show (LogLine date status repo file) = unwords show (LogLine date status repo) = unwords
[(show (toSeconds date)), (show status), repo, file] [(show (toSeconds date)), (show status), repo]
instance Read LogLine where instance Read LogLine where
-- This parser is robust in that even unparsable log lines are -- This parser is robust in that even unparsable log lines are
-- read without an exception being thrown. -- read without an exception being thrown.
-- Such lines have a status of Undefined. -- Such lines have a status of Undefined.
readsPrec _ string = if (length w >= 3) readsPrec _ string = if (length w >= 3)
then [((LogLine date status repo file), "")] then [((LogLine date status repo), "")]
else [((LogLine (fromSeconds 0) Undefined "" ""), "")] else [((LogLine (fromSeconds 0) Undefined ""), "")]
where where
date = fromSeconds $ read $ w !! 0 date = fromSeconds $ read $ w !! 0
status = read $ w !! 1 status = read $ w !! 1
repo = w !! 2 repo = unwords $ rest w
file = unwords $ rest w
w = words string w = words string
rest (_:_:_:l) = l rest (_:_:l) = l
{- Reads a log file -} {- Reads a log file -}
readLog :: String -> IO [LogLine] readLog :: String -> IO [LogLine]
@ -77,23 +75,11 @@ writeLog file line = do
hPutStrLn h $ show line hPutStrLn h $ show line
hClose h hClose h
{- Let's just say that Haskell makes reading/writing a file with {- Generates a new LogLine with the current date. -}
- file locking excessively difficult. -} logNow :: LogStatus -> String -> IO LogLine
openLocked file mode = do logNow status repo = do
handle <- openFile file mode
lockfd <- handleToFd handle -- closes handle
waitToSetLock lockfd (lockType mode, AbsoluteSeek, 0, 0)
handle' <- fdToHandle lockfd
return handle'
where
lockType ReadMode = ReadLock
lockType _ = WriteLock
{- Generates a new log line with the current date. -}
logNow :: LogStatus -> String -> String -> IO LogLine
logNow status repo file = do
now <- getCurrentTime now <- getCurrentTime
return $ LogLine now status repo file return $ LogLine now status repo
{- Returns the filename of the log file for a given annexed file. -} {- Returns the filename of the log file for a given annexed file. -}
logFile :: String -> IO String logFile :: String -> IO String
@ -101,3 +87,16 @@ logFile annexedFile = do
repo <- repoTop repo <- repoTop
return $ repo ++ "/.git-annex/" ++ return $ repo ++ "/.git-annex/" ++
(gitRelative repo annexedFile) ++ ".log" (gitRelative repo annexedFile) ++ ".log"
{- Returns a list of repositories that, according to the log, have
- the content of a file -}
fileLocations :: String -> IO [String]
fileLocations file = do
log <- logFile file
lines <- readLog log
return $ map repo (filterPresent lines)
{- Filters the list of LogLines to find repositories where the file
- is (or should still be) present. -}
filterPresent :: [LogLine] -> [LogLine]
filterPresent lines =