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

all Walls are clean!

Browse source
This commit is contained in:
Joey Hess 2010-10-31 16:04:19 -04:00
commit dda0679290
1 changed files with 16 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

30
UUID.hs
View file

@ -36,6 +36,7 @@ import Utility
type UUID = String type UUID = String
configkey :: String
configkey="annex.uuid" configkey="annex.uuid"
{- Generates a UUID. There is a library for this, but it's not packaged, {- Generates a UUID. There is a library for this, but it's not packaged,
@ -53,19 +54,19 @@ getUUID :: Git.Repo -> Annex UUID
getUUID r = do getUUID r = do
g <- Annex.gitRepo g <- Annex.gitRepo
let c = cached r g let c = cached g
let u = uncached r let u = uncached
if (c /= u && u /= "") if (c /= u && u /= "")
then do then do
updatecache g r u updatecache g u
return u return u
else return c else return c
where where
uncached r = Git.configGet r "annex.uuid" "" uncached = Git.configGet r "annex.uuid" ""
cached r g = Git.configGet g (cachekey r) "" cached g = Git.configGet g cachekey ""
updatecache g r u = when (g /= r) $ setConfig (cachekey r) u updatecache g u = when (g /= r) $ setConfig cachekey u
cachekey r = "remote." ++ (Git.repoRemoteName r) ++ ".annex-uuid" cachekey = "remote." ++ (Git.repoRemoteName r) ++ ".annex-uuid"
{- Make sure that the repo has an annex.uuid setting. -} {- Make sure that the repo has an annex.uuid setting. -}
prepUUID :: Annex () prepUUID :: Annex ()
@ -111,26 +112,27 @@ describeUUID :: UUID -> String -> Annex ()
describeUUID uuid desc = do describeUUID uuid desc = do
m <- uuidMap m <- uuidMap
let m' = M.insert uuid desc m let m' = M.insert uuid desc m
log <- uuidLog logfile <- uuidLog
pid <- liftIO $ getProcessID pid <- liftIO $ getProcessID
let tmplog = log ++ ".tmp" ++ show pid let tmplogfile = logfile ++ ".tmp" ++ show pid
liftIO $ createDirectoryIfMissing True (parentDir log) liftIO $ createDirectoryIfMissing True (parentDir logfile)
liftIO $ writeFile tmplog $ serialize m' liftIO $ writeFile tmplogfile $ serialize m'
liftIO $ renameFile tmplog log liftIO $ renameFile tmplogfile logfile
where where
serialize m = unlines $ map (\(u, d) -> u++" "++d) $ M.toList m serialize m = unlines $ map (\(u, d) -> u++" "++d) $ M.toList m
{- Read and parse the uuidLog into a Map -} {- Read and parse the uuidLog into a Map -}
uuidMap :: Annex (M.Map UUID String) uuidMap :: Annex (M.Map UUID String)
uuidMap = do uuidMap = do
log <- uuidLog logfile <- uuidLog
s <- liftIO $ catch (readFile log) (\error -> return "") s <- liftIO $ catch (readFile logfile) ignoreerror
return $ M.fromList $ map (\l -> pair l) $ lines s return $ M.fromList $ map (\l -> pair l) $ lines s
where where
pair l = pair l =
if (1 < (length $ words l)) if (1 < (length $ words l))
then ((words l) !! 0, unwords $ drop 1 $ words l) then ((words l) !! 0, unwords $ drop 1 $ words l)
else ("", "") else ("", "")
ignoreerror _ = return ""
{- Filename of uuid.log. -} {- Filename of uuid.log. -}
uuidLog :: Annex String uuidLog :: Annex String