shpider 0.2 → 0.2.1.1
raw patch · 4 files changed
+99/−33 lines, 4 filesdep +timedep ~tagsoup-parsec
Dependencies added: time
Dependency ranges changed: tagsoup-parsec
Files
- Network/Shpider.hs +62/−24
- Network/Shpider/Options.hs +23/−0
- Network/Shpider/State.hs +10/−6
- shpider.cabal +4/−3
Network/Shpider.hs view
@@ -41,8 +41,10 @@ , module Network.Shpider.Options , module Network.Shpider.Forms , module Network.Shpider.Links+ -- * Crawl Functions , download , sendForm+ -- * Basic Parsing/Decision Support , getLinksByText , getLinksByTextRegex , getLinksByAddressRegex@@ -50,6 +52,7 @@ , getFormsHasAction , currentLinks , currentForms+ -- * Utilities , parsePage , isAuthorizedDomain , withAuthorizedDomain@@ -57,25 +60,23 @@ ) where -import Network.Curl +import Control.Concurrent+import qualified Data.Map as M+import Data.Maybe+import Data.Time+import Network.Curl+import Network.Shpider.Code+import Network.Shpider.Forms+import Network.Shpider.Links+import Network.Shpider.Options+import Network.Shpider.State+import Network.Shpider.URL+import Text.HTML.TagSoup+import Text.HTML.TagSoup+import Text.Regex.Posix+import Web.Encodings -import Text.HTML.TagSoup-import Text.Regex.Posix -import qualified Data.Map as M-import Data.Maybe--import Text.HTML.TagSoup--import Network.Shpider.State-import Network.Shpider.URL-import Network.Shpider.Code-import Network.Shpider.Options-import Network.Shpider.Forms-import Network.Shpider.Links--import Web.Encodings- -- | if `keepTrack` has been set, then haveVisited will return `True` if the given URL has been visited. haveVisited :: String -> Shpider Bool haveVisited uncleanUrl = do@@ -120,12 +121,49 @@ setCurrentPage newP return newP -curlDownload url = do- shpider <- get- res <- liftIO $ curlGetString url $ curlOpts shpider- r <- mkRes url res- return r +-------------------------------------------------------------------------------+-- | Perform the given operation subject to blocking throttling based+-- on the last time there was a download.+withThrottle :: Shpider a -> Shpider a+withThrottle f = do+ let perform = do+ res <- f+ sh <- get+ now <- liftIO $ getCurrentTime+ put $ sh { lastDownloadTime = Just now }+ return res+ thOpt <- gets downloadThrottle+ lastD <- gets lastDownloadTime+ case thOpt of+ Nothing -> perform+ Just n -> do+ case lastD of + Nothing -> perform+ Just ld -> do+ th <- liftIO $ shouldThrottle n ld+ case th of+ Just x -> liftIO (threadDelay x) >> perform+ Nothing -> perform+ ++-------------------------------------------------------------------------------+-- | Test whether we need to throttle+shouldThrottle :: Int -> UTCTime -> IO (Maybe Int)+shouldThrottle n lastTime = do+ now <- getCurrentTime+ let n' = fromIntegral n / 1000000+ diff = diffUTCTime now lastTime+ delta = round . (* 1000000) $ n' - diff+ return $ if delta > 0 then (Just delta) else Nothing+++curlDownload url = withThrottle $ do+ shpider <- get+ res <- liftIO $ curlGetString url $ curlOpts shpider+ r <- mkRes url res+ return r+ mkRes url ( curlCode , html ) = do p <- if curlCode == CurlOK then@@ -135,7 +173,7 @@ return ( ccToSh curlCode , p ) -curlDownloadPost url fields = do+curlDownloadPost url fields = withThrottle $ do shpider <- get res <- liftIO $ curlGetString url $ opts shpider mkRes url res@@ -146,7 +184,7 @@ ] ++ curlOpts sh -curlDownloadHead urlStr = do+curlDownloadHead urlStr = withThrottle $ do shpider <- get liftIO $ curlHead urlStr $ curlOpts shpider
Network/Shpider/Options.hs view
@@ -116,3 +116,26 @@ keepTrack = do shpider <- get put $ shpider { visited = Just [ ] }+++-- | Add CURL options to Shpider+addCurlOpts :: [CurlOption] -> Shpider ()+addCurlOpts opts = do+ shpider <- get+ put $ shpider { curlOpts = opts ++ curlOpts shpider }+ ++-- | Set Shpider's CURL options from scratch+setCurlOpts :: [CurlOption] -> Shpider ()+setCurlOpts opts = do+ shpider <- get+ put $ shpider { curlOpts = opts}+ ++-- | Set download throttling, so that subsequent calls to 'download'+-- or 'sendForm' block, making sure at least N micro-seconds pass.+-- Passing a "Nothing" would disable any throttling.+setThrottle :: Maybe Int -> Shpider ()+setThrottle n = do+ sh <- get+ put $ sh { downloadThrottle = n}
Network/Shpider/State.hs view
@@ -37,16 +37,14 @@ where import Control.Monad.State--import Network.Curl- import Data.Maybe--import Text.HTML.TagSoup.Parsec-+import Data.Time+import Network.Curl import Network.Shpider.Forms import Network.Shpider.Links+import Text.HTML.TagSoup.Parsec + -- | The shpider state holds all the options for shpider transactions, the current page and all the `CurlOption`s used when calling curl. data ShpiderState = SS { htmlOnlyDownloads :: Bool@@ -55,6 +53,10 @@ , curlOpts :: [ CurlOption ] , currentPage :: Page , visited :: Maybe [ String ]+ , downloadThrottle :: Maybe Int+ -- ^ Whether to wait at least N micro-seconds between downloads+ -- or form submissions. Defaults to 'Nothing'.+ , lastDownloadTime :: Maybe UTCTime } deriving Show @@ -85,6 +87,8 @@ ] , currentPage = emptyPage , visited = Nothing + , downloadThrottle = Nothing+ , lastDownloadTime = Nothing } -- | The Page datatype. Holds `Link`s, `Form`s, the parsed [ `Tag` ], the page source, and the page's absolute URL.
shpider.cabal view
@@ -1,5 +1,5 @@ Name: shpider -Version: 0.2+Version: 0.2.1.1 Synopsis: Web automation library in Haskell. Description: Shpider is a web automation library for Haskell. It allows you to quickly@@ -37,11 +37,12 @@ base < 5 , regex-posix , curl- , tagsoup-parsec + , tagsoup-parsec >= 0.0.8 , url>=2 , containers , tagsoup - , mtl + , mtl+ , time , bytestring , web-encodings Exposed-modules: Network.Shpider.URL