addurl: Add --pathdepth option.
This commit is contained in:
parent
a86d937b5b
commit
39c3f56b33
3 changed files with 36 additions and 15 deletions
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue