diff options
| -rw-r--r-- | Annex.hs | 3 | ||||
| -rw-r--r-- | Annex/Quvi.hs | 17 | ||||
| -rw-r--r-- | Build/Configure.hs | 2 | ||||
| -rw-r--r-- | Command/AddUrl.hs | 2 | ||||
| -rw-r--r-- | Command/ImportFeed.hs | 2 | ||||
| -rw-r--r-- | Utility/Quvi.hs | 89 | ||||
| -rw-r--r-- | debian/changelog | 6 | ||||
| -rw-r--r-- | doc/bugs/quvi_0.9.5_does_not_work_with_git-annex.mdwn | 2 |
8 files changed, 80 insertions, 43 deletions
@@ -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]] |