mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

--all for get, move, and copy

Browse source
This commit is contained in:
Joey Hess 2013-07-03 13:55:50 -04:00
parent def7cb706f
commit b337a8b4c7
5 changed files with 89 additions and 57 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
Command/Copy.hs
View file

@ -14,13 +14,16 @@ import qualified Remote
import Annex.Wanted
def :: [Command]
def = [withOptions Command.Move.options $ command "copy" paramPaths seek
def = [withOptions Command.Move.moveOptions $ command "copy" paramPaths seek
SectionCommon "copy content of files to/from another repository"]
seek :: [CommandSeek]
seek = [withField Command.Move.toOption Remote.byNameWithUUID $ \to ->
withField Command.Move.fromOption Remote.byNameWithUUID $ \from ->
withFilesInGit $ whenAnnexed $ start to from]
seek =
[ withField Command.Move.toOption Remote.byNameWithUUID $ \to ->
withField Command.Move.fromOption Remote.byNameWithUUID $ \from ->
withAll (Command.Move.startAll to from False) $
withFilesInGit $ whenAnnexed $ start to from
]
{- A copy is just a move that does not delete the source file.
- However, --auto mode avoids unnecessary copies, and avoids getting or
@ -33,4 +36,3 @@ start to from file (key, backend) = stopUnless shouldCopy $
check = case to of
Nothing -> wantGet False (Just file)
Just r -> wantSend False (Just file) (Remote.uuid r)

56
Command/Get.hs
View file

@ -1,6 +1,6 @@
{- git-annex command
-
- Copyright 2010 Joey Hess <joey@kitenet.net>
- Copyright 2010, 2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@ -14,37 +14,53 @@ import Annex.Content
import qualified Command.Move
import Logs.Transfer
import Annex.Wanted
import GitAnnex.Options
import Types.Key
import Types.Remote
def :: [Command]
def = [withOptions [Command.Move.fromOption] $ command "get" paramPaths seek
def = [withOptions getOptions $ command "get" paramPaths seek
SectionCommon "make content of annexed files available"]
getOptions :: [Option]
getOptions = [allOption, Command.Move.fromOption]
seek :: [CommandSeek]
seek = [withField Command.Move.fromOption Remote.byNameWithUUID $ \from ->
withFilesInGit $ whenAnnexed $ start from]
seek =
[ withField Command.Move.fromOption Remote.byNameWithUUID $ \from ->
withAll (startAll from) $
withFilesInGit $ whenAnnexed $ start from
]
start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
start from file (key, _) = stopUnless (not <$> inAnnex key) $
stopUnless (checkAuto (numCopiesCheck file key (<) <||> wantGet False (Just file))) $ do
case from of
Nothing -> go $ perform key file
Just src ->
-- get --from = copy --from
stopUnless (Command.Move.fromOk src key) $
go $ Command.Move.fromPerform src False key file
start from file (key, _) = start' expensivecheck from key (Just file)
where
go a = do
showStart "get" file
expensivecheck = checkAuto (numCopiesCheck file key (<) <||> wantGet False (Just file))
startAll :: Maybe Remote -> Key -> CommandStart
startAll from key = start' (return True) from key Nothing
start' :: Annex Bool -> Maybe Remote -> Key -> AssociatedFile -> CommandStart
start' expensivecheck from key afile = stopUnless (not <$> inAnnex key) $
stopUnless expensivecheck $
case from of
Nothing -> go $ perform key afile
Just src ->
stopUnless (Command.Move.fromOk src key) $
go $ Command.Move.fromPerform src False key afile
where
go a = do
showStart "get" (fromMaybe (key2file key) afile)
next a
perform :: Key -> FilePath -> CommandPerform
perform key file = stopUnless (getViaTmp key $ getKeyFile key file) $
perform :: Key -> AssociatedFile -> CommandPerform
perform key afile = stopUnless (getViaTmp key $ getKeyFile key afile) $
next $ return True -- no cleanup needed
{- Try to find a copy of the file in one of the remotes,
- and copy it to here. -}
getKeyFile :: Key -> FilePath -> FilePath -> Annex Bool
getKeyFile key file dest = dispatch =<< Remote.keyPossibilities key
getKeyFile :: Key -> AssociatedFile -> FilePath -> Annex Bool
getKeyFile key afile dest = dispatch =<< Remote.keyPossibilities key
where
dispatch [] = do
showNote "not available"
@ -69,7 +85,7 @@ getKeyFile key file dest = dispatch =<< Remote.keyPossibilities key
either (const False) id <$> Remote.hasKey r key
| otherwise = return True
docopy r continue = do
ok <- download (Remote.uuid r) key (Just file) noRetry $ \p -> do
ok <- download (Remote.uuid r) key afile noRetry $ \p -> do
showAction $ "from " ++ Remote.name r
Remote.retrieveKeyFile r key (Just file) dest p
Remote.retrieveKeyFile r key afile dest p
if ok then return ok else continue

72
Command/Move.hs
View file

@ -1,6 +1,6 @@
{- git-annex command
-
- Copyright 2010-2011 Joey Hess <joey@kitenet.net>
- Copyright 2010-2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@ -17,9 +17,12 @@ import Annex.UUID
import qualified Option
import Logs.Presence
import Logs.Transfer
import GitAnnex.Options
import Types.Key
import Types.Remote
def :: [Command]
def = [withOptions options $ command "move" paramPaths seek
def = [withOptions moveOptions $ command "move" paramPaths seek
SectionCommon "move content of files to/from another repository"]
fromOption :: Option
@ -28,29 +31,40 @@ fromOption = Option.field ['f'] "from" paramRemote "source remote"
toOption :: Option
toOption = Option.field ['t'] "to" paramRemote "destination remote"
options :: [Option]
options = [fromOption, toOption]
moveOptions :: [Option]
moveOptions = [allOption, fromOption, toOption]
seek :: [CommandSeek]
seek = [withField toOption Remote.byNameWithUUID $ \to ->
withField fromOption Remote.byNameWithUUID $ \from ->
withFilesInGit $ whenAnnexed $ start to from True]
seek =
[ withField toOption Remote.byNameWithUUID $ \to ->
withField fromOption Remote.byNameWithUUID $ \from ->
withAll (startAll to from True) $
withFilesInGit $ whenAnnexed $ start to from True
]
start :: Maybe Remote -> Maybe Remote -> Bool -> FilePath -> (Key, Backend) -> CommandStart
start to from move file (key, _) = do
start to from move file (key, _) = start' to from move (Just file) key
startAll :: Maybe Remote -> Maybe Remote -> Bool -> Key -> CommandStart
startAll to from move key = start' to from move Nothing key
start' :: Maybe Remote -> Maybe Remote -> Bool -> AssociatedFile -> Key -> CommandStart
start' to from move afile key = do
noAuto
case (from, to) of
(Nothing, Nothing) -> error "specify either --from or --to"
(Nothing, Just dest) -> toStart dest move file key
(Just src, Nothing) -> fromStart src move file key
(Nothing, Just dest) -> toStart dest move afile key
(Just src, Nothing) -> fromStart src move afile key
(_ , _) -> error "only one of --from or --to can be specified"
where
noAuto = when move $ whenM (Annex.getState Annex.auto) $ error
"--auto is not supported for move"
showMoveAction :: Bool -> FilePath -> Annex ()
showMoveAction True file = showStart "move" file
showMoveAction False file = showStart "copy" file
showMoveAction :: Bool -> Key -> AssociatedFile -> Annex ()
showMoveAction True _ (Just file) = showStart "move" file
showMoveAction False _ (Just file) = showStart "copy" file
showMoveAction True key Nothing = showStart "move" (key2file key)
showMoveAction False key Nothing = showStart "copy" (key2file key)
{- Moves (or copies) the content of an annexed file to a remote.
-
@ -61,17 +75,17 @@ showMoveAction False file = showStart "copy" file
- A file's content can be moved even if there are insufficient copies to
- allow it to be dropped.
-}
toStart :: Remote -> Bool -> FilePath -> Key -> CommandStart
toStart dest move file key = do
toStart :: Remote -> Bool -> AssociatedFile -> Key -> CommandStart
toStart dest move afile key = do
u <- getUUID
ishere <- inAnnex key
if not ishere || u == Remote.uuid dest
then stop -- not here, so nothing to do
else do
showMoveAction move file
next $ toPerform dest move key file
toPerform :: Remote -> Bool -> Key -> FilePath -> CommandPerform
toPerform dest move key file = moveLock move key $ do
showMoveAction move key afile
next $ toPerform dest move key afile
toPerform :: Remote -> Bool -> Key -> AssociatedFile -> CommandPerform
toPerform dest move key afile = moveLock move key $ do
-- Checking the remote is expensive, so not done in the start step.
-- In fast mode, location tracking is assumed to be correct,
-- and an explicit check is not done, when copying. When moving,
@ -87,8 +101,8 @@ toPerform dest move key file = moveLock move key $ do
stop
Right False -> do
showAction $ "to " ++ Remote.name dest
ok <- upload (Remote.uuid dest) key (Just file) noRetry $
Remote.storeKey dest key (Just file)
ok <- upload (Remote.uuid dest) key afile noRetry $
Remote.storeKey dest key afile
if ok
then do
Remote.logStatus dest key InfoPresent
@ -117,14 +131,14 @@ toPerform dest move key file = moveLock move key $ do
- If the current repository already has the content, it is still removed
- from the remote.
-}
fromStart :: Remote -> Bool -> FilePath -> Key -> CommandStart
fromStart src move file key
fromStart :: Remote -> Bool -> AssociatedFile -> Key -> CommandStart
fromStart src move afile key
| move = go
| otherwise = stopUnless (not <$> inAnnex key) go
where
go = stopUnless (fromOk src key) $ do
showMoveAction move file
next $ fromPerform src move key file
showMoveAction move key afile
next $ fromPerform src move key afile
fromOk :: Remote -> Key -> Annex Bool
fromOk src key
@ -137,16 +151,16 @@ fromOk src key
remotes <- Remote.keyPossibilities key
return $ u /= Remote.uuid src && elem src remotes
fromPerform :: Remote -> Bool -> Key -> FilePath -> CommandPerform
fromPerform src move key file = moveLock move key $
fromPerform :: Remote -> Bool -> Key -> AssociatedFile -> CommandPerform
fromPerform src move key afile = moveLock move key $
ifM (inAnnex key)
( handle move True
, handle move =<< go
)
where
go = download (Remote.uuid src) key (Just file) noRetry $ \p -> do
go = download (Remote.uuid src) key afile noRetry $ \p -> do
showAction $ "from " ++ Remote.name src
getViaTmp key $ \t -> Remote.retrieveKeyFile src key (Just file) t p
getViaTmp key $ \t -> Remote.retrieveKeyFile src key afile t p
handle _ False = stop -- failed
handle False True = next $ return True -- copy complete
handle True True = do -- finish moving

2
Command/TransferKey.hs
View file

@ -24,7 +24,7 @@ def = [withOptions options $
"transfers a key from or to a remote"]
options :: [Option]
options = fileOption : Command.Move.options
options = [fileOption, Command.Move.fromOption, Command.Move.toOption]
fileOption :: Option
fileOption = Option.field [] "file" paramFile "the associated file"

4
Seek.hs
View file

@ -122,8 +122,8 @@ withNothing :: CommandStart -> CommandSeek
withNothing a [] = return [a]
withNothing _ _ = error "This command takes no parameters."
{- If --all is specified, runs an action on all logged keys.
- Otherwise, fall back to a regular CommandSeek action on
{- If --all is specified, or in a bare repo, runs an action on all
- known keys. Otherwise, fall back to a regular CommandSeek action on
- whatever params were passed. -}
withAll :: (Key -> CommandStart) -> CommandSeek -> CommandSeek
withAll allop fallbackop params = go =<< (Annex.getFlag "all" <||> isbare)