packages feed

hpodder 1.1.1 → 1.1.2

raw patch · 5 files changed

+37/−14 lines, 5 files

Files

Commands/Update.hs view
@@ -42,6 +42,7 @@  i = infoM "update" w = warningM "update"+d = debugM "update"  cmd = simpleCmd "update"        "Re-scan all feeds and update list of needed downloads" helptext @@ -81,7 +82,8 @@                     updateThePodcast gi pt meter dlentry dltok status result =-    do incrP (dlprogress dlentry) 1+    do d "Download complete"+       incrP (dlprogress dlentry) 1        let pc = usertok dlentry        feed <- getFeed meter pc (result, status) dltok        case feed of@@ -96,14 +98,18 @@                      commit (gdbh gi)                      when (pcenabled newpc == PCErrorDisabled) $                         i ("   Podcast " ++ castname newpc ++ " disabled due to errors.")-         Just f -> do newpc <- updateFeed gi pc f+         Just f -> do d "Got feed"+                      newpc <- updateFeed gi pc f+                      d "Got newpc from feed"                       curtime <- now                       updatePodcast (gdbh gi)                                      (newpc {lastupdate = Just curtime,                                             lastattempt = Just curtime,                                             failedattempts = 0})                       --i $ "   Podcast Title: " ++ (castname newpc)+                      d $ "Updated podcast on disk"                       commit (gdbh gi)+                      d $ "Committed changes"  considerDisable gi pc = forceEither $     do faildays <- get (gcp gi) (show (castid pc)) "podcastfaildays"@@ -127,6 +133,7 @@ updateFeed gi pcorig f =     do count <- foldM (updateEnc gi pc) 0 (items f)        --i $ printf "   %d new episodes" count+       d $ "Added " ++ show count ++ " new episodes"        return pc     where pc = pcorig {castname = newname}           newname = if (castname pcorig) == ""@@ -134,7 +141,10 @@                        else (castname pcorig)  updateEnc gi pc count item = -    do newc <- addEpisode (gdbh gi) (item2ep pc item)+    do d $ "updateEnc running on item " ++ show item+       newc <- addEpisode (gdbh gi) (item2ep pc item)+       commit (gdbh gi)+       d $ "addEpisode returned"        return $ count + newc  getFeed meter pc (result, status) dltok =
DB.hs view
@@ -258,17 +258,28 @@              lastupdate = fromSql lupdate, lastattempt = fromSql lattempt,              failedattempts = fromSql fattempts} -{- | Add a new episode. If the episode already exists, update the URL, GUID-and title fields while preserving other fields as they are. Returns the number-of inserted rows. -}+{- | Add a new episode. If the episode already exists, based solely on+looking at the GUID (if present), update the URL and title fields while +preserving other fields as they are. Returns the number of inserted rows. -} addEpisode :: Connection -> Episode -> IO Integer addEpisode dbh ep = -    do run dbh "UPDATE episodes SET epurl = ?, epguid = ?, title = ? WHERE castid = ? AND (epurl = ? OR epguid = ?)"-           [toSql (epurl ep), toSql (epguid ep), toSql (eptitle ep),-            toSql (castid (podcast ep)), toSql (epurl ep), toSql (epguid ep)]+    do +       -- We have to be careful of cases where a feed may have two+       -- different episodes with different GUIDs but identical URLs.+       -- So if we have a GUID match here, we must have a conflict on URL,+       -- so we ignore the request to change it.+       when (epguid ep /= Nothing) $+          do run dbh "UPDATE OR IGNORE episodes SET epurl = ?, epguid = ?, title = ? \+                  \WHERE castid = ? AND epguid = ?"+                 [toSql (epurl ep), toSql (epguid ep), toSql (eptitle ep),+                  toSql (castid (podcast ep)), toSql (epguid ep)]+             return ()        -- if the UPDATE was successful, that means that something with the same        -- URL or GUID already exists, so the INSERT below will be ignored.+       dbdebug "update done"        nextepid <- getepid+       dbdebug $ "addEpisode: epid: " ++ show nextepid+       dbdebug "addEpisode: running insertEpisode"        insertEpisode "INSERT OR IGNORE" dbh ep nextepid     where getepid =                do r <- quickQuery dbh "SELECT MAX(episodeid) FROM episodes WHERE castid = ?" [toSql (castid (podcast ep))]
DownloadQueue.hs view
@@ -1,5 +1,5 @@ {- hpodder component-Copyright (C) 2006 John Goerzen <jgoerzen@complete.org>+Copyright (C) 2006-2008 John Goerzen <jgoerzen@complete.org>  This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by@@ -18,7 +18,7 @@  {- |    Module     : DownloadQueue-   Copyright  : Copyright (C) 2006 John Goerzen+   Copyright  : Copyright (C) 2006-2008 John Goerzen    License    : GNU GPL, version 2 or above     Maintainer : John Goerzen <jgoerzen@complete.org>@@ -39,6 +39,7 @@ import System.Cmd.Utils import Data.Maybe.Utils import System.Posix.Process+import Database.HDBC(handleSqlError) import Config import System.Log.Logger import Text.Printf@@ -150,7 +151,7 @@                                           allowResume = resumeOK,                                           callbackFunc = callbackfunc}        semaphore <- newQSem 0 -- Used by threads to signal they're done-       mapM_ (\_ -> forkIO (childthread dqmvar semaphore)) [1..maxthreads]+       mapM_ (\_ -> forkIO (handleSqlError $ childthread dqmvar semaphore)) [1..maxthreads]        mapM_ (\_ -> waitQSem semaphore) [1..maxthreads]        restoresignals oldsigs        withMVar dqmvar (\dq -> return (completedDownloads dq))
hpodder.cabal view
@@ -1,5 +1,5 @@ Name: hpodder-Version: 1.1.1+Version: 1.1.2 License: GPL Maintainer: John Goerzen <jgoerzen@complete.org> Author: John Goerzen@@ -13,6 +13,7 @@   doc/sgml-common/Makefile.common, doc/sgml-common/SConstruct,   doc/sgml-common/ps2epsi homepage: http://software.complete.org/hpodder+Build-type: Simple Category: Network Synopsis: Podcast Aggregator (downloader) Description:  Podcasting is a method of publishing radio-like programs on the
hpodder.hs view
@@ -45,7 +45,7 @@ import Utils import Database.HDBC -main = handleSqlError $+main =      do updateGlobalLogger "" (setLevel INFO)        argv <- getArgs        let (optargs, commandargs) = span (isPrefixOf "-") argv