Added support for quvi 0.9. Slightly suboptimal due to limitations in its interface compared with the old version.

Build/Configure.hs

@@ -35,6 +35,7 @@ tests =
 	, 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 "gpg" $ maybeSelectCmd "gpg"

Utility/Quvi.hs

@@ -11,9 +11,13 @@ module Utility.Quvi where
 
 import Common
 import Utility.Url
+import Build.SysConfig (newquvi)
 
 import Data.Aeson
 import Data.ByteString.Lazy.UTF8 (fromString)
+import qualified Data.Map as M
+import Network.URI (uriAuthority, uriRegName)
+import Data.Char
 
 data Page = Page
 	{ pageTitle :: String
@@ -25,6 +29,7 @@ data Link = Link
 	, linkUrl :: URLString
 	} deriving (Show)
 
+{- JSON instances for quvi 0.4. -}
 instance FromJSON Page where
 	parseJSON (Object v) = Page
 		<$> v .: "page_title"
@@ -37,6 +42,18 @@ instance FromJSON Link where
 		<*> v .: "url"
 	parseJSON _ = mzero
 
+{- "enum" format used by quvi 0.9 -}
+parseEnum :: String -> Maybe Page
+parseEnum s = Page
+	<$> get "QUVI_MEDIA_PROPERTY_TITLE"
+	<*> ((:[]) <$> link)
+  where
+	link = Link
+		<$> get "QUVI_MEDIA_STREAM_PROPERTY_CONTAINER"
+		<*> get "QUVI_MEDIA_STREAM_PROPERTY_URL"
+	get = flip M.lookup m
+	m = M.fromList $ map (separate (== '=')) $ lines s
+
 type Query a = [CommandParam] -> URLString -> IO a
 
 {- Throws an error when quvi is not installed. -}
@@ -54,8 +71,11 @@ query :: Query (Maybe Page)
 query ps url = flip catchNonAsync (const $ return Nothing) (query' ps url)
 
 query' :: Query (Maybe Page)
-query' ps url = decode . fromString
+query' ps url
-	<$> readProcess "quvi" (toCommand $ ps ++ [Param url])
+	| newquvi = parseEnum
+		<$> readProcess "quvi" (toCommand $ [Param "dump", Param "-p", Param "enum"] ++ ps ++ [Param url])
+	| otherwise = decode . fromString
+		<$> readProcess "quvi" (toCommand $ ps ++ [Param url])
 
 queryLinks :: Query [URLString]
 queryLinks ps url = maybe [] (map linkUrl . pageLinks) <$> query ps url
@@ -65,17 +85,47 @@ queryLinks ps url = maybe [] (map linkUrl . pageLinks) <$> query ps url
 check :: Query Bool
 check ps url = maybe False (not . null . pageLinks) <$> query ps url
 
-{- Checks if an url is supported by quvi, without hitting it, or outputting
+{- 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 = boolSystem "quvi" [Params "--verbosity mute --support", Param url]
+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)
+		`catchNonAsync` (\_ -> return False)
+	| otherwise = boolSystem "quvi" [Params "--verbosity mute --support", Param url]
+  where
+  	firstlevel = case uriAuthority =<< parseURIRelaxed url of
+		Nothing -> return False
+		Just auth -> do
+			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
+	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 []
+
+{- Disables progress, but not information output. -}
 quiet :: CommandParam
-quiet = Params "--verbosity quiet"
+quiet
-
+	-- Cannot use quiet as it now disables informational output.
-noredir :: CommandParam
+	-- No way to disable progress.
-noredir = Params "-e -resolve"
+	| newquvi = Param "--verbosity verbose"
+	| otherwise = Params "--verbosity quiet"
 
 {- Only return http results, not streaming protocols. -}
 httponly :: CommandParam
-httponly = Params "-c http"
+httponly
+	-- No way to do it with 0.9?
+	| newquvi = Params ""
+	| otherwise = Params "-c http"

Utility/Url.hs

@@ -14,7 +14,8 @@ module Utility.Url (
 	checkBoth,
 	exists,
 	download,
-	downloadQuiet
+	downloadQuiet,
+	parseURIRelaxed
 ) where
 
 import Common

debian/changelog

@@ -11,6 +11,8 @@ git-annex (5.20131121) UNRELEASED; urgency=low
   * annex.autoupgrade configures both the above upgrade behaviors.
   * Fix bug that broke switching between local repositories
     in the webapp when they use the new guarded direct mode.
+  * Added support for quvi 0.9. Slightly suboptimal due to limitations in its
+    interface compared with the old version.
 
  -- Joey Hess <joeyh@debian.org>  Wed, 20 Nov 2013 18:30:47 -0400