Advertisement
Guest User

Untitled

a guest
Sep 4th, 2010
207
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. import Data.IORef
  2. import Network.HTTP
  3. import Network.Browser
  4. import Network.URI
  5. import Data.Maybe
  6. import Control.Monad
  7. import Data.List
  8. import Text.Regex.TDFA
  9. import Control.Concurrent
  10.  
  11. pageUrl off = URI "http:" (Just $ URIAuth "" "www.interpals.net" "") "/dosearch.php" ("?todo=search&sec=adv&age1=15&age2=18&sex[]=FEMALE&lfor[]=lfor_email&lfor[]=lfor_snail&lfor[]=lfor_langex&lfor[]=lfor_friend&lfor[]=lfor_flirt&lfor[]=lfor_relation&countries[]=AT&countries[]=DE&countries[]=CH&state=&languages[]=any&keywords=&sort=p.last_login+DESC&offset="++(show off)) ""
  12.  
  13. getPage     :: URI -> BrowserAction (HandleStream [Char]) String
  14. getPage uri = do
  15.     setErrHandler $ const $ return ()
  16.     setOutHandler $ const $ return ()
  17.     (_,s) <- request $ Request (uri) GET
  18.         [Header HdrCookie "__ubic1=MTE3ODM0NDM0MTRjN2RkYTA1OTAzMmU4LjkxODE1Njk2; __utma=46363135.421215970.1283316265.1283538085.1283541700.10; __utmz=46363135.1283316265.1.1.utmccn=(direct)|utmcsr=(direct)|utmcmd=(none); __utmc=46363135; PHPSESSID=59a130c66d4853f85289852f15cefa3a; resolution=1920x1080; ip_auto_login[login]=cap11235; ip_auto_login[password_md5]=NDM0NWM0NDlkZTg4MjRkMWVhZmJmZWNiZTQwOWQ4YTE%3D; __utmb=46363135"] ""
  19.     return $ rspBody s
  20.  
  21. getPeople :: Int -> BrowserAction (HandleStream [Char]) ([String], Int)
  22. getPeople off = do
  23.     s <- getPage (pageUrl off)
  24.     let t = (s=~"<a href='/([^?.]+)\\?")::[[String]]
  25.     let next = if length t > 0 then off+10 else 0
  26.     return (nub $ map (!!1) t, next)
  27.  
  28. personUrl :: String -> URI
  29. personUrl name = fromJust $ parseURI ("http://www.interpals.net/"++name)
  30.  
  31. viewPerson :: String -> BrowserAction (HandleStream [Char]) ()
  32. viewPerson name = do
  33.     _ <- getPage $ personUrl name
  34.     return ()
  35.  
  36. doCycle :: IORef (Int, Int) -> IO ()
  37. doCycle r = do
  38.     (count, off) <- readIORef r
  39.     (people, newOff) <- browse $  getPeople off
  40.     mapM_ (forkIO . browse . viewPerson) people
  41.     let newCount = count + (length people)
  42.     writeIORef r (newCount, if newOff<2000 then newOff else 0)
  43.     print newCount
  44.     doCycle r
  45.  
  46. main = do
  47.     t <- newIORef (0,0)
  48.     doCycle t
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement