diff --git a/Commands/Update.hs b/Commands/Update.hs --- a/Commands/Update.hs +++ b/Commands/Update.hs @@ -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 = diff --git a/DB.hs b/DB.hs --- a/DB.hs +++ b/DB.hs @@ -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))] diff --git a/DownloadQueue.hs b/DownloadQueue.hs --- a/DownloadQueue.hs +++ b/DownloadQueue.hs @@ -1,5 +1,5 @@ {- hpodder component -Copyright (C) 2006 John Goerzen +Copyright (C) 2006-2008 John Goerzen 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 @@ -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)) diff --git a/hpodder.cabal b/hpodder.cabal --- a/hpodder.cabal +++ b/hpodder.cabal @@ -1,5 +1,5 @@ Name: hpodder -Version: 1.1.1 +Version: 1.1.2 License: GPL Maintainer: John Goerzen 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 diff --git a/hpodder.hs b/hpodder.hs --- a/hpodder.hs +++ b/hpodder.hs @@ -45,7 +45,7 @@ import Utils import Database.HDBC -main = handleSqlError $ +main = do updateGlobalLogger "" (setLevel INFO) argv <- getArgs let (optargs, commandargs) = span (isPrefixOf "-") argv