diff options
author | Joey Hess <joey@kitenet.net> | 2011-08-06 14:57:22 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2011-08-06 14:57:22 -0400 |
commit | dede05171bc9431778da72e5e1235c69db9fa38e (patch) | |
tree | a9bc1f6fce6e16af835b9d3ff7d647ad0d82583e /Command | |
parent | dd8e649f49212c46df23f329299c64e13a3c90e1 (diff) |
addurl: --fast can be used to avoid immediately downloading the url.
The tricky part about this is that to generate a key, the file must be
present already. Worked around by adding (back) an URL key type, which
is used for addurl --fast.
Diffstat (limited to 'Command')
-rw-r--r-- | Command/Add.hs | 21 | ||||
-rw-r--r-- | Command/AddUrl.hs | 27 | ||||
-rw-r--r-- | Command/Migrate.hs | 2 |
3 files changed, 32 insertions, 18 deletions
diff --git a/Command/Add.hs b/Command/Add.hs index 58c0143dd..d8947fb07 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -8,6 +8,7 @@ module Command.Add where import Control.Monad.State (liftIO) +import Control.Monad (when) import System.Posix.Files import System.Directory import Control.Exception.Control (handle) @@ -52,7 +53,7 @@ perform (file, backend) = do Nothing -> stop Just (key, _) -> do handle (undo file key) $ moveAnnex key file - next $ cleanup file key + next $ cleanup file key True {- On error, put the file back so it doesn't seem to have vanished. - This can be called before or after the symlink is in place. -} @@ -72,18 +73,20 @@ undo file key e = do g <- Annex.gitRepo liftIO $ renameFile (gitAnnexLocation g key) file -cleanup :: FilePath -> Key -> CommandCleanup -cleanup file key = do +cleanup :: FilePath -> Key -> Bool -> CommandCleanup +cleanup file key hascontent = do handle (undo file key) $ do link <- calcGitLink file key liftIO $ createSymbolicLink link file - logStatus key InfoPresent + + when hascontent $ do + logStatus key InfoPresent - -- touch the symlink to have the same mtime as the - -- file it points to - s <- liftIO $ getFileStatus file - let mtime = modificationTime s - liftIO $ touch file (TimeSpec mtime) False + -- touch the symlink to have the same mtime as the + -- file it points to + s <- liftIO $ getFileStatus file + let mtime = modificationTime s + liftIO $ touch file (TimeSpec mtime) False force <- Annex.getState Annex.force if force diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index 1b12362e9..e87de384b 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -17,10 +17,10 @@ import qualified Backend import qualified Remote.Web import qualified Command.Add import qualified Annex +import qualified Backend.URL import Messages import Content import PresenceLog -import Types.Key import Locations import Utility @@ -42,9 +42,14 @@ start s = do perform :: String -> FilePath -> CommandPerform perform url file = do + fast <- Annex.getState Annex.fast + if fast then nodownload url file else download url file + +download :: String -> FilePath -> CommandPerform +download url file = do g <- Annex.gitRepo showAction $ "downloading " ++ url ++ " " - let dummykey = stubKey { keyName = url, keyBackendName = "URL" } + let dummykey = Backend.URL.fromUrl url let tmp = gitAnnexTmpLocation g dummykey liftIO $ createDirectoryIfMissing True (parentDir tmp) ok <- Remote.Web.download [url] tmp @@ -57,9 +62,16 @@ perform url file = do Just (key, _) -> do moveAnnex key tmp Remote.Web.setUrl key url InfoPresent - next $ Command.Add.cleanup file key + next $ Command.Add.cleanup file key True else stop +nodownload :: String -> FilePath -> CommandPerform +nodownload url file = do + let key = Backend.URL.fromUrl url + Remote.Web.setUrl key url InfoPresent + + next $ Command.Add.cleanup file key False + url2file :: URI -> IO FilePath url2file url = do let parts = filter safe $ split "/" $ uriPath url @@ -75,8 +87,7 @@ url2file url = do e <- doesFileExist file when e $ error "already have this url" return file - safe s - | null s = False - | s == "." = False - | s == ".." = False - | otherwise = True + safe "" = False + safe "." = False + safe ".." = False + safe _ = True diff --git a/Command/Migrate.hs b/Command/Migrate.hs index 495bf9fb6..5ae835440 100644 --- a/Command/Migrate.hs +++ b/Command/Migrate.hs @@ -72,7 +72,7 @@ perform file oldkey newbackend = do then do -- Update symlink to use the new key. liftIO $ removeFile file - next $ Command.Add.cleanup file newkey + next $ Command.Add.cleanup file newkey True else stop where cleantmp t = whenM (doesFileExist t) $ removeFile t |