adding file presence calculation code
This commit is contained in:
parent
9ae522bb76
commit
011118dbdf
1 changed files with 27 additions and 28 deletions
|
@ -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 =
|
||||||
|
|
Loading…
Reference in a new issue