copying almost working

This commit is contained in:
Joey Hess 2010-10-13 16:21:50 -04:00
parent e28ff5bdaf
commit f87c5ed949
4 changed files with 44 additions and 24 deletions

View file

@ -64,8 +64,8 @@ annexFile state file = inBackend file err $ do
else return ()
setup key backend = do
logStatus state key ValuePresent
let dest = annexLocation state backend key
let reldest = annexLocationRelative state backend key
let dest = annexLocation (repo state) backend key
let reldest = annexLocationRelative (repo state) backend key
createDirectoryIfMissing True (parentDir dest)
renameFile file dest
createSymbolicLink ((linkTarget file) ++ reldest) file
@ -94,7 +94,7 @@ unannexFile state file = notinBackend file err $ \(key, backend) -> do
-- git rm deletes empty directories;
-- put them back
createDirectoryIfMissing True (parentDir file)
let src = annexLocation state backend key
let src = annexLocation (repo state) backend key
renameFile src file
return ()
where
@ -107,7 +107,7 @@ annexGetFile state file = notinBackend file err $ \(key, backend) -> do
if (inannex)
then return ()
else do
let dest = annexLocation state backend key
let dest = annexLocation (repo state) backend key
createDirectoryIfMissing True (parentDir dest)
success <- retrieveFile state backend key dest
if (success)
@ -166,4 +166,4 @@ logStatus state key status = do
{- Checks if a given key is currently present in the annexLocation -}
inAnnex :: State -> Backend -> Key -> IO Bool
inAnnex state backend key = doesFileExist $ annexLocation state backend key
inAnnex state backend key = doesFileExist $ annexLocation (repo state) backend key

View file

@ -3,6 +3,9 @@
module BackendFile (backend) where
import System.IO
import System.Cmd
import Control.Exception
import Types
import LocationLog
import Locations
@ -45,12 +48,30 @@ copyKeyFile state key file = do
"To get that file, need access to one of these remotes: " ++
(remotesList full)
trycopy full (r:rs) = do
ok <- copyFromRemote r key file
if (ok)
then return True
else trycopy full rs
putStrLn "trying a remote"
result <- try (copyFromRemote r key file)::IO (Either SomeException ())
case (result) of
Left err -> do
showerr err r
trycopy full rs
Right succ -> return True
showerr err r = do
hPutStrLn stderr $ "git-annex: copy from " ++
(gitRepoDescribe r ) ++ " failed: " ++
(show err)
{- Tries to copy a file from a remote. -}
copyFromRemote :: GitRepo -> Key -> FilePath -> IO (Bool)
{- Tries to copy a file from a remote, exception on error. -}
copyFromRemote :: GitRepo -> Key -> FilePath -> IO ()
copyFromRemote r key file = do
return False -- TODO
r <- if (gitRepoIsLocal r)
then getlocal
else getremote
return ()
where
getlocal = do
putStrLn $ "get: " ++ location
rawSystem "cp" ["-a", location, file]
getremote = do
putStrLn $ "get: " ++ location
error "get via network not yet implemented!"
location = annexLocation r backend key

View file

@ -21,18 +21,18 @@ gitStateDir :: GitRepo -> FilePath
gitStateDir repo = (gitWorkTree repo) ++ "/" ++ stateLoc ++ "/"
{- An annexed file's content is stored in
- .git/annex/<backend>/<key> ; this allows deriving the key and backend
- by looking at the symlink to it. -}
annexLocation :: State -> Backend -> Key -> FilePath
annexLocation state backend key =
(gitWorkTree $ repo state) ++ "/" ++
(annexLocationRelative state backend key)
- /path/to/repo/.git/annex/<backend>/<key>
-
- (That allows deriving the key and backend by looking at the symlink to it.)
-}
annexLocation :: GitRepo -> Backend -> Key -> FilePath
annexLocation r backend key =
(gitWorkTree r) ++ "/" ++ (annexLocationRelative r backend key)
{- Annexed file's location relative to the gitWorkTree -}
annexLocationRelative :: State -> Backend -> Key -> FilePath
annexLocationRelative state backend key =
gitDir (repo state) ++ "/annex/" ++ (name backend) ++
"/" ++ (keyFile key)
annexLocationRelative :: GitRepo -> Backend -> Key -> FilePath
annexLocationRelative r backend key =
gitDir r ++ "/annex/" ++ (name backend) ++ "/" ++ (keyFile key)
{- Converts a key into a filename fragment.
-

View file

@ -32,6 +32,5 @@ tryRun errnum oknum (a:as) = do
{- Exception pretty-printing. -}
showErr :: SomeException -> IO ()
showErr e = do
let err = show e
hPutStrLn stderr $ "git-annex: " ++ err
hPutStrLn stderr $ "git-annex: " ++ (show e)
return ()