Allow building without quvi support.

6 files changed, 67 insertions, 18 deletions

diff --git a/BuildFlags.hs b/BuildFlags.hs
index 384590c57..e1e5c1b88 100644
--- a/BuildFlags.hs
+++ b/BuildFlags.hs
@@ -51,4 +51,7 @@ buildFlags = filter (not . null)
 #ifdef WITH_FEED
 	, "Feeds"
 #endif
+#ifdef WITH_QUVI
+	, "Quvi"
+#endif
 	]
diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs
index 0309a6a59..21cb83f7e 100644
--- a/Command/AddUrl.hs
+++ b/Command/AddUrl.hs
@@ -5,6 +5,8 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE CPP #-}
+
 module Command.AddUrl where
 
 import Network.URI
@@ -27,8 +29,10 @@ import Annex.Content.Direct
 import Logs.Location
 import qualified Logs.Transfer as Transfer
 import Utility.Daemon (checkDaemon)
+#ifdef WITH_QUVI
 import Annex.Quvi
 import qualified Utility.Quvi as Quvi
+#endif
 
 def :: [Command]
 def = [notBareRepo $ withOptions [fileOption, pathdepthOption, relaxedOption] $
@@ -56,18 +60,25 @@ start relaxed optfile pathdepth s = go $ fromMaybe bad $ parseURI s
   	(s', downloader) = getDownloader s
 	bad = fromMaybe (error $ "bad url " ++ s') $
 		parseURI $ escapeURIString isUnescapedInURI s'
-	badquvi = error $ "quvi does not know how to download url " ++ s'
 	choosefile = flip fromMaybe optfile
 	go url = case downloader of
 		QuviDownloader -> usequvi
-		DefaultDownloader -> ifM (liftIO $ Quvi.supported s')
-			( usequvi
-			, do
-				pathmax <- liftIO $ fileNameLengthLimit "."
-				let file = choosefile $ url2file url pathdepth pathmax
-				showStart "addurl" file
-				next $ perform relaxed s' file
-			)
+		DefaultDownloader -> 
+#ifdef WITH_QIVI
+			ifM (liftIO $ Quvi.supported s')
+				( usequvi
+				, regulardownload url
+				)
+#else
+			regulardownload url
+#endif
+	regulardownload url = do
+		pathmax <- liftIO $ fileNameLengthLimit "."
+		let file = choosefile $ url2file url pathdepth pathmax
+		showStart "addurl" file
+		next $ perform relaxed s' file
+#ifdef WITH_QUVI
+	badquvi = error $ "quvi does not know how to download url " ++ s'
 	usequvi = do
 		page <- fromMaybe badquvi
 			<$> withQuviOptions Quvi.forceQuery [Quvi.quiet, Quvi.httponly] s'
@@ -76,7 +87,11 @@ start relaxed optfile pathdepth s = go $ fromMaybe bad $ parseURI s
 			Quvi.pageTitle page ++ "." ++ Quvi.linkSuffix link
 		showStart "addurl" file
 		next $ performQuvi relaxed s' (Quvi.linkUrl link) file
+#else
+	usequvi = error "not built with quvi support"
+#endif
 
+#ifdef WITH_QUVI
 performQuvi :: Bool -> URLString -> URLString -> FilePath -> CommandPerform
 performQuvi relaxed pageurl videourl file = ifAnnexed file addurl geturl
   where
@@ -96,6 +111,7 @@ performQuvi relaxed pageurl videourl file = ifAnnexed file addurl geturl
 					then next $ cleanup quviurl file key (Just tmp)
 					else stop
 			)
+#endif
 
 perform :: Bool -> URLString -> FilePath -> CommandPerform
 perform relaxed url file = ifAnnexed file addurl geturl
diff --git a/Remote/Web.hs b/Remote/Web.hs
index 42ae032e9..5b8df2994 100644
--- a/Remote/Web.hs
+++ b/Remote/Web.hs
@@ -5,6 +5,8 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE CPP #-}
+
 module Remote.Web (remote) where
 
 import Common.Annex
@@ -18,8 +20,10 @@ import Logs.Web
 import Types.Key
 import Utility.Metered
 import qualified Utility.Url as Url
+#ifdef WITH_QUVI
 import Annex.Quvi
 import qualified Utility.Quvi as Quvi
+#endif
 
 import qualified Data.Map as M
 
@@ -72,8 +76,14 @@ downloadKey key _file dest _p = get =<< getUrls key
 		untilTrue urls $ \u -> do
 			let (u', downloader) = getDownloader u
 			case downloader of
-				QuviDownloader -> flip downloadUrl dest
-					=<< withQuviOptions Quvi.queryLinks [Quvi.httponly, Quvi.quiet] u'
+				QuviDownloader -> do
+#ifdef WITH_QUVI
+					flip downloadUrl dest
+						=<< withQuviOptions Quvi.queryLinks [Quvi.httponly, Quvi.quiet] u'
+#else
+					warning "quvi support needed for this url"
+					return False
+#endif
 				DefaultDownloader -> downloadUrl [u'] dest
 
 downloadKeyCheap :: Key -> FilePath -> Annex Bool
@@ -94,14 +104,25 @@ checkKey key = do
 	us <- getUrls key
 	if null us
 		then return $ Right False
-		else return . Right =<< checkKey' key us
-checkKey' :: Key -> [URLString] -> Annex Bool
-checkKey' key us = untilTrue us $ \u -> do
+		else return =<< checkKey' key us
+checkKey' :: Key -> [URLString] -> Annex (Either String Bool)
+checkKey' key us = firsthit us (Right False) $ \u -> do
 	let (u', downloader) = getDownloader u
 	showAction $ "checking " ++ u'
 	case downloader of
 		QuviDownloader ->
-			withQuviOptions Quvi.check [Quvi.httponly, Quvi.quiet] u'
+#ifdef WITH_QUVI
+			Right <$> withQuviOptions Quvi.check [Quvi.httponly, Quvi.quiet] u'
+#else
+			return $ Left "quvi support needed for this url"
+#endif
 		DefaultDownloader -> do
 			headers <- getHttpHeaders
-			liftIO $ Url.check u' headers (keySize key)
+			liftIO $ Right <$> Url.check u' headers (keySize key)
+  where
+  	firsthit [] miss _ = return miss
+	firsthit (u:rest) _ a = do
+		r <- a u
+		case r of
+			Right _ -> return r
+			Left _ -> firsthit rest r a
diff --git a/debian/changelog b/debian/changelog
index 6a5150eb8..2e537c6dd 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -32,6 +32,7 @@ git-annex (4.20130828) UNRELEASED; urgency=low
     Works around chromium behavior where ajax connections to urls
     that were already accessed are denied after navigating back to
     a previous page.
+  * Allow building without quvi support.
 
  -- Joey Hess <joeyh@debian.org>  Tue, 27 Aug 2013 11:03:00 -0400
 
diff --git a/doc/bugs/Feature_request:___34__quvi__34___flag.mdwn b/doc/bugs/Feature_request:___34__quvi__34___flag.mdwn
index b710b6cf4..950aad0fc 100644
--- a/doc/bugs/Feature_request:___34__quvi__34___flag.mdwn
+++ b/doc/bugs/Feature_request:___34__quvi__34___flag.mdwn
@@ -11,3 +11,4 @@ See above.
 ### What version of git-annex are you using? On what operating system?
 I'm running Raspbian Wheezy on a Raspberry Pi. The git-annex version to be built is 4.20130827. 
 
+> [[done]] --[[Joey]]
diff --git a/git-annex.cabal b/git-annex.cabal
index 9aca6db7b..915f9aabe 100644
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -68,6 +68,9 @@ Flag TDFA
 Flag Feed
   Description: Enable podcast feed support
 
+Flag Quvi
+  Description: Enable use of quvi to download videos
+
 Executable git-annex
   Main-Is: git-annex.hs
   Build-Depends: MissingH, hslogger, directory, filepath,
@@ -76,7 +79,7 @@ Executable git-annex
    extensible-exceptions, dataenc, SHA, process, json,
    base (>= 4.5 && < 4.8), monad-control, MonadCatchIO-transformers,
    IfElse, text, QuickCheck >= 2.1, bloomfilter, edit-distance, process,
-   SafeSemaphore, uuid, random, dlist, unix-compat, aeson
+   SafeSemaphore, uuid, random, dlist, unix-compat
   -- Need to list these because they're generated from .hsc files.
   Other-Modules: Utility.Touch Utility.Mounts
   Include-Dirs: Utility
@@ -142,7 +145,7 @@ Executable git-annex
      yesod, yesod-default, yesod-static, yesod-form, yesod-core,
      case-insensitive, http-types, transformers, wai, wai-logger, warp,
      blaze-builder, crypto-api, hamlet, clientsession,
-     template-haskell, data-default
+     template-haskell, data-default, aeson
     CPP-Options: -DWITH_WEBAPP
 
   if flag(Pairing)
@@ -160,6 +163,10 @@ Executable git-annex
   if flag(Feed)
     Build-Depends: feed
     CPP-Options: -DWITH_FEED
+  
+  if flag(Quvi)
+    Build-Depends: aeson
+    CPP-Options: -DWITH_QUVI
 
 source-repository head
   type: git