addurl: Add --pathdepth option.

1 files changed, 26 insertions, 11 deletions

diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs
index 981af2f7e..a6c89542e 100644
--- a/Command/AddUrl.hs
+++ b/Command/AddUrl.hs
@@ -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