Probe for quvi version at run time.

Overhead: git annex addurl runs quvi --version once.
And more bloat to Annex state..

8 files changed, 80 insertions, 43 deletions

diff --git a/Annex.hs b/Annex.hs
index f3f2a9177..e3bd95c33 100644
--- a/Annex.hs
+++ b/Annex.hs
@@ -62,6 +62,7 @@ import Types.MetaData
 import qualified Utility.Matcher
 import qualified Data.Map as M
 import qualified Data.Set as S
+import Utility.Quvi (QuviVersion)
 
 {- git-annex's monad is a ReaderT around an AnnexState stored in a MVar.
  - This allows modifying the state in an exception-safe fashion.
@@ -116,6 +117,7 @@ data AnnexState = AnnexState
 	, useragent :: Maybe String
 	, errcounter :: Integer
 	, unusedkeys :: Maybe (S.Set Key)
+	, quviversion :: Maybe QuviVersion
 	}
 
 newState :: GitConfig -> Git.Repo -> AnnexState
@@ -154,6 +156,7 @@ newState c r = AnnexState
 	, useragent = Nothing
 	, errcounter = 0
 	, unusedkeys = Nothing
+	, quviversion = Nothing
 	}
 
 {- Makes an Annex state object for the specified git repo.
diff --git a/Annex/Quvi.hs b/Annex/Quvi.hs
index b0725bae7..1a2edf6b8 100644
--- a/Annex/Quvi.hs
+++ b/Annex/Quvi.hs
@@ -14,7 +14,20 @@ import qualified Annex
 import Utility.Quvi
 import Utility.Url
 
-withQuviOptions :: forall a. Query a -> [CommandParam] -> URLString -> Annex a
+withQuviOptions :: forall a. Query a -> [QuviParam] -> URLString -> Annex a
 withQuviOptions a ps url = do
+	v <- quviVersion
 	opts <- map Param . annexQuviOptions <$> Annex.getGitConfig
-	liftIO $ a (ps++opts) url
+	liftIO $ a v (map (\mkp -> mkp v) ps++opts) url
+
+quviSupported :: URLString -> Annex Bool
+quviSupported u = liftIO . flip supported u =<< quviVersion
+
+quviVersion :: Annex QuviVersion
+quviVersion = go =<< Annex.getState Annex.quviversion
+  where
+	go (Just v) = return v
+	go Nothing = do
+		v <- liftIO probeVersion
+		Annex.changeState $ \s -> s { Annex.quviversion = Just v }
+		return v
diff --git a/Build/Configure.hs b/Build/Configure.hs
index 487ed9b10..593e3ada7 100644
--- a/Build/Configure.hs
+++ b/Build/Configure.hs
@@ -35,8 +35,6 @@ tests =
 	, TestCase "curl" $ testCmd "curl" "curl --version >/dev/null"
 	, TestCase "wget" $ testCmd "wget" "wget --version >/dev/null"
 	, TestCase "bup" $ testCmd "bup" "bup --version >/dev/null"
-	, TestCase "quvi" $ testCmd "quvi" "quvi --version >/dev/null"
-	, TestCase "newquvi" $ testCmd "newquvi" "quvi info >/dev/null"
 	, TestCase "nice" $ testCmd "nice" "nice true >/dev/null"
 	, TestCase "ionice" $ testCmd "ionice" "ionice -c3 true >/dev/null"
 	, TestCase "nocache" $ testCmd "nocache" "nocache true >/dev/null"
diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs
index ae56908c1..a0978a88d 100644
--- a/Command/AddUrl.hs
+++ b/Command/AddUrl.hs
@@ -64,7 +64,7 @@ start relaxed optfile pathdepth s = go $ fromMaybe bad $ parseURI s
 		QuviDownloader -> usequvi
 		DefaultDownloader -> 
 #ifdef WITH_QUVI
-			ifM (liftIO $ Quvi.supported s')
+			ifM (quviSupported s')
 				( usequvi
 				, regulardownload url
 				)
diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs
index 005d42d20..50f4278b6 100644
--- a/Command/ImportFeed.hs
+++ b/Command/ImportFeed.hs
@@ -108,7 +108,7 @@ findDownloads u = go =<< downloadFeed u
 		Nothing -> mkquvi f i
 #ifdef WITH_QUVI
 	mkquvi f i = case getItemLink i of
-		Just link -> ifM (liftIO $ Quvi.supported link)
+		Just link -> ifM (quviSupported link)
 			( return $ Just $ ToDownload f u i $ QuviLink link
 			, return Nothing
 			)
diff --git a/Utility/Quvi.hs b/Utility/Quvi.hs
index 4039167ac..bb4975cbe 100644
--- a/Utility/Quvi.hs
+++ b/Utility/Quvi.hs
@@ -11,7 +11,6 @@ module Utility.Quvi where
 
 import Common
 import Utility.Url
-import Build.SysConfig (newquvi)
 
 import Data.Aeson
 import Data.ByteString.Lazy.UTF8 (fromString)
@@ -19,6 +18,11 @@ import qualified Data.Map as M
 import Network.URI (uriAuthority, uriRegName)
 import Data.Char
 
+data QuviVersion
+	= Quvi04
+	| Quvi09
+	| NoQuvi
+
 data Page = Page
 	{ pageTitle :: String
 	, pageLinks :: [Link]
@@ -56,11 +60,19 @@ parseEnum s = Page
 	get = flip M.lookup m
 	m = M.fromList $ map (separate (== '=')) $ lines s
 
-type Query a = [CommandParam] -> URLString -> IO a
+probeVersion :: IO QuviVersion
+probeVersion = examine <$> processTranscript "quvi" ["--version"] Nothing
+  where
+	examine (s, True)
+		| "quvi v0.4" `isInfixOf` s = Quvi04
+		| otherwise = Quvi09
+	examine _ = NoQuvi
+
+type Query a = QuviVersion -> [CommandParam] -> URLString -> IO a
 
 {- Throws an error when quvi is not installed. -}
 forceQuery :: Query (Maybe Page)
-forceQuery ps url = query' ps url `catchNonAsync` onerr
+forceQuery v ps url = query' v ps url `catchNonAsync` onerr
   where
 	onerr _ = ifM (inPath "quvi")
 		( error "quvi failed"
@@ -70,33 +82,36 @@ forceQuery ps url = query' ps url `catchNonAsync` onerr
 {- Returns Nothing if the page is not a video page, or quvi is not
  - installed. -}
 query :: Query (Maybe Page)
-query ps url = flip catchNonAsync (const $ return Nothing) (query' ps url)
+query v ps url = flip catchNonAsync (const $ return Nothing) (query' v ps url)
 
 query' :: Query (Maybe Page)
-query' ps url
-	| newquvi = parseEnum
-		<$> readProcess "quvi" (toCommand $ [Param "dump", Param "-p", Param "enum"] ++ ps ++ [Param url])
-	| otherwise = decode . fromString
-		<$> readProcess "quvi" (toCommand $ ps ++ [Param url])
+query' Quvi09 ps url = parseEnum
+	<$> readProcess "quvi" (toCommand $ [Param "dump", Param "-p", Param "enum"] ++ ps ++ [Param url])
+query' Quvi04 ps url = decode . fromString
+	<$> readProcess "quvi" (toCommand $ ps ++ [Param url])
+query' NoQuvi _ _ = return Nothing
 
 queryLinks :: Query [URLString]
-queryLinks ps url = maybe [] (map linkUrl . pageLinks) <$> query ps url
+queryLinks v ps url = maybe [] (map linkUrl . pageLinks) <$> query v ps url
 
 {- Checks if quvi can still find a download link for an url.
  - If quvi is not installed, returns False. -}
 check :: Query Bool
-check ps url = maybe False (not . null . pageLinks) <$> query ps url
+check v ps url = maybe False (not . null . pageLinks) <$> query v ps url
 
 {- Checks if an url is supported by quvi, as quickly as possible
  - (without hitting it if possible), and without outputting
  - anything. Also returns False if quvi is not installed. -}
-supported :: URLString -> IO Bool
-supported url
-	{- Use quvi-info to see if the url's domain is supported.
-	 - If so, have to do a online verification of the url. -}
-	| newquvi = (firstlevel <&&> secondlevel)
+supported :: QuviVersion -> URLString -> IO Bool
+supported NoQuvi _ = return False
+supported Quvi04 url = boolSystem "quvi"
+		[ Params "--verbosity mute --support"
+		, Param url
+		]
+{- Use quvi-info to see if the url's domain is supported.
+ - If so, have to do a online verification of the url. -}
+supported Quvi09 url = (firstlevel <&&> secondlevel)
 		`catchNonAsync` (\_ -> return False)
-	| otherwise = boolSystem "quvi" [Params "--verbosity mute --support", Param url]
   where
   	firstlevel = case uriAuthority =<< parseURIRelaxed url of
 		Nothing -> return False
@@ -104,30 +119,30 @@ supported url
 			let domain = map toLower $ uriRegName auth
 			let basedomain = intercalate "." $ reverse $ take 2 $ reverse $ split "." domain
 			any (\h -> domain `isSuffixOf` h || basedomain `isSuffixOf` h) 
-				. map (map toLower) <$> listdomains
+				. map (map toLower) <$> listdomains Quvi09
 	secondlevel = snd <$> processTranscript "quvi"
 		(toCommand [Param "dump", Param "-o", Param url]) Nothing
 
-listdomains :: IO [String]
-listdomains 
-	| newquvi = concatMap (split ",") 
-		. concatMap (drop 1 . words) 
-		. filter ("domains: " `isPrefixOf`) . lines
-		<$> readProcess "quvi"
-			(toCommand [Param "info", Param "-p", Param "domains"])
-	| otherwise = return []
+listdomains :: QuviVersion -> IO [String]
+listdomains Quvi09 = concatMap (split ",") 
+	. concatMap (drop 1 . words) 
+	. filter ("domains: " `isPrefixOf`) . lines
+	<$> readProcess "quvi"
+		(toCommand [Param "info", Param "-p", Param "domains"])
+listdomains _ = return []
+
+type QuviParam = QuviVersion -> CommandParam
 
 {- Disables progress, but not information output. -}
-quiet :: CommandParam
-quiet
-	-- Cannot use quiet as it now disables informational output.
-	-- No way to disable progress.
-	| newquvi = Params "--verbosity verbose"
-	| otherwise = Params "--verbosity quiet"
+quiet :: QuviParam
+-- Cannot use quiet as it now disables informational output.
+-- No way to disable progress.
+quiet Quvi09 = Params "--verbosity verbose"
+quiet Quvi04 = Params "--verbosity quiet"
+quiet NoQuvi = Params ""
 
 {- Only return http results, not streaming protocols. -}
-httponly :: CommandParam
-httponly
-	-- No way to do it with 0.9?
-	| newquvi = Params ""
-	| otherwise = Params "-c http"
+httponly :: QuviParam
+-- No way to do it with 0.9?
+httponly Quvi04 = Params "-c http"
+httponly _ = Params "" -- No way to do it with 0.9?
diff --git a/debian/changelog b/debian/changelog
index 5264f0a70..e042624f3 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+git-annex (5.20140228) UNRELEASED; urgency=medium
+
+  * Probe for quvi version at run time.
+
+ -- Joey Hess <joeyh@debian.org>  Fri, 28 Feb 2014 14:52:15 -0400
+
 git-annex (5.20140227) unstable; urgency=medium
 
   * metadata: Field names limited to alphanumerics and a few whitelisted
diff --git a/doc/bugs/quvi_0.9.5_does_not_work_with_git-annex.mdwn b/doc/bugs/quvi_0.9.5_does_not_work_with_git-annex.mdwn
index 4d776fc51..7e760bb70 100644
--- a/doc/bugs/quvi_0.9.5_does_not_work_with_git-annex.mdwn
+++ b/doc/bugs/quvi_0.9.5_does_not_work_with_git-annex.mdwn
@@ -83,3 +83,5 @@ It does however output some status messages to STDERR (which it removes later) t
 [0 zerodogg@browncoats Dokumentar]$ cat -v stderr 
 status: o--- resolve <url> ...                                                 ^M                                                                               ^Mstatus: -o-- fetch <url> ...                                                   ^M                                                                               ^M%               [0 zerodogg@browncoats Dokumentar]$              
 """ ]]
+
+> quvi version now probed at runtime. [[done]] --[[Joey]]