importfeed: git-annex becomes a podcatcher in 150 LOC

1 files changed, 45 insertions, 2 deletions

diff --git a/Logs/Web.hs b/Logs/Web.hs
index 0ed537a8e..cbce7a36e 100644
--- a/Logs/Web.hs
+++ b/Logs/Web.hs
@@ -1,6 +1,6 @@
 {- Web url logs.
  -
- - Copyright 2011 Joey Hess <joey@kitenet.net>
+ - Copyright 2011, 2013 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -11,12 +11,21 @@ module Logs.Web (
 	getUrls,
 	setUrlPresent,
 	setUrlMissing,
+	urlLog,
+	urlLogKey,
+	knownUrls
 ) where
 
+import qualified Data.ByteString.Lazy.Char8 as L
+
 import Common.Annex
 import Logs.Presence
 import Logs.Location
 import Types.Key
+import qualified Annex.Branch
+import Annex.CatFile
+import qualified Git
+import qualified Git.LsFiles
 
 type URLString = String
 
@@ -24,8 +33,24 @@ type URLString = String
 webUUID :: UUID
 webUUID = UUID "00000000-0000-0000-0000-000000000001"
 
+urlLogExt :: String
+urlLogExt = ".log.web"
+
 urlLog :: Key -> FilePath
-urlLog key = hashDirLower key </> keyFile key ++ ".log.web"
+urlLog key = hashDirLower key </> keyFile key ++ urlLogExt
+
+{- Converts a url log file into a key.
+ - (Does not work on oldurlLogs.) -}
+urlLogKey :: FilePath -> Maybe Key
+urlLogKey file
+	| ext == urlLogExt = fileKey base
+	| otherwise = Nothing
+  where
+  	(base, ext) = splitAt (length file - extlen) file
+	extlen = length urlLogExt
+
+isUrlLog :: FilePath -> Bool
+isUrlLog file = urlLogExt `isSuffixOf` file
 
 {- Used to store the urls elsewhere. -}
 oldurlLogs :: Key -> [FilePath]
@@ -58,3 +83,21 @@ setUrlMissing key url = do
 	addLog (urlLog key) =<< logNow InfoMissing url
 	whenM (null <$> getUrls key) $
 		logChange key webUUID InfoMissing
+
+{- Finds all known urls. -}
+knownUrls :: Annex [URLString]
+knownUrls = do
+	{- Ensure the git-annex branch's index file is up-to-date and
+	 - any journaled changes are reflected in it, since we're going
+	 - to query its index directly. -}
+	Annex.Branch.update
+	Annex.Branch.commit "update"
+	Annex.Branch.withIndex $ do
+		top <- fromRepo Git.repoPath
+		(l, cleanup) <- inRepo $ Git.LsFiles.stagedDetails [top]
+		r <- mapM (geturls . snd) $ filter (isUrlLog . fst) l
+		void $ liftIO cleanup
+		return $ concat r
+  where
+	geturls Nothing = return []
+  	geturls (Just logsha) = getLog . L.unpack <$> catObject logsha