Probe for quvi version at run time.
Overhead: git annex addurl runs quvi --version once. And more bloat to Annex state..
This commit is contained in:
parent
9ec1441a94
commit
7ac37a7854
8 changed files with 80 additions and 43 deletions
3
Annex.hs
3
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.
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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
|
||||
)
|
||||
|
|
|
@ -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
|
||||
)
|
||||
|
|
|
@ -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?
|
||||
|
|
6
debian/changelog
vendored
6
debian/changelog
vendored
|
@ -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
|
||||
|
|
|
@ -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]]
|
||||
|
|
Loading…
Reference in a new issue