wikipedia4epub 0.0.2 → 0.0.3

raw patch · 5 files changed

+153/−41 lines, 5 filesdep ~ghcPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: ghc

API changes (from Hackage documentation)

Files

• src/Network/Wikipedia.hs +48/−7
• src/Web/Firefox.hs +24/−13
• src/Wikipedia4epub/Commands.hs +72/−18
• src/wiki4e-firefox-epub.hs +7/−1
• wikipedia4epub.cabal +2/−2

@@ -2,7 +2,9 @@                          , WikiArticle(..)                          , articleURL2Title                          , getArticleLinks+                         , getArticleImages                          , sanitizeArticle+                         , sanitizeFileName                          --, fetchPrintArticle                          --, fetchRawArticle                          , fetchArticle)@@ -13,20 +15,36 @@ import Text.Regex.Base import Network.HTTP import Text.HTML.TagSoup+import System.FilePath import Data.List (nub) import Data.Maybe (catMaybes, mapMaybe, fromJust)  data WikiArticle = WikiArticleHTML { waTitle :: String, waContent :: String }                   | WikiArticleSRC  { waTitle :: String, waContent :: String } deriving (Show, Ord, Eq) ++sanitizeFileName :: FilePath -> FilePath+sanitizeFileName cs = map (unPercent) $ urlEncode cs+    where+      unPercent c = if (c == '%') then 'X' else c+ isArticleURL :: URL -> Bool isArticleURL (URL (Absolute (Host (HTTP False) xs Nothing)) ph []) = (xs =~ ".*en[.]wikipedia.org$") && (ph =~ "wiki/[^:/]+$" ) isArticleURL _ = False  articleURL2Title :: URL -> String-articleURL2Title x | isArticleURL x = filter (/= '%') $ urlEncode $ tail $ dropWhile (/='/') (url_path x)+articleURL2Title x | isArticleURL x = sanitizeFileName (takeFileName (url_path x))                    | otherwise      = "" +isArticleImgURL :: String -> Bool+isArticleImgURL cs = cs =~ "^http://upload.wikimedia.org/.*"++getArticleImages :: WikiArticle -> [URL]+getArticleImages x = let inTags = parseTags (waContent x)+                         imgTags = filter (isTagOpenName "img") inTags+                         imgSrcs = filter (isArticleImgURL) $ map (fromAttrib "src") imgTags +                     in mapMaybe importURL imgSrcs+ getArticleLinks :: WikiArticle -> [URL] getArticleLinks xs = let inTags = parseTags (waContent xs)                          aTags = filter (isTagOpenName "a") inTags@@ -43,22 +61,45 @@ articleURL2RawURL xs | isArticleURL xs = URL (url_type xs) "w/index.php" [("title",articleURL2Title xs),("action","raw")]                      | otherwise       = xs + sanitizeArticle :: WikiArticle -> WikiArticle sanitizeArticle xs = let inTags = parseTags (waContent xs)-                         outTags = processTags $ filterTags "img" $ filterTags "div" $ filterTags "link" $ filterTags "script" inTags+                         outTags = procImgTags $ processTags $ filterAllTags tags4Filter inTags+                         tags4Filter = ["link", "script", "sup" ]                      in WikiArticleHTML (waTitle xs) (renderTags outTags) -processTags xs = map removeEmptyAttr xs+processTags xs = map processAttrs xs    where-     removeEmptyAttr t@(TagOpen s xs) | null s        = t-                                      | head s == '!' = t-                                      | otherwise     = TagOpen s (filter (not . null . snd) xs) -     removeEmptyAttr t = t+     processAttrs t@(TagOpen "a" _)  = TagText ""+     processAttrs t@(TagClose "a")   = TagText ""+     processAttrs t@(TagOpen  "div" _) = TagText ""+     processAttrs t@(TagClose "div") = TagText ""+     processAttrs t@(TagOpen s xs) | null s        = t+                                   | head s == '!' = t+                                   | otherwise     = TagOpen s (removeStyleAttr $ removeEmptyAttr xs)+     processAttrs t = t+     removeEmptyAttr xs = filter (not . null . snd) xs +     removeStyleAttr xs = filter (\x -> (fst x) `notElem` ["style", "id", "class"]) xs ++filterAllTags tgs xs = filter (not . isTagComment) $ foldr (filterTags) xs tgs ++isTagComment (TagComment _) = True+isTagComment _              = False+ filterTags tn [] = [] filterTags tn (x:xs) | isTagOpenName tn x  = filterTags tn $ dropWhile (not . isTagCloseName tn) xs                      | isTagCloseName tn x = filterTags tn xs                      | otherwise           = x:filterTags tn xs++procImgTags [] = []+procImgTags (x:xs) | isTagOpenName "img" x = let absP   = fromAttrib "src" x+                                                 relP   = "img" </> (sanitizeFileName $ takeFileName $ url_path $ fromJust $ importURL absP)+                                                 imgOk  = TagOpen "img" [("src",relP)]+                                                 imgNok = tail $ dropWhile (not . isTagCloseName "img") xs+                                             in if isArticleImgURL absP then imgOk:(procImgTags xs) else procImgTags imgNok+                   | otherwise             = x:procImgTags xs+ {- fetchPrintArticle :: URL -> IO WikiArticle fetchPrintArticle xs = do

@@ -5,12 +5,16 @@ import Network.URL (importURL, URL) import Data.List (isSuffixOf) import Control.Monad (forM)-import Data.Maybe (catMaybes, mapMaybe)-import System.Directory (doesDirectoryExist, getDirectoryContents, getHomeDirectory)+import Data.Maybe (mapMaybe)+import System.Directory (doesDirectoryExist, getDirectoryContents, getHomeDirectory, getTemporaryDirectory, copyFile, removeFile) import System.FilePath ((</>)) -firefoxDirs = [ ".mozilla" ]+firefoxDirs :: [String]+firefoxDirs = [ ".mozilla", ".mozilla-firefox", ".firefox" ]++placesFile :: String placesFile = "places.sqlite"+ timeoutFox = 5  listPlacesFiles :: IO [FilePath]@@ -29,20 +33,27 @@ listHistoryURLs :: FilePath -> IO [URL] listHistoryURLs name = do    putStrLn $ "Going to connect on Firefox SQLite DB: " ++ name-   conn <- connectSqlite3 name+   tmpDir <- getTemporaryDirectory+   let tmpName = tmpDir </> "wiki4e_places.sqlite"+   copyFile name tmpName+   conn <- connectSqlite3 tmpName    setBusyTimeout conn (1000*timeoutFox)    xs <- quickQuery' conn "select url from moz_places order by last_visit_date desc" []    let ys = map (fromSql . head) xs :: [String]+   removeFile tmpName    return $ mapMaybe importURL ys  getRecursiveContents :: FilePath -> IO [FilePath] getRecursiveContents topdir = do-  names <- getDirectoryContents topdir-  let properNames = filter (`notElem` [".", ".."]) names-  paths <- forM properNames $ \name -> do-    let path = topdir </> name-    isDirectory <- doesDirectoryExist path-    if isDirectory-      then getRecursiveContents path-      else return [path]-  return (concat paths)+  e <- doesDirectoryExist topdir+  if e then do+    names <- getDirectoryContents topdir+    let properNames = filter (`notElem` [".", ".."]) names+    paths <- forM properNames $ \name -> do+      let path = topdir </> name+      e2 <- doesDirectoryExist path+      if e2+        then getRecursiveContents path+        else return [path]+    return (concat paths)+    else return []

@@ -4,10 +4,11 @@ import System.FilePath import System.Directory import Network.URL-import Control.Monad (liftM)+import Control.Monad (liftM, filterM) import Data.List (nub, foldl')-import Data.Char (isLetter)+import Data.Char (toLower) import System.IO+import Network.HTTP import Codec.EBook import qualified Data.ByteString.Lazy as B @@ -16,7 +17,7 @@   e <- doesFileExist filename   if not e then do     putStrLn $ "Fetching : " ++ exportURL x-    (WikiArticleHTML t c) <- fetchArticle x+    (WikiArticleHTML _ c) <- fetchArticle x     withBinaryFile filename WriteMode (flip hPutStr c)     else putStrLn $ "File already exists. Skipping download: " ++ filename   where@@ -40,39 +41,92 @@                )          ) +wiki4e_listArticleImages :: FilePath -> IO [URL]+wiki4e_listArticleImages x = do+          h <- openFile x ReadMode+          hSetEncoding h utf8+          c <- hGetContents h+          return $ getArticleImages (WikiArticleHTML "" c)++wiki4e_listArticlesImages :: FilePath -> IO [URL]+wiki4e_listArticlesImages ind = do +     xs <- wiki4e_listFiles ind+     ys <- mapM (wiki4e_listArticleImages) xs+     return $ nub $ concat ys++wiki4e_fetchImage :: FilePath -> URL -> IO ()+wiki4e_fetchImage oud x = do+  e <- doesFileExist filename+  if not e then do+    createDirectoryIfMissing True (takeDirectory filename)+    putStrLn $ "Fetching : " ++ exportURL x+    rsp <- Network.HTTP.simpleHTTP (getRequest (exportURL x))+    c <- (getResponseBody rsp)+    withBinaryFile filename WriteMode (flip hPutStr c)+    else putStrLn $ "File already exists. Skipping download: " ++ filename+  where+    filename = oud </> name+    name     = sanitizeFileName $ takeFileName (url_path x)++wiki4e_fetchImages :: FilePath -> [URL] -> IO ()+wiki4e_fetchImages oud xs = mapM_ (wiki4e_fetchImage oud) xs+ wiki4e_sanitizeArticles :: FilePath -> FilePath -> IO () wiki4e_sanitizeArticles ind oud = wiki4e_listFiles ind >>= -     mapM_ (\x -> wiki4e_sanitizeArticle (ind </> x) (oud </> x))+     mapM_ (\x -> wiki4e_sanitizeArticle x (oud </> (takeFileName x)))  wiki4e_listFiles :: FilePath -> IO [FilePath]-wiki4e_listFiles = liftM (filter (\(c:_) -> c /= '.')) . getDirectoryContents+wiki4e_listFiles xs = do+  nonDot <- liftM (filter (\(c:_) -> c /= '.')) $ getDirectoryContents xs+  dirs <- filterM (doesDirectoryExist) (map (xs </>) nonDot)+  fils <- filterM (\e -> liftM (not) $ doesDirectoryExist e ) (map (xs </>) nonDot)+  ys <- mapM (wiki4e_listFiles) dirs+  return $ (concat ys) ++ fils -wiki4e_createEpub :: String -> FilePath -> IO ()-wiki4e_createEpub bookName srcDir = do-     xs <- wiki4e_listFiles srcDir+wiki4e_listFirefoxURLs :: IO [URL]+wiki4e_listFirefoxURLs = do+     xs <- listAllHistoryURLs+     return $ nub $ filter isArticleURL xs++wiki4e_createEpub :: String -> FilePath -> FilePath -> IO ()+wiki4e_createEpub bookName srcDir imgDir = do      let book = emptyBook {                    bookID = "http://localhost/"++bookName,                   bookAuthor = "wiki4e-firefox-epub",                   bookTitle = bookName                 }-     let fileNames = map (srcDir </>) xs-     items <- mapM (loadArticleFile "wiki") fileNames-     let bookFull = foldl' addItem2Book book items+     xs <- wiki4e_listFiles srcDir+     itemsA <- mapM (\(i,x) -> loadArticleFile i "wiki" x) $ zip [1..] xs+     ys <- wiki4e_listFiles imgDir+     itemsI <- mapM (\(i,x) -> loadImgFile i "wiki/img" x) $ zip [(length xs + 1)..] ys+     let bookFull = foldl' addItem2Book book (itemsA ++ itemsI)      let epubFName = bookName++".epub"      outdata <- book2Bin' bookFull      B.writeFile epubFName  outdata      putStrLn $ epubFName ++ " constructed." -loadArticleFile :: FilePath -> FilePath -> IO BookItem-loadArticleFile bookDir fname = do+-- Support Functions++loadArticleFile :: Int -> FilePath -> FilePath -> IO BookItem+loadArticleFile i bookDir fname = do    cs <- B.readFile fname    return (BookItem aid bfile cs opsMediatype (Just (ChapterMetadata name)))     where-      aid = filter isLetter name +      aid = show i       bfile = bookDir </> name       name = takeFileName $ normalise fname -wiki4e_listFirefoxURLs :: IO [URL]-wiki4e_listFirefoxURLs = do-     xs <- listAllHistoryURLs-     return $ nub $ filter isArticleURL xs+loadImgFile :: Int -> FilePath -> FilePath -> IO BookItem+loadImgFile i bookDir fname = do+   cs <- B.readFile fname+   return (BookItem aid bfile cs mimeType Nothing) +   where+      mimeType | hasExt ".png"  name = "image/png"+               | hasExt ".jpeg" name = "image/jpeg"+               | hasExt ".jpg"  name = "image/jpeg"+               | hasExt ".gif"  name = "image/gif"+               | otherwise = "image/png"+      hasExt x f = (map toLower $ takeExtension f) == x+      aid = show i+      bfile = bookDir </> name+      name = takeFileName $ normalise fname

@@ -4,6 +4,7 @@ import System.FilePath import Wikipedia4epub.Commands import System.IO +import Network.URL  main = do   name <- getProgName@@ -22,12 +23,17 @@   tmpDir <- getTemporaryDirectory   let tmpDirFetch    = tmpDir </> "wiki4e_fetch"        let tmpDirSanitize = tmpDir </> "wiki4e_sanitize"+  let tmpDirImgs     = tmpDir </> "wiki4e_images"   createDirectoryIfMissing True tmpDirFetch   createDirectoryIfMissing True tmpDirSanitize+  createDirectoryIfMissing True tmpDirImgs   putStrLn $ "Fetching "++show (length xs)++" Articles..."   wiki4e_fetchArticles tmpDirFetch xs   putStrLn "Sanitize Articles..."   wiki4e_sanitizeArticles tmpDirFetch tmpDirSanitize+  putStrLn "Download Images..."+  imgs <- wiki4e_listArticlesImages tmpDirFetch+  wiki4e_fetchImages tmpDirImgs imgs   putStrLn "Constructing EPUB..."-  wiki4e_createEpub bookName tmpDirSanitize+  wiki4e_createEpub bookName tmpDirSanitize tmpDirImgs   putStrLn "Done."

@@ -1,5 +1,5 @@ Name:            wikipedia4epub-Version:         0.0.2+Version:         0.0.3 License:         BSD3 License-File:    LICENSE Homepage:        http://rampa.sk/static/wikipedia4epub.html@@ -23,7 +23,7 @@   location: http://patch-tag.com/r/dixiecko/wikipedia4epub      Library-  Build-Depends:   ghc,+  Build-Depends:   ghc >= 6.12.1,                    base < 5,                    filepath,                    bytestring,