summaryrefslogtreecommitdiff
path: root/Command/AddUrl.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2015-07-21 12:50:05 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2015-07-21 12:50:05 -0400
commitd8c78237328a15c2feba05e7ed2a0bf1ff266ad6 (patch)
tree2f485038d77e20f8320393b9ec206365b30ca648 /Command/AddUrl.hs
parent65449fc0960c9030dd7d1a3ad39e2f64bdc749a8 (diff)
addurl now accepts --prefix and --suffix options to adjust the filenames used
Diffstat (limited to 'Command/AddUrl.hs')
-rw-r--r--Command/AddUrl.hs57
1 files changed, 37 insertions, 20 deletions
diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs
index 4ae80d9d4..adc0d3a1e 100644
--- a/Command/AddUrl.hs
+++ b/Command/AddUrl.hs
@@ -46,6 +46,8 @@ data AddUrlOptions = AddUrlOptions
{ addUrls :: CmdParams
, fileOption :: Maybe FilePath
, pathdepthOption :: Maybe Int
+ , prefixOption :: Maybe String
+ , suffixOption :: Maybe String
, relaxedOption :: Bool
, rawOption :: Bool
}
@@ -59,7 +61,15 @@ optParser desc = AddUrlOptions
))
<*> optional (option auto
( long "pathdepth" <> metavar paramNumber
- <> help "path components to use in filename"
+ <> help "number of url path components to use in filename"
+ ))
+ <*> optional (strOption
+ ( long "prefix" <> metavar paramValue
+ <> help "add a prefix to the filename"
+ ))
+ <*> optional (strOption
+ ( long "suffix" <> metavar paramValue
+ <> help "add a suffix to the filename"
))
<*> parseRelaxedOption
<*> parseRawOption
@@ -80,13 +90,13 @@ seek :: AddUrlOptions -> CommandSeek
seek o = forM_ (addUrls o) $ \u -> do
r <- Remote.claimingUrl u
if Remote.uuid r == webUUID || rawOption o
- then void $ commandAction $ startWeb (relaxedOption o) (fileOption o) (pathdepthOption o) u
- else checkUrl r u (fileOption o) (relaxedOption o) (pathdepthOption o)
+ then void $ commandAction $ startWeb o u
+ else checkUrl r o u
-checkUrl :: Remote -> URLString -> Maybe FilePath -> Bool -> Maybe Int -> Annex ()
-checkUrl r u optfile relaxed pathdepth = do
+checkUrl :: Remote -> AddUrlOptions -> URLString -> Annex ()
+checkUrl r o u = do
pathmax <- liftIO $ fileNameLengthLimit "."
- let deffile = fromMaybe (urlString2file u pathdepth pathmax) optfile
+ let deffile = fromMaybe (urlString2file u (pathdepthOption o) pathmax) (fileOption o)
go deffile =<< maybe
(error $ "unable to checkUrl of " ++ Remote.name r)
(tryNonAsync . flip id u)
@@ -98,14 +108,15 @@ checkUrl r u optfile relaxed pathdepth = do
warning (show e)
next $ next $ return False
go deffile (Right (UrlContents sz mf)) = do
- let f = fromMaybe (maybe deffile fromSafeFilePath mf) optfile
+ let f = adjustFile o (fromMaybe (maybe deffile fromSafeFilePath mf) (fileOption o))
void $ commandAction $
- startRemote r relaxed f u sz
+ startRemote r (relaxedOption o) f u sz
go deffile (Right (UrlMulti l))
- | isNothing optfile =
- forM_ l $ \(u', sz, f) ->
+ | isNothing (fileOption o) =
+ forM_ l $ \(u', sz, f) -> do
+ let f' = adjustFile o (deffile </> fromSafeFilePath f)
void $ commandAction $
- startRemote r relaxed (deffile </> fromSafeFilePath f) u' sz
+ startRemote r (relaxedOption o) f' u' sz
| otherwise = error $ unwords
[ "That url contains multiple files according to the"
, Remote.name r
@@ -151,8 +162,8 @@ downloadRemoteFile r relaxed uri file sz = do
where
loguri = setDownloader uri OtherDownloader
-startWeb :: Bool -> Maybe FilePath -> Maybe Int -> String -> CommandStart
-startWeb relaxed optfile pathdepth s = go $ fromMaybe bad $ parseURI urlstring
+startWeb :: AddUrlOptions -> String -> CommandStart
+startWeb o s = go $ fromMaybe bad $ parseURI urlstring
where
(urlstring, downloader) = getDownloader s
bad = fromMaybe (error $ "bad url " ++ urlstring) $
@@ -170,22 +181,22 @@ startWeb relaxed optfile pathdepth s = go $ fromMaybe bad $ parseURI urlstring
#endif
regulardownload url = do
pathmax <- liftIO $ fileNameLengthLimit "."
- urlinfo <- if relaxed
+ urlinfo <- if relaxedOption o
then pure $ Url.UrlInfo True Nothing Nothing
else Url.withUrlOptions (Url.getUrlInfo urlstring)
- file <- case optfile of
+ file <- adjustFile o <$> case fileOption o of
Just f -> pure f
Nothing -> case Url.urlSuggestedFile urlinfo of
- Nothing -> pure $ url2file url pathdepth pathmax
+ Nothing -> pure $ url2file url (pathdepthOption o) pathmax
Just sf -> do
let f = truncateFilePath pathmax $
sanitizeFilePath sf
ifM (liftIO $ doesFileExist f <||> doesDirectoryExist f)
- ( pure $ url2file url pathdepth pathmax
+ ( pure $ url2file url (pathdepthOption o) pathmax
, pure f
)
showStart "addurl" file
- next $ performWeb relaxed urlstring file urlinfo
+ next $ performWeb (relaxedOption o) urlstring file urlinfo
#ifdef WITH_QUVI
badquvi = error $ "quvi does not know how to download url " ++ urlstring
usequvi = do
@@ -193,11 +204,11 @@ startWeb relaxed optfile pathdepth s = go $ fromMaybe bad $ parseURI urlstring
<$> withQuviOptions Quvi.forceQuery [Quvi.quiet, Quvi.httponly] urlstring
let link = fromMaybe badquvi $ headMaybe $ Quvi.pageLinks page
pathmax <- liftIO $ fileNameLengthLimit "."
- let file = flip fromMaybe optfile $
+ let file = adjustFile o $ flip fromMaybe (fileOption o) $
truncateFilePath pathmax $ sanitizeFilePath $
Quvi.pageTitle page ++ "." ++ fromMaybe "m" (Quvi.linkSuffix link)
showStart "addurl" file
- next $ performQuvi relaxed urlstring (Quvi.linkUrl link) file
+ next $ performQuvi (relaxedOption o) urlstring (Quvi.linkUrl link) file
#else
usequvi = error "not built with quvi support"
#endif
@@ -367,3 +378,9 @@ urlString2file :: URLString -> Maybe Int -> Int -> FilePath
urlString2file s pathdepth pathmax = case Url.parseURIRelaxed s of
Nothing -> error $ "bad uri " ++ s
Just u -> url2file u pathdepth pathmax
+
+adjustFile :: AddUrlOptions -> FilePath -> FilePath
+adjustFile o = addprefix . addsuffix
+ where
+ addprefix f = maybe f (++ f) (prefixOption o)
+ addsuffix f = maybe f (f ++) (suffixOption o)