packages feed

feed2lj 0.0.2 → 0.0.3

raw patch · 2 files changed

+71/−22 lines, 2 filesdep +tagsoup

Dependencies added: tagsoup

Files

Feed2Lj.hs view
@@ -3,9 +3,11 @@ import LjPost  import System.Environment (getArgs)-import System.Directory (renameFile)+import System.Directory (renameFile, doesFileExist)+import System (exitWith, ExitCode(..)) import Control.Monad (liftM, mapM,ap)-import Maybe (fromJust, isNothing, isJust)+import Maybe (fromJust, fromMaybe, isNothing, isJust, maybe)+import List ((\\)) import Network.HTTP (urlEncode)  import Text.Regex.Posix ((=~))@@ -14,6 +16,7 @@ import Text.Feed.Import (parseFeedString) import Text.Feed.Types (Feed, Item) import Text.Feed.Query+import Text.HTML.TagSoup  import IO import Codec.Binary.UTF8.String (encodeString)@@ -34,12 +37,18 @@      then (first ++ [head rest],tail rest)      else (first,[]) --- remove all html/xml tags, quick and dirty+-- remove all html/xml tags, use tag text and replace images with their ALT text eatTags :: String -> String eatTags [] = [] eatTags s =-  let (b,t,a) = s =~ "</?[^>]*/?>" :: (String,String,String)-  in b ++ eatTags a+  let tags = parseTags s+      toString t =+        if (isTagOpenName "img" t)+          then (fromAttrib "alt" t)++" "+          else if isTagText t+            then fromTagText t+            else ""+  in  concat $ map toString tags  -- mini template engine renderTemplate _ [] = []@@ -54,42 +63,77 @@        then b ++ (fromJust val) ++ renderTemplate alist a        else b ++ t ++ renderTemplate alist a -renderItem :: String -> Item -> String-renderItem t i =+renderItem :: (Maybe Int) -> String -> Item -> String+renderItem n t i =   let title = ( fromJust . getItemTitle ) i       link = ( fromJust . getItemLink ) i       guid = ( fromJust . getItemId ) i-      summary = ( takeSentences 5 . eatTags . fromJust . getItemSummary) i+      justFirst Nothing = id+      justFirst (Just n) = takeSentences n+      summary = ( justFirst n . eatTags . fromJust . getItemSummary) i       tags = zip [ "title","link","text" ]                  [ title, urlEncode link,summary ]   in renderTemplate tags t  isNotSent sent i = ((snd . fromJust . getItemId) i) `notElem` sent -postItem u p t i = do-  let message = renderItem t i+postItem u p t n i = do+  let message = renderItem n t i   let subj = fromJust $ getItemTitle i   r <- postToLj u p subj message   if isSuccess r     then putLjKey "url" r     else putLjKey "errmsg" r +printItem t n i = do+  let message = renderItem n t i+  let subj = fromJust $ getItemTitle i+  putStrLn $ "Subject: " ++ subj+  putStrLn message+  putStrLn ""++readFileIfExists f = do+  t <- doesFileExist f+  if t then readFile f+       else return ""++readMaybeInt =  maybe Nothing (\s -> Just (read s::Int))++usage = "usage: feed2lj [--help] [--dry-run] http://example.com/rss.xml"++printUsageAndExitIf c status =+  if c+    then do { putStrLn usage ; exitWith status ; }+    else return ()+ main = do-  url:_ <- getArgs+  args <- getArgs+  let opts = [ "--help", "--dry-run" ]+  let dryrun = "--dry-run" `elem` args+  printUsageAndExitIf ("--help" `elem` args) ExitSuccess++  let args' = args \\ opts+  printUsageAndExitIf (length args' == 0) $ ExitFailure 1++  let url= head $ args \\ opts   (_,rawfeed) <- curlGetString url []    ljuser <- return fromJust `ap` readLjSetting "username"   ljpass <- return fromJust `ap` readLjSetting "password"   sentfile <- return fromJust `ap` readLjSetting "sentfile"   t <- return fromJust `ap` readLjSetting "template"-  sent_ids <- (return . lines) =<< readFile sentfile+  nsentences <- return readMaybeInt `ap` readLjSetting "nsentences"+  sent_ids <- (return . lines) =<< readFileIfExists sentfile    let feed = fromJust $ parseFeedString rawfeed   let items = feedItems feed   let newitems = reverse $ filter (isNotSent sent_ids) items   let new_ids = map ( snd . fromJust . getItemId) newitems -  mapM_ (postItem ljuser ljpass t) newitems--  renameFile sentfile (sentfile ++ "~")-  writeFile sentfile $ unlines (sent_ids ++ new_ids)+  if not dryrun+    then do+      mapM_ (postItem ljuser ljpass t nsentences) newitems+      renameFile sentfile (sentfile ++ "~")+      writeFile sentfile $ unlines (sent_ids ++ new_ids)+    else do -- debug script and cross-post preview+      mapM_ (printItem t nsentences) newitems
feed2lj.cabal view
@@ -1,12 +1,10 @@ name:                feed2lj-version:             0.0.2+version:             0.0.3 synopsis:            Cross-post any RSS/Atom feed to LiveJournal description:         A script to cross-post any RSS/Atom Feed to LiveJournal.                      .-                     All HTML tags are merely stripped from the original. By-                     default the script takes only the first 5 sentences of-                     the original message. You may need to edit source to change-                     this behaviour.+                     All HTML tags are merely stripped from the original.+                     Images are replaced with their ALT attributes.                      .                      CONFIGURATION                      .@@ -15,6 +13,8 @@                      message are saved to the file defined by `sentfile`.                      Additionally, define an HTML `template` of the cross-posted                      messages as they should appear in LJ.+                     Option `nsentences`, if defined, specifies how many+                     sentences of the original message are to be cross-posted.                      .                      For example:                      .@@ -22,10 +22,14 @@                           > password=myljpassword                           > sentfile=/path/to/file/where/crossposted/GUIDs/are/saved                           > template=<p>%text%</p><p>( <a href="%link%" title="%title%">more</a> )</p>+                          > nsentences=5                      .                      USAGE                      .-                          > $ feed2lj http://example.com/rss.xml+                          > $ feed2lj [--help] [--dry-run] http://example.com/rss.xml+                     .+                     Use `--dry-run` option to preview results without actually+                     posting to LJ.  stability:           experimental category:            Web@@ -53,6 +57,7 @@                        , old-locale, directory, time                        , utf8-string, regex-posix                        , HTTP, curl, feed+                       , tagsoup >= 0.6   if flag(nano-md5)     build-depends:  nano-md5     cpp-options:    -DNANOMD5