make copy --to check preferred content of the remote

This commit is contained in:
Joey Hess 2012-10-08 16:06:56 -04:00
parent 17543f6e80
commit 1eedf495c3
5 changed files with 73 additions and 39 deletions

View file

@ -11,6 +11,7 @@ import Common.Annex
import Command
import qualified Command.Move
import qualified Remote
import Annex.Wanted
def :: [Command]
def = [withOptions Command.Move.options $ command "copy" paramPaths seek
@ -21,8 +22,14 @@ seek = [withField Command.Move.toOption Remote.byName $ \to ->
withField Command.Move.fromOption Remote.byName $ \from ->
withFilesInGit $ whenAnnexed $ start to from]
-- A copy is just a move that does not delete the source file.
-- However, --auto mode avoids unnecessary copies.
{- A copy is just a move that does not delete the source file.
- However, --auto mode avoids unnecessary copies, and avoids getting or
- sending non-preferred content. -}
start :: Maybe Remote -> Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
start to from file (key, backend) = autoCopies file key (<) $
Command.Move.start to from False file (key, backend)
stopUnless shouldCopy $
Command.Move.start to from False file (key, backend)
where
shouldCopy = case to of
Nothing -> checkAuto $ shouldGet file key
Just r -> checkAuto $ shouldSend r file

View file

@ -17,10 +17,7 @@ import Logs.Trust
import Annex.Content
import Config
import qualified Option
import Git.FilePath
import Logs.PreferredContent
import qualified Data.Set as S
import Annex.Wanted
def :: [Command]
def = [withOptions [fromOption] $ command "drop" paramPaths seek
@ -34,27 +31,15 @@ seek = [withField fromOption Remote.byName $ \from ->
withFilesInGit $ whenAnnexed $ start from]
start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
start from file (key, _) = shouldDrop $ \numcopies ->
case from of
Nothing -> startLocal file numcopies key
Just remote -> do
u <- getUUID
if Remote.uuid remote == u
then startLocal file numcopies key
else startRemote file numcopies key remote
where
{- In --auto mode, drop if there are enough copies,
- and the repository being dropped from doesn't prefer
- to keep the content. -}
shouldDrop a = autoCopiesWith file key (>) $ \numcopies ->
ifM (Annex.getState Annex.auto)
( do
fp <- inRepo $ toTopFilePath file
u <- maybe getUUID (return . Remote.uuid) from
ifM (isPreferredContent (Just u) (S.singleton u) fp)
( a numcopies, stop )
, a numcopies
)
start from file (key, _) = autoCopiesWith file key (>) $ \numcopies ->
stopUnless (checkAuto $ shouldDrop from file) $
case from of
Nothing -> startLocal file numcopies key
Just remote -> do
u <- getUUID
if Remote.uuid remote == u
then startLocal file numcopies key
else startRemote file numcopies key remote
startLocal :: FilePath -> Maybe Int -> Key -> CommandStart
startLocal file numcopies key = stopUnless (inAnnex key) $ do

View file

@ -13,6 +13,7 @@ import qualified Remote
import Annex.Content
import qualified Command.Move
import Logs.Transfer
import Annex.Wanted
def :: [Command]
def = [withOptions [Command.Move.fromOption] $ command "get" paramPaths seek
@ -23,7 +24,7 @@ seek = [withField Command.Move.fromOption Remote.byName $ \from ->
withFilesInGit $ whenAnnexed $ start from]
start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
start from file (key, _) = stopUnless (not <$> inAnnex key) $
start from file (key, _) = stopUnless (checkAuto $ shouldGet file key) $
autoCopies file key (<) $
case from of
Nothing -> go $ perform key file