v3 upgrade code works
but write the index file a lot, so slow
This commit is contained in:
parent
66ceb92702
commit
af10b2854a
4 changed files with 94 additions and 50 deletions
|
@ -30,6 +30,7 @@ import Backend
|
|||
import Messages
|
||||
import Version
|
||||
import Utility
|
||||
import qualified Upgrade.V2
|
||||
|
||||
-- v2 adds hashing of filenames of content and location log files.
|
||||
-- Key information is encoded in filenames differently, so
|
||||
|
@ -70,8 +71,8 @@ upgrade = do
|
|||
|
||||
AnnexQueue.flush True
|
||||
setVersion
|
||||
|
||||
return True
|
||||
|
||||
Upgrade.V2.upgrade
|
||||
|
||||
moveContent :: Annex ()
|
||||
moveContent = do
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
{- git-annex v2 -> v2 upgrade support
|
||||
{- git-annex v2 -> v3 upgrade support
|
||||
-
|
||||
- Copyright 2011 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
|
@ -9,14 +9,22 @@ module Upgrade.V2 where
|
|||
|
||||
import System.Directory
|
||||
import System.FilePath
|
||||
import Control.Monad.State (liftIO)
|
||||
import List
|
||||
import Data.Maybe
|
||||
|
||||
import Types.Key
|
||||
import Types
|
||||
import qualified Annex
|
||||
import qualified GitRepo as Git
|
||||
import qualified Branch
|
||||
import Messages
|
||||
import Utility
|
||||
import Locations
|
||||
|
||||
olddir :: FilePath
|
||||
olddir = ".git-annex"
|
||||
|
||||
{- .git-annex/ moved to a git-annex branch.
|
||||
-
|
||||
- Strategy:
|
||||
|
@ -35,7 +43,36 @@ import Locations
|
|||
upgrade :: Annex Bool
|
||||
upgrade = do
|
||||
showNote "v2 to v3"
|
||||
error "TODO"
|
||||
g <- Annex.gitRepo
|
||||
Branch.create
|
||||
mapM_ (\(k, f) -> inject f $ logFile k) =<< locationLogs g
|
||||
mapM_ (\f -> inject f f) =<< logFiles olddir
|
||||
liftIO $ do
|
||||
Git.run g "rm" [Param "-r", Param "-f", Param "-q", File olddir]
|
||||
gitAttributesUnWrite g
|
||||
return True
|
||||
|
||||
locationLogs :: Git.Repo -> Annex [(Key, FilePath)]
|
||||
locationLogs repo = liftIO $ do
|
||||
levela <- dirContents dir
|
||||
levelb <- mapM tryDirContents levela
|
||||
files <- mapM tryDirContents (concat levelb)
|
||||
return $ catMaybes $ map islogfile (concat files)
|
||||
where
|
||||
tryDirContents d = catch (dirContents d) (return . const [])
|
||||
dir = gitStateDir repo
|
||||
islogfile f = maybe Nothing (\k -> Just $ (k, f)) $
|
||||
logFileKey $ takeFileName f
|
||||
|
||||
inject :: FilePath -> FilePath -> Annex ()
|
||||
inject source dest = do
|
||||
new <- liftIO (readFile $ olddir </> source)
|
||||
prev <- Branch.get dest
|
||||
Branch.change dest $ unlines $ nub $ lines prev ++ lines new
|
||||
|
||||
logFiles :: FilePath -> Annex [FilePath]
|
||||
logFiles dir = return . filter (".log" `isSuffixOf`)
|
||||
=<< liftIO (getDirectoryContents dir)
|
||||
|
||||
{- Old .gitattributes contents, not needed anymore. -}
|
||||
attrLines :: [String]
|
||||
|
@ -49,15 +86,6 @@ gitAttributesUnWrite repo = do
|
|||
let attributes = Git.attributes repo
|
||||
whenM (doesFileExist attributes) $ do
|
||||
c <- readFileStrict attributes
|
||||
safeWriteFile attributes $ unlines $
|
||||
liftIO $ safeWriteFile attributes $ unlines $
|
||||
filter (\l -> not $ l `elem` attrLines) $ lines c
|
||||
|
||||
oldlogFile :: Git.Repo -> Key -> String
|
||||
oldlogFile = logFile' hashDirLower
|
||||
|
||||
oldlogFileOld :: Git.Repo -> Key -> String
|
||||
oldlogFileOld = logFile' hashDirMixed
|
||||
|
||||
logFile' :: (Key -> FilePath) -> Git.Repo -> Key -> String
|
||||
logFile' hasher repo key =
|
||||
gitStateDir repo ++ hasher key ++ keyFile key ++ ".log"
|
||||
Git.run repo "add" [File attributes]
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue