1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
|
{- git-annex command
-
- Copyright 2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.ImportFeed where
import Text.Feed.Import
import Text.Feed.Query
import Text.Feed.Types
import qualified Data.Set as S
import qualified Data.Map as M
import Data.Char
import Common.Annex
import Command
import qualified Utility.Url as Url
import Logs.Web
import qualified Option
import qualified Utility.Format
import Utility.Tmp
import Command.AddUrl (addUrlFile, relaxedOption)
data ToDownload = ToDownload
{ feed :: Feed
, item :: Item
, location :: URLString
}
mkToDownload :: Feed -> Item -> Maybe ToDownload
mkToDownload f i = case getItemEnclosure i of
Nothing -> Nothing
Just (enclosureurl, _, _) -> Just $ ToDownload f i enclosureurl
def :: [Command]
def = [notBareRepo $ withOptions [templateOption, relaxedOption] $
command "importfeed" (paramRepeating paramUrl) seek
SectionCommon "import files from podcast feeds"]
templateOption :: Option
templateOption = Option.field [] "template" paramFormat "template for filenames"
seek :: [CommandSeek]
seek = [withField templateOption return $ \tmpl ->
withFlag relaxedOption $ \relaxed ->
withWords $ start relaxed tmpl]
start :: Bool -> Maybe String -> [URLString] -> CommandStart
start relaxed opttemplate = go Nothing
where
go _ [] = stop
go cache (url:urls) = do
showStart "importfeed" url
v <- findEnclosures url
if isJust v then showEndOk else showEndFail
case v of
Just l | not (null l) -> do
knownurls <- getknownurls cache
mapM_ (downloadEnclosure relaxed template knownurls) l
go (Just knownurls) urls
_ -> go cache urls
defaulttemplate = "${feedtitle}/${itemtitle}.${extension}"
template = Utility.Format.gen $ fromMaybe defaulttemplate opttemplate
{- This is expensive, so avoid running it more than once. -}
getknownurls (Just cached) = return cached
getknownurls Nothing = do
showSideAction "checking known urls"
S.fromList <$> knownUrls
findEnclosures :: URLString -> Annex (Maybe [ToDownload])
findEnclosures url = go =<< downloadFeed url
where
go Nothing = do
warning $ "failed to parse feed " ++ url
return Nothing
go (Just f) = return $ Just $
mapMaybe (mkToDownload f) (feedItems f)
{- Feeds change, so a feed download cannot be resumed. -}
downloadFeed :: URLString -> Annex (Maybe Feed)
downloadFeed url = do
showOutput
liftIO $ withTmpFile "feed" $ \f h -> do
fileEncoding h
ifM (Url.download url [] [] f)
( parseFeedString <$> hGetContentsStrict h
, return Nothing
)
{- Avoids downloading any urls that are already known to be associated
- with a file in the annex. -}
downloadEnclosure :: Bool -> Utility.Format.Format -> S.Set URLString -> ToDownload -> Annex ()
downloadEnclosure relaxed template knownurls enclosure
| S.member url knownurls = noop
| otherwise = do
dest <- liftIO $ feedFile template enclosure
showStart "addurl" dest
ifM (addUrlFile relaxed url dest)
( showEndOk
, showEndFail
)
where
url = location enclosure
{- Generate a unique filename for the feed item by filling
- out the template.
-
- Since each feed url is only downloaded once,
- if the file already exists, two items with different urls
- has the same title. A number is added to disambiguate.
-}
feedFile :: Utility.Format.Format -> ToDownload -> IO FilePath
feedFile template i = makeUnique 0 $
Utility.Format.format template $ M.fromList
[ field "feedtitle" $ getFeedTitle $ feed i
, fieldMaybe "itemtitle" $ getItemTitle $ item i
, fieldMaybe "feedauthor" $ getFeedAuthor $ feed i
, fieldMaybe "itemauthor" $ getItemAuthor $ item i
, fieldMaybe "itemsummary" $ getItemSummary $ item i
, fieldMaybe "itemdescription" $ getItemDescription $ item i
, fieldMaybe "itemrights" $ getItemRights $ item i
, fieldMaybe "itemid" $ snd <$> getItemId (item i)
, field "extension" $ takeExtension $ location i
]
where
field k v =
let s = map sanitize v in
if null s then (k, "none") else (k, s)
fieldMaybe k Nothing = (k, "none")
fieldMaybe k (Just v) = field k v
sanitize c
| isSpace c || isPunctuation c || c == '/' = '_'
| otherwise = c
makeUnique :: Integer -> FilePath -> IO FilePath
makeUnique n file =
ifM (isJust <$> catchMaybeIO (getSymbolicLinkStatus f))
( makeUnique (n + 1) file
, return file
)
where
f = if n == 0
then file
else
let (d, base) = splitFileName file
in d </> show n ++ "_" ++ base
|
