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

avoid queuing transfers that are currently running

Browse source
This commit is contained in:
Joey Hess 2013-04-02 16:17:06 -04:00
parent 1f4fe92f61
commit 69a80a9a4d
2 changed files with 17 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

20
Assistant/TransferQueue.hs
View file

@ -136,14 +136,18 @@ enqueue reason schedule t info
notifyTransfer
add modlist = do
q <- getAssistant transferQueue
liftIO $ atomically $ do
l <- readTVar (queuelist q)
if (t `notElem` map fst l)
then do
void $ modifyTVar' (queuesize q) succ
void $ modifyTVar' (queuelist q) modlist
return True
else return False
dstatus <- getAssistant daemonStatusHandle
liftIO $ atomically $ ifM (checkRunningTransferSTM dstatus t)
( return False
, do
l <- readTVar (queuelist q)
if (t `notElem` map fst l)
then do
void $ modifyTVar' (queuesize q) succ
void $ modifyTVar' (queuelist q) modlist
return True
else return False
)
{- Adds a transfer to the queue. -}
queueTransfer :: Reason -> Schedule -> AssociatedFile -> Transfer -> Remote -> Assistant ()