From 0eae5b806c76b0fa3e21fbae6e5f2d9a39a04cce Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 2 Nov 2010 19:04:24 -0400
Subject: broke subcommands out into separate modules

---
 Command/Move.hs | 131 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 131 insertions(+)
 create mode 100644 Command/Move.hs

(limited to 'Command/Move.hs')

diff --git a/Command/Move.hs b/Command/Move.hs
new file mode 100644
index 000000000..cee941622
--- /dev/null
+++ b/Command/Move.hs
@@ -0,0 +1,131 @@
+{- git-annex command
+ -
+ - Copyright 2010 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.Move where
+
+import Control.Monad.State (liftIO)
+import Monad (when)
+
+import Command
+import Command.Drop
+import qualified Annex
+import Locations
+import LocationLog
+import Types
+import Core
+import qualified GitRepo as Git
+import qualified Remotes
+import UUID
+
+{- Move 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
+	fromName <- Annex.flagGet "fromrepository"
+	toName <- Annex.flagGet "torepository"
+	case (fromName, toName) of
+		("", "") -> error "specify either --from or --to"
+		("",  _) -> moveToStart file
+		(_ , "") -> moveFromStart 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.
+ -
+ - 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
+	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
+	-- checking the remote is expensive, so not done in the start step
+	remote <- Remotes.commandLineRemote
+	isthere <- Remotes.inAnnex remote key
+	case isthere of
+		Left err -> do
+			showNote $ show err
+			return Nothing
+		Right False -> do
+			Core.showNote $ "moving 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
+				else return Nothing -- failed
+		Right True -> return $ Just $ Command.Drop.cleanup key
+moveToCleanup :: Git.Repo -> Key -> FilePath -> SubCmdCleanup
+moveToCleanup remote key tmpfile = do
+	-- Tell remote to use the transferred content.
+	ok <- Remotes.runCmd remote "git-annex" ["setkey", "--quiet",
+		"--backend=" ++ (backendName key),
+		"--key=" ++ keyName key,
+		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
+		else return False
+
+{- Moves 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.
+ -}
+moveFromStart :: SubCmdStartString
+moveFromStart 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
+	remote <- Remotes.commandLineRemote
+	ishere <- inAnnex key
+	if (ishere)
+		then return $ Just $ moveFromCleanup remote key
+		else do
+			Core.showNote $ "moving from " ++ (Git.repoDescribe remote) ++ "..."
+			ok <- getViaTmp key (Remotes.copyFromRemote remote key)
+			if (ok)
+				then return $ Just $ moveFromCleanup remote key
+				else return Nothing -- fail
+moveFromCleanup :: Git.Repo -> Key -> SubCmdCleanup
+moveFromCleanup 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
+	return ok
-- 
cgit v1.2.3