summaryrefslogtreecommitdiff
path: root/Command
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2010-11-27 17:02:53 -0400
committerGravatar Joey Hess <joey@kitenet.net>2010-11-27 17:02:53 -0400
commite97d13e29b18c4522395996299651334cb221519 (patch)
tree5270972b2c6941cd3cc66066eefbd33bce9e29e3 /Command
parenteeae91024285c85a7e77b1b44e501a63bced7154 (diff)
Add copy subcommand.
Diffstat (limited to 'Command')
-rw-r--r--Command/Move.hs107
1 files changed, 56 insertions, 51 deletions
diff --git a/Command/Move.hs b/Command/Move.hs
index c18054c90..cb6525919 100644
--- a/Command/Move.hs
+++ b/Command/Move.hs
@@ -7,7 +7,7 @@
module Command.Move where
-import Control.Monad.State (liftIO, when)
+import Control.Monad.State (liftIO)
import Command
import qualified Command.Drop
@@ -22,43 +22,55 @@ import UUID
import Messages
seek :: [SubCmdSeek]
-seek = [withFilesInGit start]
+seek = [withFilesInGit $ start True]
-{- Move a file either --to or --from a repository.
+{- Move (or copy) a file either --to or --from a repository.
-
- This only operates on the cached file content; it does not involve
- moving data in the key-value backend. -}
-start :: SubCmdStartString
-start file = do
+start :: Bool -> SubCmdStartString
+start move file = do
fromName <- Annex.flagGet "fromrepository"
toName <- Annex.flagGet "torepository"
case (fromName, toName) of
("", "") -> error "specify either --from or --to"
- ("", _) -> moveToStart file
- (_ , "") -> moveFromStart file
+ ("", _) -> toStart move file
+ (_ , "") -> fromStart move file
(_ , _) -> error "only one of --from or --to can be specified"
-{- Moves the content of an annexed file to another repository,
- - removing it from the current repository, and updates locationlog
- - information on both.
+showAction :: Bool -> FilePath -> Annex ()
+showAction True file = showStart "move" file
+showAction False file = showStart "copy" file
+
+remoteHasKey :: Git.Repo -> Key -> Bool -> Annex ()
+remoteHasKey remote key present = do
+ g <- Annex.gitRepo
+ remoteuuid <- getUUID remote
+ logfile <- liftIO $ logChange g key remoteuuid status
+ Annex.queue "add" ["--"] logfile
+ where
+ status = if present then ValuePresent else ValueMissing
+
+{- Moves (or copies) the content of an annexed file to another repository,
+ - and updates locationlog information on both.
-
- - If the destination already has the content, it is still removed
- - from the current repository.
+ - When moving, if the destination already has the content, it is
+ - still removed from the current repository.
-
- Note that unlike drop, this does not honor annex.numcopies.
- A file's content can be moved even if there are insufficient copies to
- allow it to be dropped.
-}
-moveToStart :: SubCmdStartString
-moveToStart file = isAnnexed file $ \(key, _) -> do
+toStart :: Bool -> SubCmdStartString
+toStart move file = isAnnexed file $ \(key, _) -> do
ishere <- inAnnex key
if not ishere
then return Nothing -- not here, so nothing to do
else do
- showStart "move" file
- return $ Just $ moveToPerform key
-moveToPerform :: Key -> SubCmdPerform
-moveToPerform key = do
+ showAction move file
+ return $ Just $ toPerform move key
+toPerform :: Bool -> Key -> SubCmdPerform
+toPerform move key = do
-- checking the remote is expensive, so not done in the start step
remote <- Remotes.commandLineRemote
isthere <- Remotes.inAnnex remote key
@@ -67,15 +79,15 @@ moveToPerform key = do
showNote $ show err
return Nothing
Right False -> do
- showNote $ "moving to " ++ Git.repoDescribe remote ++ "..."
+ showNote $ "to " ++ Git.repoDescribe remote ++ "..."
let tmpfile = annexTmpLocation remote ++ keyFile key
ok <- Remotes.copyToRemote remote key tmpfile
if ok
- then return $ Just $ moveToCleanup remote key tmpfile
+ then return $ Just $ toCleanup move remote key tmpfile
else return Nothing -- failed
Right True -> return $ Just $ Command.Drop.cleanup key
-moveToCleanup :: Git.Repo -> Key -> FilePath -> SubCmdCleanup
-moveToCleanup remote key tmpfile = do
+toCleanup :: Bool -> Git.Repo -> Key -> FilePath -> SubCmdCleanup
+toCleanup move remote key tmpfile = do
-- Tell remote to use the transferred content.
ok <- Remotes.runCmd remote "git-annex" ["setkey", "--quiet",
"--backend=" ++ backendName key,
@@ -83,52 +95,45 @@ moveToCleanup remote key tmpfile = do
tmpfile]
if ok
then do
- -- Record that the key is present on the remote.
- g <- Annex.gitRepo
- remoteuuid <- getUUID remote
- logfile <- liftIO $ logChange g key remoteuuid ValuePresent
- Annex.queue "add" ["--"] logfile
- -- Cleanup on the local side is the same as done for the
- -- drop subcommand.
- Command.Drop.cleanup key
+ remoteHasKey remote key True
+ if move
+ then Command.Drop.cleanup key
+ else return True
else return False
-{- Moves the content of an annexed file from another repository to the current
- - repository and updates locationlog information on both.
+{- Moves (or copies) the content of an annexed file from another repository
+ - to the current repository and updates locationlog information on both.
-
- If the current repository already has the content, it is still removed
- - from the other repository.
+ - from the other repository when moving.
-}
-moveFromStart :: SubCmdStartString
-moveFromStart file = isAnnexed file $ \(key, _) -> do
+fromStart :: Bool -> SubCmdStartString
+fromStart move file = isAnnexed file $ \(key, _) -> do
remote <- Remotes.commandLineRemote
l <- Remotes.keyPossibilities key
if null $ filter (\r -> Remotes.same r remote) l
then return Nothing
else do
- showStart "move" file
- return $ Just $ moveFromPerform key
-moveFromPerform :: Key -> SubCmdPerform
-moveFromPerform key = do
+ showAction move file
+ return $ Just $ fromPerform move key
+fromPerform :: Bool -> Key -> SubCmdPerform
+fromPerform move key = do
remote <- Remotes.commandLineRemote
ishere <- inAnnex key
if ishere
- then return $ Just $ moveFromCleanup remote key
+ then return $ Just $ fromCleanup move remote key
else do
- showNote $ "moving from " ++ Git.repoDescribe remote ++ "..."
+ showNote $ "from " ++ Git.repoDescribe remote ++ "..."
ok <- getViaTmp key $ Remotes.copyFromRemote remote key
if ok
- then return $ Just $ moveFromCleanup remote key
+ then return $ Just $ fromCleanup move remote key
else return Nothing -- fail
-moveFromCleanup :: Git.Repo -> Key -> SubCmdCleanup
-moveFromCleanup remote key = do
- ok <- Remotes.runCmd remote "git-annex" ["dropkey", "--quiet", "--force",
+fromCleanup :: Bool -> Git.Repo -> Key -> SubCmdCleanup
+fromCleanup True remote key = do
+ ok <- Remotes.runCmd remote "git-annex"
+ ["dropkey", "--quiet", "--force",
"--backend=" ++ backendName key,
keyName key]
- when ok $ do
- -- Record locally that the key is not on the remote.
- remoteuuid <- getUUID remote
- g <- Annex.gitRepo
- logfile <- liftIO $ logChange g key remoteuuid ValueMissing
- Annex.queue "add" ["--"] logfile
+ remoteHasKey remote key False
return ok
+fromCleanup False _ _ = return True