avoid sending uploads right back to where the download came from

Just an optimisation.
This commit is contained in:
Joey Hess 2012-09-18 14:24:51 -04:00
parent 3a0cffcfed
commit 9f05d19108
2 changed files with 13 additions and 4 deletions

View file

@ -86,7 +86,9 @@ onDel st dstatus transferqueue file _ = case parseTransferFile file of
- spreading them out to other reachable remotes. -} - spreading them out to other reachable remotes. -}
case (minfo, transferDirection t) of case (minfo, transferDirection t) of
(Just info, Download) -> runThreadState st $ (Just info, Download) -> runThreadState st $
queueTransfers Later transferqueue dstatus queueTransfersMatching
(/= transferUUID t)
Later transferqueue dstatus
(transferKey t) (transferKey t)
(associatedFile info) (associatedFile info)
Upload Upload

View file

@ -11,6 +11,7 @@ module Assistant.TransferQueue (
newTransferQueue, newTransferQueue,
getTransferQueue, getTransferQueue,
queueTransfers, queueTransfers,
queueTransfersMatching,
queueDeferredDownloads, queueDeferredDownloads,
queueTransfer, queueTransfer,
queueTransferAt, queueTransferAt,
@ -57,12 +58,18 @@ stubInfo f r = stubTransferInfo
{- Adds transfers to queue for some of the known remotes. -} {- Adds transfers to queue for some of the known remotes. -}
queueTransfers :: Schedule -> TransferQueue -> DaemonStatusHandle -> Key -> AssociatedFile -> Direction -> Annex () queueTransfers :: Schedule -> TransferQueue -> DaemonStatusHandle -> Key -> AssociatedFile -> Direction -> Annex ()
queueTransfers schedule q dstatus k f direction = do queueTransfers = queueTransfersMatching (const True)
{- Adds transfers to queue for some of the known remotes, that match a
- predicate. -}
queueTransfersMatching :: (UUID -> Bool) -> Schedule -> TransferQueue -> DaemonStatusHandle -> Key -> AssociatedFile -> Direction -> Annex ()
queueTransfersMatching pred schedule q dstatus k f direction = do
rs <- sufficientremotes rs <- sufficientremotes
=<< knownRemotes <$> liftIO (getDaemonStatus dstatus) =<< knownRemotes <$> liftIO (getDaemonStatus dstatus)
if null rs let matchingrs = filter (pred . Remote.uuid) rs
if null matchingrs
then defer then defer
else forM_ rs $ \r -> liftIO $ else forM_ matchingrs $ \r -> liftIO $
enqueue schedule q dstatus (gentransfer r) (stubInfo f r) enqueue schedule q dstatus (gentransfer r) (stubInfo f r)
where where
sufficientremotes rs sufficientremotes rs