packages feed

download-media-content (empty) → 0.0.0.1

raw patch · 5 files changed

+163/−0 lines, 5 filesdep +basedep +bytestringdep +filepathsetup-changed

Dependencies added: base, bytestring, filepath, http-enumerator, tagsoup, text

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2011, Jasper Van der Jeugt <m@jaspervdj.be>++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 <m@jaspervdj.be> 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ download-media-content.cabal view
@@ -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 <m@jaspervdj.be>+Maintainer: Jasper Van der Jeugt <m@jaspervdj.be>++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 <some RSS feed or local filename>++  .++  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
+ src/Main.hs view
@@ -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 ++ " <RSS filename or URL>"++-- | 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
+ src/Network/DownloadMediaContent.hs view
@@ -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