summaryrefslogtreecommitdiff
path: root/Logs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-07-28 15:27:36 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-07-28 16:55:42 -0400
commit217068206893864ed05911c3b06d8fdb802750a1 (patch)
tree3bfa87ee63197405f3aa18138eb8affd3ce7c7e7 /Logs
parent468e2c789371f924ec4586148e4e9e5618c58303 (diff)
importfeed: git-annex becomes a podcatcher in 150 LOC
Diffstat (limited to 'Logs')
-rw-r--r--Logs/Web.hs47
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