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

addurl: Add --pathdepth option.

Browse source
This commit is contained in:
Joey Hess 2012-02-16 12:25:19 -04:00
parent a86d937b5b
commit 39c3f56b33
3 changed files with 36 additions and 15 deletions
Download patch file Download diff file Expand all files Collapse all files

37
Command/AddUrl.hs
View file

@ -22,34 +22,40 @@ import qualified Option
import Types.Key
def :: [Command]
def = [withOptions [fileOption] $
def = [withOptions [fileOption, pathdepthOption] $
command "addurl" (paramRepeating paramUrl) seek "add urls to annex"]
fileOption :: Option
fileOption = Option.field [] "file" paramFile "specify what file the url is added to"
pathdepthOption :: Option
pathdepthOption = Option.field [] "pathdepth" paramFile "number of path components to use in filename"
seek :: [CommandSeek]
seek = [withField fileOption return $ \f ->
withStrings $ start f]
withField pathdepthOption (return . maybe Nothing readish) $ \d ->
withStrings $ start f d]
start :: Maybe FilePath -> String -> CommandStart
start optfile s = notBareRepo $ go $ fromMaybe bad $ parseURI s
start :: Maybe FilePath -> Maybe Int -> String -> CommandStart
start optfile pathdepth s = notBareRepo $ go $ fromMaybe bad $ parseURI s
where
bad = fromMaybe (error $ "bad url " ++ s) $
parseURI $ escapeURIString isUnescapedInURI s
go url = do
let file = fromMaybe (url2file url) optfile
let file = fromMaybe (url2file url pathdepth) optfile
showStart "addurl" file
next $ perform s file
next $ perform s file pathdepth
perform :: String -> FilePath -> CommandPerform
perform url file = ifAnnexed file addurl geturl
perform :: String -> FilePath -> Maybe Int -> CommandPerform
perform url file pathdepth = ifAnnexed file addurl geturl
where
geturl = do
liftIO $ createDirectoryIfMissing True (parentDir file)
fast <- Annex.getState Annex.fast
if fast then nodownload url file else download url file
addurl (key, _backend) = do
when (pathdepth /= Nothing) $
error $ file ++ " already exists"
unlessM (liftIO $ Url.check url (keySize key)) $
error $ "failed to verify url: " ++ url
setUrlPresent key url
@ -80,8 +86,17 @@ nodownload url file = do
setUrlPresent key url
next $ Command.Add.cleanup file key False
url2file :: URI -> FilePath
url2file url = take 255 $ escape $ uriRegName auth ++ uriPath url ++ uriQuery url
url2file :: URI -> Maybe Int -> FilePath
url2file url pathdepth = case pathdepth of
Nothing -> filesize $ escape fullurl
Just depth
| depth > 0 -> filesize $ join "/" $
fromend depth $ map escape $
filter (not . null) $ split "/" fullurl
| otherwise -> error "bad --pathdepth value"
where
escape = replace "/" "_" . replace "?" "_"
fullurl = uriRegName auth ++ uriPath url ++ uriQuery url
auth = fromMaybe (error $ "bad url " ++ show url) $ uriAuthority url
filesize = take 255
escape = replace "/" "_" . replace "?" "_"
fromend n = reverse . take n . reverse