From e97d13e29b18c4522395996299651334cb221519 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 27 Nov 2010 17:02:53 -0400 Subject: Add copy subcommand. --- Command/Move.hs | 107 +++++++++++++++++++++++++++++--------------------------- 1 file changed, 56 insertions(+), 51 deletions(-) (limited to 'Command/Move.hs') 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 -- cgit v1.2.3