hpdft 0.1.0.4 → 0.1.0.5
raw patch · 9 files changed
+202/−36 lines, 9 filesdep +hpdftdep ~directorydep ~parsecnew-component:exe:hpdftPVP ok
version bump matches the API change (PVP)
Dependencies added: hpdft
Dependency ranges changed: directory, parsec
API changes (from Hackage documentation)
Files
- data/sample/Sample.hs +3/−0
- hpdft.cabal +19/−5
- hpdft.hs +65/−0
- src/PDF/Cmap.hs +23/−3
- src/PDF/ContentStream.hs +30/−15
- src/PDF/Definition.hs +1/−0
- src/PDF/Object.hs +49/−13
- src/PDF/Outlines.hs +10/−0
- src/PDF/PDFIO.hs +2/−0
data/sample/Sample.hs view
@@ -1,6 +1,9 @@ {-# LANGUAGE OverloadedStrings #-} +module Main where+ import PDF.Definition+ import PDF.Object import PDF.PDFIO import PDF.Outlines
hpdft.cabal view
@@ -1,5 +1,5 @@ name: hpdft-version: 0.1.0.4+version: 0.1.0.5 synopsis: A tool for looking through PDF file using Haskell -- description: homepage: https://github.com/k16shikano/hpdft@@ -18,6 +18,7 @@ data-files: map/Adobe-Japan1-6.map data-files: sample/Sample.hs + library hs-source-dirs: src/ exposed-modules: PDF.PDFIO@@ -27,18 +28,31 @@ , PDF.Definition , PDF.Outlines , PDF.Object- -- other-modules: + other-modules: Paths_hpdft other-extensions: OverloadedStrings build-depends: base >=4.6 && <5 , bytestring >=0.10 && <0.11 , text >=0.11- , parsec >=3.1 && <3.2+ , parsec >=3.0 && <3.2 , attoparsec >=0.13.0 && <1.0 , zlib >=0.5 , utf8-string >=0.3- , directory >=1.2 && <1.3+ , directory >=1.2 , containers >=0.5 && <0.6 , file-embed >=0.0.9 && <1.0 , binary >=0.7.5 && <0.8.2- -- hs-source-dirs: + autogen-modules: Paths_hpdft default-language: Haskell2010+ buildable: True++executable hpdft+ main-is: hpdft.hs+ hs-source-dirs: .+ other-modules: Paths_hpdft+ other-extensions: OverloadedStrings+ build-depends: hpdft+ , base >=4.6 && <5+ , bytestring >=0.10 && <0.11+ , utf8-string >=0.3+ default-language: Haskell2010+ buildable: True
+ hpdft.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import PDF.Definition++import PDF.Object+import PDF.PDFIO+import PDF.Outlines++import System.Environment (getArgs)++import Data.ByteString.UTF8 (ByteString)+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy.Char8 as BSL+import Data.List (nub)+import Data.Maybe (fromMaybe)++import Debug.Trace++initstate = PSR { linex=0+ , liney=0+ , absolutex=0+ , absolutey=0+ , leftmargin=0.0+ , top=0.0+ , bottom=0.0+ , fontfactor=1+ , curfont=""+ , fontmaps=[]+ , cmaps=[]+ , colorspace=""+ , xcolorspaces=[]+ }++main = do+ fn:_ <- getArgs+ pdfToText fn++-- | Get a whole text from 'filename'. It works as:+-- (1) grub objects+-- (2) parse within each object, deflating its stream+-- (3) linearize stream++pdfToText filename = do+ contents <- BS.readFile filename+ let objs = expandObjStm $ map parsePDFObj $ getObjs contents+ let rootref = fromMaybe 0 (rootRef contents)+ BSL.putStrLn $ linearize rootref objs++linearize :: Int -> [PDFObj] -> PDFStream+linearize parent objs = + case findObjsByRef parent objs of+ Just os -> case findDictOfType "/Catalog" os of+ Just dict -> case pages dict of + Just pr -> linearize pr objs+ Nothing -> ""+ Nothing -> case findDictOfType "/Pages" os of+ Just dict -> case pagesKids dict of+ Just kidsrefs -> BSL.concat $ map ((\f -> f objs) . linearize) kidsrefs+ Nothing -> ""+ Nothing -> case findDictOfType "/Page" os of+ Just dict -> contentsStream dict initstate objs+ Nothing -> ""+ Nothing -> ""
src/PDF/Cmap.hs view
@@ -23,12 +23,15 @@ import PDF.Definition parseCMap :: BSL.ByteString -> CMap-parseCMap str = case runParser (concat <$> manyTill cmapParser (try $ string "endcmap")) () "" str of+parseCMap str = case runParser (concat <$> + manyTill + (try bfchar <|> (concat <$> bfrange)) + (try $ string "endcmap")) () "" str of Left err -> error "Can not parse CMap" Right cmap -> cmap -cmapParser :: Parser CMap-cmapParser = do+bfchar :: Parser CMap+bfchar = do spaces manyTill anyChar (try $ string "beginbfchar") spaces@@ -38,6 +41,23 @@ spaces return ms where toCmap cid ucs = ((fst.head.readHex) cid, ((:[]).chr.fst.head.readHex) ucs)++bfrange :: Parser [CMap]+bfrange = do+ spaces+ manyTill anyChar (try $ string "beginbfrange")+ spaces+ ms <- many1 (toCmap <$> (getRange <$> hexletters <*> hexletters) <*> hexletters)+ spaces+ string "endbfrange"+ spaces+ return ms+ where + getRange cid cid' = [gethex cid .. gethex cid']+ toCmap range ucs = zip range (map ((:[]).chr) [gethex ucs ..])++gethex = fst.head.readHex+ hexletters :: Parser String hexletters = do
src/PDF/ContentStream.hs view
@@ -7,7 +7,10 @@ ) where import Data.Char (chr)+import Data.String (fromString)+import Data.List (isPrefixOf) import Numeric (readOct, readHex)+import Data.Maybe (fromMaybe) import Data.Binary (decode) import Data.ByteString (ByteString)@@ -35,7 +38,7 @@ parseDeflated :: PSR -> BSC.ByteString -> PDFStream parseDeflated psr pdfstream = case parseContentStream (T.concat <$> many (elems <|> skipOther)) psr pdfstream of- Left err -> error "Nothing to be parsed"+ Left err -> error $ "Nothing to be parsed: " ++ (show err) Right str -> BSC.pack $ BS.unpack $ encodeUtf8 str deflate :: PSR -> PDFStream -> PDFStream@@ -84,15 +87,16 @@ , try graphicState , try pdfopcm , try $ T.empty <$ colorSpace+ , try $ T.empty <$ renderingIntent , unknowns ] pdfopGraphics :: PSParser T.Text pdfopGraphics = do spaces- choice [ try $ T.empty <$ oneOf "qQ" <* space <* spaces- , try $ T.empty <$ oneOf "fFbBW" <* (many $ string "*") <* spaces- , try $ T.empty <$ oneOf "nsS" <* space <* spaces+ choice [ try $ T.empty <$ oneOf "qQ" <* spaces+ , try $ T.empty <$ oneOf "fFbBW" <* (many $ string "*") <* space <* spaces+ , try $ T.empty <$ oneOf "nsS" <* spaces , try $ T.empty <$ (digitParam <* spaces) <* oneOf "jJM" <* space <* spaces , try $ T.empty <$ (digitParam <* spaces) <* oneOf "dwi" <* space <* spaces , try $ T.empty <$ (many1 (digitParam <* spaces) <* oneOf "ml" <* space <* spaces)@@ -128,7 +132,14 @@ dashPattern = do char '[' >> many digit >> char ']' >> spaces >> many1 digit >> spaces >> string "d" return T.empty- ++renderingIntent :: PSParser T.Text+renderingIntent = do+ ri <- choice [ try $ string "/" *> manyTill anyChar (try space) <* string "ri " <* spaces+ , try $ string "/" *> manyTill anyChar (try space) <* string "Intent" <* spaces+ ]+ return $ T.pack ri+ pathConstructor :: PSParser T.Text pathConstructor = do choice [ try $ T.empty <$ (digitParam <* spaces) <* oneOf "ml" <* spaces@@ -218,24 +229,22 @@ return $ T.concat lets adobeOneSix :: Int -> T.Text-adobeOneSix a = case Map.lookup a (adobeJapanOneSixMap) of+adobeOneSix a = case Map.lookup a adobeJapanOneSixMap of Just cs -> T.pack $ BSL.toString cs Nothing -> T.pack $ "[" ++ (show a) ++ "]" toUcs :: CMap -> Int -> T.Text-toUcs map h = case lookup h map of+toUcs m h = case lookup h m of Just ucs -> T.pack ucs Nothing -> adobeOneSix h hexletter :: PSParser T.Text hexletter = do st <- getState- let cmap = case lookup (curfont st) (cmaps st) of- Just m -> m- Nothing -> []+ let cmap = fromMaybe [] (lookup (curfont st) (cmaps st)) (hexToString cmap . readHex) <$> (count 4 $ oneOf "0123456789ABCDEFabcdef")- where hexToString map [] = "????"- hexToString map [(h,_)] = toUcs map h+ where hexToString m [(h,"")] = toUcs m h+ hexToString _ _ = "????" psletter :: PSParser T.Text psletter = do@@ -254,9 +263,15 @@ Nothing -> T.pack [c'] replaceWithCharDict s = case Map.lookup s pdfcharmap of Just cs -> cs- Nothing -> T.pack s- octToChar [] = '?'- octToChar [(o,_)] = chr o+ Nothing -> if "/uni" `isPrefixOf` s+ then readUni s+ else T.pack s+ readUni s = case readHex (drop 4 s) of+ [(i,"")] -> T.singleton $ chr i+ [(i,x)] -> T.pack (chr i : " ")+ _ -> T.pack s+ octToChar [(o,"")] = chr o+ octToChar _ = '?' kern :: PSParser T.Text kern = do
src/PDF/Definition.hs view
@@ -37,6 +37,7 @@ dictentry e = error $ "Illegular dictionary entry "++show e toString depth (PdfText t) = t toString depth (PdfStream s) = "\n " ++ (BSL.unpack $ decompress s)+--toString depth (PdfStream s) = "\n " ++ (BSL.unpack $ s) toString depth (PdfNumber r) = show r toString depth (PdfHex h) = h toString depth (PdfArray a) = intercalate ", " $ map (toString depth) a
src/PDF/Object.hs view
@@ -1,5 +1,16 @@ {-# LANGUAGE OverloadedStrings #-} +{-|+Module : PDF.Object+Description : Function to parse objects in a PDF file+Copyright : (c) Keiichiro Shikano, 2016+License : MIT+Maintainer : k16.shikano@gmail.com++Functions to parsea and show objects in a PDF file. +It provides a basic way to get information from a PDF file.+-}+ module PDF.Object ( parseTrailer , findTrailer@@ -34,12 +45,13 @@ import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BSL import qualified Data.Text as T-import Data.Text.Encoding (decodeUtf16BE)+import Data.Text.Encoding (decodeUtf16BEWith)+import Data.Text.Encoding.Error (lenientDecode) import Numeric (readOct, readHex) import Data.ByteString.Builder (toLazyByteString, word16BE) -import Data.Attoparsec.ByteString hiding (inClass, notInClass, satisfy)-import Data.Attoparsec.ByteString.Char8+import Data.Attoparsec.ByteString hiding (inClass, notInClass, satisfy, take)+import Data.Attoparsec.ByteString.Char8 hiding (take) import Data.Attoparsec.Combinator import Control.Applicative import Codec.Compression.Zlib (decompress)@@ -73,10 +85,11 @@ object <- manyTill anyChar (try $ string "endobj") spaces skipMany xref+ skipMany startxref return $ (read objn, BS.pack object) parsePDFObj :: PDFBS -> PDFObj-parsePDFObj (n,pdfobject) = case parseOnly (spaces >> many1 (pdfobj <|> objother)) pdfobject of+parsePDFObj (n,pdfobject) = case parseOnly (spaces >> many1 (try pdfobj <|> try objother)) pdfobject of Left err -> (n,[PdfNull]) Right obj -> (n,obj) @@ -96,6 +109,15 @@ spaces return "" +startxref :: Parser String+startxref = do+ spaces+ string "startxref"+ spaces+ ref <- manyTill anyChar (try $ string "%%EOF")+ spaces+ return ""+ stream :: Parser PDFStream stream = do string "stream"@@ -149,7 +171,7 @@ octToString [] = "????" octToString [(o,_)] = [chr o] -utf16be = T.unpack . decodeUtf16BE . BS.pack+utf16be = T.unpack . decodeUtf16BEWith lenientDecode . BS.pack pdfstream :: Parser Obj pdfstream = PdfStream <$> stream@@ -303,16 +325,27 @@ rawStreamByRef :: [PDFObj] -> Int -> BSL.ByteString rawStreamByRef objs x = case findObjsByRef x objs of Just objs -> rawStream objs- Nothing -> error "No stream to be shown"+ Nothing -> error "No object with stream to be shown" rawStream :: [Obj] -> BSL.ByteString rawStream objs = case find isStream objs of- Just (PdfStream strm) -> decompress strm- Nothing -> error "No stream to be shown"+ Just (PdfStream strm) -> streamFilter strm+ Nothing -> error $ (show objs) ++ "\n No stream to be shown" where isStream (PdfStream s) = True isStream _ = False + streamFilter = case findDict objs of+ Just d -> case find withFilter d of+ Just (PdfName "/Filter", PdfName "/FlateDecode")+ -> decompress+ Just _ -> id -- need fix+ Nothing -> id+ Nothing -> id+ withFilter (PdfName "/Filter", _) = True+ withFilter _ = False++ parseRefsArray :: [Obj] -> [Int] parseRefsArray (ObjRef x:y) = (x:parseRefsArray y) parseRefsArray (x:y) = (parseRefsArray y)@@ -433,13 +466,13 @@ return $ BS.pack t xref :: Parser BS.ByteString xref = do- manyTill anyChar (try $ string "startxref")- offset <- spaces *> many1 digit+ manyTill anyChar (try $ string "startxref" >> spaces >> lookAhead (oneOf "123456789"))+ offset <- many1 digit return $ BS.drop (read offset :: Int) bs parseCRDict :: BS.ByteString -> Dict parseCRDict rlt = case parseOnly crdict rlt of- Left err -> error $ show rlt+ Left err -> error $ show (BS.take 100 rlt) Right (PdfDict dict) -> dict Right other -> error "Could not find Cross-Reference dictionary" where crdict :: Parser Obj@@ -456,7 +489,7 @@ rootRefFromCRStream :: BS.ByteString -> Maybe Int rootRefFromCRStream bs =- let offset = (read . BS.unpack . head . drop 1 . reverse . BS.lines $ bs) :: Int+ let offset = (read . BS.unpack . head . drop 1 . reverse . BS.lines $ (trace (show bs) bs)) :: Int crstrm = snd . head . getObjs $ BS.drop offset bs crdict = parseCRDict crstrm in getRefs isRootRef $ crdict@@ -508,4 +541,7 @@ in map (\(r,o) -> (r, parseDict $ BS.pack $ drop o objstr)) location where parseDict s' = case parseOnly pdfdictionary s' of Right obj -> [obj]- Left err -> error $ "Failed to parse obj " ++ (show s') ++ (show err)+ Left _ -> case parseOnly pdfarray s' of+ Right obj -> [obj]+ Left err -> error $ (show err) ++ ":\n Failed to parse obj around; \n"+ ++ (show $ BS.take 100 s')
src/PDF/Outlines.hs view
@@ -1,5 +1,15 @@ {-# LANGUAGE OverloadedStrings #-} +{-|+Module : PDF.Outlines+Description : Function to get /Outlines object+Copyright : (c) Keiichiro Shikano, 2016+License : MIT+Maintainer : k16.shikano@gmail.com++Function to grub /Outlines in PDF trailer. It mainly provides texts for Table of Contents.+-}+ module PDF.Outlines ( getOutlines ) where
src/PDF/PDFIO.hs view
@@ -19,6 +19,8 @@ import PDF.Definition import PDF.Object +import Debug.Trace+ import qualified Data.ByteString.Char8 as BS -- | Get PDF objects as a whole bytestring. Use 'getPDFObjFromFile' instead if there's no reason to see a raw bytestring.