diff --git a/src/Network/Wikipedia.hs b/src/Network/Wikipedia.hs --- a/src/Network/Wikipedia.hs +++ b/src/Network/Wikipedia.hs @@ -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 diff --git a/src/Web/Firefox.hs b/src/Web/Firefox.hs --- a/src/Web/Firefox.hs +++ b/src/Web/Firefox.hs @@ -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 [] diff --git a/src/Wikipedia4epub/Commands.hs b/src/Wikipedia4epub/Commands.hs --- a/src/Wikipedia4epub/Commands.hs +++ b/src/Wikipedia4epub/Commands.hs @@ -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 diff --git a/src/wiki4e-firefox-epub.hs b/src/wiki4e-firefox-epub.hs --- a/src/wiki4e-firefox-epub.hs +++ b/src/wiki4e-firefox-epub.hs @@ -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." diff --git a/wikipedia4epub.cabal b/wikipedia4epub.cabal --- a/wikipedia4epub.cabal +++ b/wikipedia4epub.cabal @@ -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,