assistant: Now honors preferred content settings when deciding what to transfer.

Both when queueing downloads, and uploads, consults the preferred content
settings.

I didn't make it check yet when requeing failed transfers or queuing
deferred downloads; dealing with the preferred content settings (or indeed,
other settings) changing while the assistant is running still needs work.
This commit is contained in:
Joey Hess 2012-10-09 12:18:41 -04:00
parent 11f8ea2f34
commit 5ac15149cc
7 changed files with 36 additions and 28 deletions

View file

@ -210,7 +210,7 @@ handleAdds delayadd st changechan transferqueue dstatus cs = returnWhen (null in
sha <- inRepo $
Git.HashObject.hashObject BlobObject link
stageSymlink file sha
queueTransfers Next transferqueue dstatus key (Just file) Upload
queueTransfers Next transferqueue dstatus st key (Just file) Upload
showEndOk
return $ Just change

View file

@ -22,6 +22,7 @@ import Utility.ThreadScheduler
import qualified Git.LsFiles as LsFiles
import Command
import Annex.Content
import Annex.Wanted
import qualified Data.Set as S
@ -105,18 +106,20 @@ expensiveScan st dstatus transferqueue rs = unless onlyweb $ do
in if null rs' then rs else rs'
go [] = noop
go (f:fs) = do
mapM_ (enqueue f) =<< catMaybes <$> runThreadState st
(ifAnnexed f findtransfers $ return [])
mapM_ (enqueue f) =<< runThreadState st
(ifAnnexed f (findtransfers f) $ return [])
go fs
enqueue f (r, t) = do
debug thisThread ["queuing", show t]
queueTransferWhenSmall transferqueue dstatus (Just f) t r
findtransfers (key, _) = do
findtransfers f (key, _) = do
locs <- loggedLocations key
let use a = return $ map (a key locs) rs
let use a = return $ catMaybes $ map (a key locs) rs
ifM (inAnnex key)
( use $ check Upload False
, use $ check Download True
( filterM (wantSend (Just f) . Remote.uuid . fst)
=<< use (check Upload False)
, ifM (wantGet $ Just f)
( use (check Download True) , return [] )
)
check direction want key locs r
| direction == Upload && Remote.readonly r = Nothing