SHARE
TWEET

Untitled

a guest Sep 4th, 2010 179 Never
  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
RAW Paste Data
Top