diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c)2011, Jasper Van der Jeugt + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Jasper Van der Jeugt nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/download-media-content.cabal b/download-media-content.cabal new file mode 100644 --- /dev/null +++ b/download-media-content.cabal @@ -0,0 +1,48 @@ +Name: download-media-content +Version: 0.0.0.1 +Synopsis: Simple tool to download images from RSS feeds (e.g. Flickr, Picasa) +Homepage: http://github.com/jaspervdj/download-media-content +Author: Jasper Van der Jeugt +Maintainer: Jasper Van der Jeugt + +Description: + This package provides a very simple tool to download images from RSS feeds + (e.g. the kind that Flickr and Picasa provide). + + . + + Example usage: + + . + + > download-media-content + + . + + The tool will download the @media:content@ images found in the RSS feed (it + also supports some other formats) and place them in the current directory, + naming them @01.extension@, @02.extension@, etc. + +License: BSD3 +License-file: LICENSE + +Category: Application +Build-type: Simple +Cabal-version: >= 1.6 + +Executable download-media-content + Hs-source-dirs: src + Main-is: Main.hs + Other-modules: Network.DownloadMediaContent + + Build-depends: + base >= 4 && < 5, + tagsoup >= 0.11 && < 0.13, + text >= 0.11 && < 1.0, + bytestring >= 0.9 && < 1.0, + http-enumerator >= 0.6 && < 0.7, + filepath >= 1.0 && < 1.3 + +Source-repository head + Type: git + Location: git://github.com/jaspervdj/download-media-content.git diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,27 @@ +-- | Main module +module Main + ( main + ) where + +import Control.Applicative ((<$>)) +import Control.Monad (forM_) +import System.Environment (getArgs, getProgName) + +import Network.DownloadMediaContent + +-- | Main function +main :: IO () +main = do + args <- getArgs + progName <- getProgName + case args of + [name] -> downloadMediaContent name + _ -> putStrLn $ "Usage: " ++ progName ++ " " + +-- | Actual main function ;-) +downloadMediaContent :: String -> IO () +downloadMediaContent name = do + urls <- mediaContentUrls <$> readFileOrUrl name + forM_ (generateNames urls) $ \(url, fileName) -> do + putStrLn $ "Getting " ++ fileName ++ " (" ++ url ++ ")..." + downloadFile url fileName diff --git a/src/Network/DownloadMediaContent.hs b/src/Network/DownloadMediaContent.hs new file mode 100644 --- /dev/null +++ b/src/Network/DownloadMediaContent.hs @@ -0,0 +1,56 @@ +-- | Provides functions to download media content from an RSS feed +{-# LANGUAGE OverloadedStrings #-} +module Network.DownloadMediaContent + ( readFileOrUrl + , mediaContentUrls + , downloadFile + , generateNames + ) where + +import Data.List (nub) +import Data.Maybe (catMaybes) +import Network.HTTP.Enumerator (parseUrl, simpleHttp) +import System.FilePath (takeExtension, (<.>)) +import Text.HTML.TagSoup (Tag (..), parseTags) +import Text.Printf (printf) +import qualified Data.ByteString.Lazy as BL +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Encoding as TL + +-- | Download a file or simply open it +readFileOrUrl :: String -- ^ Filename or URL + -> IO BL.ByteString -- ^ Resulting content +readFileOrUrl name = case parseUrl name of + Nothing -> BL.readFile name + _ -> simpleHttp name + +-- | Take an XML document and extract the URL's of @media:content@ tags +mediaContentUrls :: BL.ByteString -- ^ Document + -> [String] -- ^ Media URL's +mediaContentUrls = nub . map str . catMaybes . map mediaContentUrl . parseTags + where + str = TL.unpack . TL.decodeUtf8 + mediaContentUrl (TagOpen "media:content" attrs) = lookup "url" attrs + mediaContentUrl (TagOpen "link" attrs) + | lookup "rel" attrs == Just "enclosure" = lookup "href" attrs + | otherwise = Nothing + mediaContentUrl _ = Nothing + +-- | Download a file +downloadFile :: String -- ^ URL + -> FilePath -- ^ Output filename + -> IO () +downloadFile url filePath = simpleHttp url >>= BL.writeFile filePath + +-- | Generate a number of names based on a list existing URL's +generateNames :: [String] -- ^ URL's + -> [(String, String)] -- ^ URL's and generated names +generateNames urls = + map (\(url, n) -> (url, generateName url n)) $ zip urls [1 ..] + where + generateName :: String -> Int -> String + generateName url n = + let name = printf ("%0" ++ show width ++ "d") n + ext = takeExtension $ takeWhile (`notElem` "#?") url + in name <.> ext + width = length $ show $ length urls