all Walls are clean!
This commit is contained in:
parent
cf4c926f2e
commit
dda0679290
1 changed files with 16 additions and 14 deletions
30
UUID.hs
30
UUID.hs
|
@ -36,6 +36,7 @@ import Utility
|
|||
|
||||
type UUID = String
|
||||
|
||||
configkey :: String
|
||||
configkey="annex.uuid"
|
||||
|
||||
{- 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
|
||||
g <- Annex.gitRepo
|
||||
|
||||
let c = cached r g
|
||||
let u = uncached r
|
||||
let c = cached g
|
||||
let u = uncached
|
||||
|
||||
if (c /= u && u /= "")
|
||||
then do
|
||||
updatecache g r u
|
||||
updatecache g u
|
||||
return u
|
||||
else return c
|
||||
where
|
||||
uncached r = Git.configGet r "annex.uuid" ""
|
||||
cached r g = Git.configGet g (cachekey r) ""
|
||||
updatecache g r u = when (g /= r) $ setConfig (cachekey r) u
|
||||
cachekey r = "remote." ++ (Git.repoRemoteName r) ++ ".annex-uuid"
|
||||
uncached = Git.configGet r "annex.uuid" ""
|
||||
cached g = Git.configGet g cachekey ""
|
||||
updatecache g u = when (g /= r) $ setConfig cachekey u
|
||||
cachekey = "remote." ++ (Git.repoRemoteName r) ++ ".annex-uuid"
|
||||
|
||||
{- Make sure that the repo has an annex.uuid setting. -}
|
||||
prepUUID :: Annex ()
|
||||
|
@ -111,26 +112,27 @@ describeUUID :: UUID -> String -> Annex ()
|
|||
describeUUID uuid desc = do
|
||||
m <- uuidMap
|
||||
let m' = M.insert uuid desc m
|
||||
log <- uuidLog
|
||||
logfile <- uuidLog
|
||||
pid <- liftIO $ getProcessID
|
||||
let tmplog = log ++ ".tmp" ++ show pid
|
||||
liftIO $ createDirectoryIfMissing True (parentDir log)
|
||||
liftIO $ writeFile tmplog $ serialize m'
|
||||
liftIO $ renameFile tmplog log
|
||||
let tmplogfile = logfile ++ ".tmp" ++ show pid
|
||||
liftIO $ createDirectoryIfMissing True (parentDir logfile)
|
||||
liftIO $ writeFile tmplogfile $ serialize m'
|
||||
liftIO $ renameFile tmplogfile logfile
|
||||
where
|
||||
serialize m = unlines $ map (\(u, d) -> u++" "++d) $ M.toList m
|
||||
|
||||
{- Read and parse the uuidLog into a Map -}
|
||||
uuidMap :: Annex (M.Map UUID String)
|
||||
uuidMap = do
|
||||
log <- uuidLog
|
||||
s <- liftIO $ catch (readFile log) (\error -> return "")
|
||||
logfile <- uuidLog
|
||||
s <- liftIO $ catch (readFile logfile) ignoreerror
|
||||
return $ M.fromList $ map (\l -> pair l) $ lines s
|
||||
where
|
||||
pair l =
|
||||
if (1 < (length $ words l))
|
||||
then ((words l) !! 0, unwords $ drop 1 $ words l)
|
||||
else ("", "")
|
||||
ignoreerror _ = return ""
|
||||
|
||||
{- Filename of uuid.log. -}
|
||||
uuidLog :: Annex String
|
||||
|
|
Loading…
Reference in a new issue