hpdft (empty) → 0.1.0.0
raw patch · 11 files changed
+1390/−0 lines, 11 filesdep +basedep +bytestringdep +directorysetup-changed
Dependencies added: base, bytestring, directory, parsec, text, utf8-string, zlib
Files
- LICENSE +20/−0
- README.md +11/−0
- Setup.hs +2/−0
- hpdft.cabal +35/−0
- src/PDF/Character.hs +308/−0
- src/PDF/Cmap.hs +51/−0
- src/PDF/ContentStream.hs +355/−0
- src/PDF/Definition.hs +64/−0
- src/PDF/Object.hs +392/−0
- src/PDF/Outlines.hs +100/−0
- src/PDF/PDFIO.hs +52/−0
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2016 k16.shikano++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,11 @@+Haskell PDF Tools(hpdft)+========================++Tools to poke PDF files using Haskell. +++Example+-------+`Sample.hs` has some functions showing how to use hpdft. ++If you want to customize the character sets and encodings other than the Appendix D of the PDF specification, you could modify `PdfCharDict.hs`. For example, you can use ASCII single quote (`U+0027`) instead of `U+2019` by modifying the entry for `/quoteright`.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hpdft.cabal view
@@ -0,0 +1,35 @@+name: hpdft+version: 0.1.0.0+synopsis: tools to poke pdf using haskell+-- description: +homepage: https://github.com/k16shikano/hpdft+license: MIT+license-file: LICENSE+author: k16.shikano+maintainer: k16.shikano@gmail.com+-- copyright: +category: Text+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10++library+ hs-source-dirs: src/+ exposed-modules: PDF.PDFIO+ , PDF.ContentStream+ , PDF.Character+ , PDF.Cmap+ , PDF.Definition+ , PDF.Outlines+ , PDF.Object+ -- other-modules: + other-extensions: OverloadedStrings+ build-depends: base >=4.6 && <5+ , bytestring >=0.10 && <0.11+ , text >=0.11+ , parsec >=3.1 && <3.2+ , zlib >=0.5+ , utf8-string >=0.3+ , directory >=1.2 && <1.3+ -- hs-source-dirs: + default-language: Haskell2010
+ src/PDF/Character.hs view
@@ -0,0 +1,308 @@+{-# LANGUAGE OverloadedStrings #-} +module PDF.Character + (pdfchardict) where + +import qualified Data.Text as T + +pdfchardict :: [(String, T.Text)] +pdfchardict = + [ ("/A","A") + , ("/AE","Æ") + , ("/Aacute","Á") + , ("/Acircumflex","Â") + , ("/Adieresis","Ä") + , ("/Aring","Å") + , ("/Atilde","Ã") + , ("/B","B") + , ("/C","C") + , ("/Ccedilla","Ç") + , ("/D","D") + , ("/E","E") + , ("/Eacute","É") + , ("/Ecircumflex","Ê") + , ("/Edieresis","Ë") + , ("/Egrave","È") + , ("/Eth","Ð") + , ("/Euro","€") + , ("/F","F") + , ("/G","G") + , ("/H","H") + , ("/I","I") + , ("/Iacute","Í") + , ("/Icircumflex","Î") + , ("/Idieresis","Ï") + , ("/Igrave","Ì") + , ("/J","J") + , ("/K","K") + , ("/L","L") + , ("/Lslash","Ł") + , ("/M","M") + , ("/N","N") + , ("/Ntilde","Ñ") + , ("/O","O") + , ("/OE","OE") + , ("/Oacute","Ó") + , ("/Ocircumflex","Ô") + , ("/Odieresis","Ö") + , ("/Ograve","Ò") + , ("/Oslash","Ø") + , ("/Otilde","Õ") + , ("/P","P") + , ("/Q","Q") + , ("/R","R") + , ("/S","S") + , ("/Scaron","Š") + , ("/T","T") + , ("/Thorn","Þ") + , ("/U","U") + , ("/Uacute","Ú") + , ("/Ucircumflex","Û") + , ("/Udieresis","Ü") + , ("/Ugrave","Ù") + , ("/V","V") + , ("/W","W") + , ("/X","X") + , ("/Y","Y") + , ("/Yacute","Ý") + , ("/Ydieresis","Ÿ") + , ("/Z","Z") + , ("/Zcaron","Ž") + , ("/a","a") + , ("/aacute","á") + , ("/acircumflex","â") + , ("/acute","´") + , ("/adieresis","ä") + , ("/ae","æ") + , ("/agrave","à") + , ("/ampersand","&") + , ("/aring","å") + , ("/asciicircum","^") + , ("/asciitilde","~") + , ("/asterisk","*") + , ("/at","@") + , ("/atilde ","ã") + , ("/b","b") + , ("/backslash","\\") + , ("/bar","|") + , ("/braceleft","{") + , ("/braceright","}") + , ("/bracketleft","[") + , ("/bracketright","]") + , ("/breve","˘") + , ("/brokenbar","¦") + , ("/bullet","•") + , ("/c","c") + , ("/caron","ˇ") + , ("/ccedilla ","ç") + , ("/cedilla","¸") + , ("/cent","¢") + , ("/circumflex","ˆ") + , ("/colon",":") + , ("/comma",",") + , ("/copyright","©") + , ("/circlecopyrt","©") + , ("/currency","¤") + , ("/d","d") + , ("/dagger","†") + , ("/daggerdb","‡") + , ("/degree","°") + , ("/dieresis","¨") + , ("/divide","÷") + , ("/dollar","$") + , ("/dotaccent","˙") + , ("/dotlessi","ı") + , ("/e","e") + , ("/eacute","é") + , ("/ecircumflex","ê") + , ("/edieresis","ë") + , ("/egrave","è") + , ("/eight","8") + , ("/ellipsis","…") + , ("/emdash","—") + , ("/endash","–") + , ("/equal","=") + , ("/eth","ð") + , ("/exclam","!") + , ("/exclamdown","¡") + , ("/f","f") + , ("/ff","ff") + , ("/ffi","ffi") + , ("/ffl","ffl") + , ("/fi","fi") + , ("/five","5") + , ("/fl","fl") + , ("/florin","ƒ") + , ("/four","4") + , ("/fraction","⁄") + , ("/g","g") + , ("/germandbls","ß") + , ("/grave","`") + , ("/greater",">") + , ("/guillemotleft","«") + , ("/guillemotright","»") + , ("/guilsinglleft","‹") + , ("/guilsinglright","›") + , ("/h","h") + , ("/hungarumlaut","˝") + , ("/hyphen","-") + , ("/i","i") + , ("/iacute","í") + , ("/icircumflex","î") + , ("/idieresis","ï") + , ("/igrave","ì") + , ("/j","j") + , ("/k","k") + , ("/l","l") + , ("/less","<") + , ("/logicalnot","¬") + , ("/lslash","ł") + , ("/m","m") + , ("/macron","¯") + , ("/minus","−") + , ("/mu","μ") + , ("/multiply","×") + , ("/n","n") + , ("/nine","9") + , ("/ntilde","ñ") + , ("/numbersign","#") + , ("/o","o") + , ("/oacute","ó") + , ("/ocircumflex","ô") + , ("/odieresis","ö") + , ("/oe","oe") + , ("/ogonek","˛") + , ("/ograve","ò") + , ("/one","1") + , ("/onehalf","½") + , ("/onequarter","¼") + , ("/onesuperior","¹") + , ("/ordfeminine","ª") + , ("/ordmasculine","º") + , ("/oslash","ø") + , ("/otilde","õ") + , ("/p","p") + , ("/paragraph","¶") + , ("/parenleft","(") + , ("/parenright",")") + , ("/percent","%") + , ("/period",".") + , ("/periodcentered","·") + , ("/perthousand","‰") + , ("/plus","+") + , ("/plusminus ","±") + , ("/q","q") + , ("/question","?") + , ("/questiondown","¿") + , ("/quotedbl","\"") + , ("/quotedblbase","„") + , ("/quotedblleft","“") + , ("/quotedblright","”") + , ("/quoteleft","‘") + , ("/quoteright","’") + , ("/quotesinglbase","‚") + , ("/quotesingle","'") + , ("/r","r") + , ("/registered","®") + , ("/ring","˚") + , ("/s","s") + , ("/scaron","š") + , ("/section","§") + , ("/semicolon",";") + , ("/seven","7") + , ("/six","6") + , ("/slash","/") + , ("/space"," ") + , ("/sterling","£") + , ("/t","t") + , ("/thorn","þ") + , ("/three","3") + , ("/threequarters","¾") + , ("/threesuperior","³") + , ("/tilde","˜") + , ("/trademark","™") + , ("/two","2") + , ("/twosuperior","²") + , ("/u","u") + , ("/uacute","ú") + , ("/ucircumflex","û") + , ("/udieresis","ü") + , ("/ugrave","ù") + , ("/underscore","_") + , ("/v","v") + , ("/w","w") + , ("/x","x") + , ("/y","y") + , ("/yacute","ý") + , ("/ydieresis","ÿ") + , ("/yen","¥") + , ("/z","z") + , ("/zcaron","ž") + , ("/zero","0") + , ("/Alpha","Α") + , ("/Beta","Β") + , ("/Chi","Χ") + , ("/Delta","Δ") + , ("/Epsilon","Ε") + , ("/Eta","Η") + , ("/Euro","€") + , ("/Gamma","Γ") + , ("/Iota","Ι") + , ("/Kappa","Κ") + , ("/Lambda","Λ") + , ("/Mu","Μ") + , ("/Nu","Ν") + , ("/Omega","Ω") + , ("/Omicron","Ο") + , ("/Phi","Φ") + , ("/Pi","Π") + , ("/Psi","Ψ") + , ("/Rho","Ρ") + , ("/Sigma","Σ") + , ("/Tau","Τ") + , ("/Theta","Θ") + , ("/Upsilon","Υ") + , ("/Xi","Ξ") + , ("/Zeta","Ζ") + , ("/aleph","ℵ") + , ("/alpha","α") + , ("/ampersand","&") + , ("/angle","∠") + , ("/angleleft","〈") + , ("/angleright","〉") + , ("/approxequal","≈") + , ("/arrowdblboth","⇔") + , ("/arrowdblleft","⇒") + , ("/asteriskmath","*") + , ("/bar","|") + , ("/beta","β") + , ("/braceleft","{") + , ("/braceright","}") + , ("/chi","χ") + , ("/delta","δ") + , ("/epsilon","ε") + , ("/eta","η") + , ("/gamma","γ") + , ("/iota","ι") + , ("/kappa","κ") + , ("/lambda","λ") + , ("/mu","μ") + , ("/nu","ν") + , ("/omega","ω") + , ("/omicron","ο") + , ("/phi","φ") + , ("/pi","π") + , ("/psi","ψ") + , ("/rho","ρ") + , ("/sigma","σ") + , ("/tau","τ") + , ("/theta","θ") + , ("/upsilon","υ") + , ("/xi","ξ") + , ("/zeta","ζ") + , ("/existential","∃") + , ("/universal","∀") + , ("/partialdiff","∂") + , ("/equal","=") + , ("/infinity","∞") + , ("/integral","∫") + ]
+ src/PDF/Cmap.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE OverloadedStrings #-}++module PDF.Cmap+ ( parseCMap+ ) where++import Data.Char (chr)+import Numeric (readOct, readHex)++import Data.ByteString (ByteString)+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 (encodeUtf8)++import Text.Parsec hiding (many, (<|>))+import Control.Applicative+import Text.Parsec.ByteString.Lazy+import Codec.Compression.Zlib (decompress) ++import Debug.Trace++import PDF.Definition+import PDF.Character (pdfchardict)++parseCMap :: BSL.ByteString -> CMap+parseCMap str = case runParser (concat <$> manyTill cmapParser (try $ string "endcmap")) () "" str of+ Left err -> error "Can not parse CMap"+ Right cmap -> cmap ++cmapParser :: Parser CMap+cmapParser = do+ spaces+ manyTill anyChar (try $ string "beginbfchar")+ spaces+ ms <- many1 (toCmap <$> hexletters <*> hexletters)+ spaces+ string "endbfchar"+ spaces+ return ms+ where toCmap cid ucs = ((fst.head.readHex) cid, ((:[]).chr.fst.head.readHex) ucs)++hexletters :: Parser String+hexletters = do+ char '<'+ lets <- manyTill hexletter (try $ char '>')+ spaces+ return $ concat lets++hexletter :: Parser String+hexletter = (count 4 $ oneOf "0123456789ABCDEFabcdef")
+ src/PDF/ContentStream.hs view
@@ -0,0 +1,355 @@+{-# LANGUAGE OverloadedStrings #-}++module PDF.ContentStream + ( deflate+ , decompressStream+ ) where++import Data.Char (chr)+import Numeric (readOct, readHex)++import Data.ByteString (ByteString)+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 (encodeUtf8)++import Text.Parsec hiding (many, (<|>))+import Control.Applicative+import Text.Parsec.ByteString.Lazy+import Codec.Compression.Zlib (decompress) ++import Debug.Trace++import PDF.Definition+import PDF.Character (pdfchardict)++type PSParser a = GenParser Char PSR a++parseContentStream p st = runParser p st ""++parseDeflated :: PSR -> BSL.ByteString -> PDFStream+parseDeflated psr pdfstream = case parseContentStream (T.concat <$> many (elems <|> skipOther)) psr pdfstream of+ Left err -> error "Nothing to be parsed"+ Right str -> BSL.pack $ BS.unpack $ encodeUtf8 str++deflate :: PSR -> PDFStream -> PDFStream+deflate = parseDeflated++decompressStream :: PDFBS -> PDFStream+decompressStream (n,pdfobject) = + case parse (BSL.pack <$> + (manyTill anyChar (try $ (string "stream" >> oneOf "\n\r")) >> spaces+ *> manyTill anyChar (try $ string "endstream"))) "" pdfobject of+ Left err -> "err"+ Right bs -> decompress bs++elems :: PSParser T.Text+elems = choice [ try pdfopBT + , try pdfopTf+ , try pdfopTD+ , try pdfopTd+ , try pdfopTm+ , try pdfopTc+ , try pdfopTw+ , try pdfopTJ+ , try pdfopTj+ , try pdfopTast+ , try letters <* spaces+ , try hexletters <* spaces+ , try array <* spaces+ , try pdfopGraphics+ , try xObject+ , try graphicState+ , unknowns+ ]++pdfopGraphics :: PSParser T.Text+pdfopGraphics = do+ spaces+ choice [ try $ T.empty <$ oneOf "qQ" <* spaces+ , try $ T.empty <$ oneOf "fFbBW" <* (many $ string "*") <* spaces+ , try $ T.empty <$ oneOf "nsS" <* spaces+ , try $ T.empty <$ (digitParam <* spaces) <* oneOf "gG" <* spaces+ , try $ T.empty <$ (digitParam <* spaces) <* oneOf "jJ" <* spaces+ , try $ T.empty <$ (digitParam <* spaces) <* oneOf "dwi" <* spaces+ , try $ T.empty <$ (many1 (digitParam <* spaces) <* oneOf "ml" <* spaces)+ , try $ T.empty <$ (many1 (digitParam <* spaces) <* string "re" <* spaces)+ , try $ T.empty <$ (many1 (digitParam <* spaces) <* string "rg" <* spaces)+ , try $ T.empty <$ (many1 (digitParam <* spaces) <* string "RG" <* spaces)+ , try $ T.empty <$ (many1 (digitParam <* spaces) <* string "cm" <* spaces)+ , try $ T.empty <$ (many1 (digitParam <* spaces) <* string "c" <* spaces)+ ]+ return T.empty++graphicState :: PSParser T.Text+graphicState = do+ gs <- (++) <$> string "/" <*> manyTill anyChar (try space)+ spaces+ string "gs"+ spaces+ return T.empty++xObject :: PSParser T.Text +xObject = do+ file <- (++) <$> string "/" <*> manyTill anyChar (try space)+ spaces+ string "Do"+ spaces+ return T.empty+ ++pdfopBT :: PSParser T.Text+pdfopBT = do+ string "BT"+ spaces+ t <- manyTill elems (try $ string "ET")+ spaces+ return $ T.concat t++pdfopTj :: PSParser T.Text+pdfopTj = do+ spaces+ t <- manyTill (letters <|> hexletters <|> array) (try $ string "Tj")+ spaces+ return $ T.concat t++pdfopTJ :: PSParser T.Text+pdfopTJ = do+ spaces+ t <- manyTill (letters <|> hexletters <|> array) (try $ string "TJ")+ spaces+ return $ T.concat t+ +unknowns :: PSParser T.Text+unknowns = do + ps <- manyTill anyChar (try $ oneOf "\r\n")+ return ""+ return $ T.pack $ "[[[UNNOKWN STREAM:" ++ take 100 (show ps) ++ "]]]"++skipOther :: PSParser T.Text+skipOther = do+ a <- manyTill anyChar (try $ oneOf "\r\n")+ return $ ""++array :: PSParser T.Text+array = do+ char '['+ str <- (manyTill (letters <|> hexletters <|> kern) (try $ char ']'))+ return $ T.concat str++letters :: PSParser T.Text+letters = do+ char '('+ lets <- manyTill psletter (try $ char ')')+ spaces+ return $ T.concat lets++hexletters :: PSParser T.Text+hexletters = do+ char '<'+ lets <- manyTill hexletter (try $ char '>')+ spaces+ return $ T.concat lets++adobeOneSix :: Int -> T.Text+adobeOneSix a = T.pack (show a)++toUcs :: CMap -> Int -> T.Text+toUcs map h = case lookup h map 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 -> []+ (hexToString cmap . readHex) <$> (count 4 $ oneOf "0123456789ABCDEFabcdef")+ where hexToString map [] = "????"+ hexToString map [(h,_)] = toUcs map h++psletter :: PSParser T.Text+psletter = do+ st <- getState+ let fontmap = case lookup (curfont st) (fontmaps st) of+ Just m -> m+ Nothing -> []+ c <- try (char '\\' >> oneOf "\\()")+ <|>+ try (octToString . readOct <$> (char '\\' >> (count 3 $ oneOf "01234567")))+ <|>+ noneOf "\\"+ return $ replaceWithDiff fontmap c+ where replaceWithDiff m c' = case lookup c' m of+ Just s -> replaceWithCharDict s+ Nothing -> T.pack [c']+ replaceWithCharDict s = case lookup s pdfchardict of+ Just cs -> cs+ Nothing -> T.pack s+ octToString [] = '?'+ octToString [(o,_)] = chr o++kern :: PSParser T.Text+kern = do+ t <- digitParam+ return $ if t < -60.0 then " " else ""++pdfopTf :: PSParser T.Text+pdfopTf = do+ font <- (++) <$> string "/" <*> manyTill anyChar (try space)+ spaces+ t <- digitParam+ spaces+ string "Tf"+ spaces+ st <- getState+ let ff = fontfactor st+ updateState (\s -> s{ curfont = font+ , fontfactor = ff*t})+ return ""++pdfopTD :: PSParser T.Text+pdfopTD = do+ t1 <- digitParam+ spaces+ t2 <- digitParam+ spaces+ string "TD"+ spaces+ st <- getState+ let ax = absolutex st+ ay = absolutey st+ lx = linex st+ ly = liney st+ lm = leftmargin st+ ff = fontfactor st+ needBreak = abs t2 > 0 && abs (ly - t2) > 0+ updateState (\s -> s { absolutex = ax + t1+ , absolutey = ay + (if needBreak then 2*t2 else 0)+ , linex = if abs t1 > 0 then t1 else lx+ , liney = if abs t2 > 0 then 2*t2 else ly+ })+ return $ if needBreak + then T.concat ["\n", (desideParagraphBreak t1 t2 lx ly lm ff)] + else ""++pdfopTd :: PSParser T.Text+pdfopTd = do+ t1 <- digitParam+ spaces+ t2 <- digitParam+ spaces+ string "Td"+ spaces+ st <- getState+ let ax = absolutex st+ ay = absolutey st+ lx = linex st+ ly = liney st+ lm = leftmargin st+ ff = fontfactor st+ needBreak = abs t2 > 0 && abs (ly - t2) > 0+ updateState (\s -> s { absolutex = ax + t1+ , absolutey = ay + (if needBreak then t2 else 0)+ , linex = if abs t1 > 0 then t1 else lx+ , liney = if abs t2 > 0 then t2 else ly+ })+ return $ if needBreak + then T.concat ["\n", (desideParagraphBreak t1 t2 lx ly lm ff)] + else ""++pdfopTw :: PSParser T.Text+pdfopTw = do+ tw <- digitParam+ spaces+ string "Tw"+ spaces+ st <- getState+ let ff = fontfactor st+ updateState (\s -> s { fontfactor = ff+ })+ return $ ""++pdfopTc :: PSParser T.Text+pdfopTc = do+ tc <- digitParam+ spaces+ string "Tc"+ spaces+ st <- getState+ let ff = fontfactor st+ updateState (\s -> s { fontfactor = ff+ })+ return $ ""++desideParagraphBreak :: Double -> Double -> Double -> Double -> Double -> Double + -> T.Text+desideParagraphBreak t1 t2 lx ly lm ff = T.pack $+ (if abs ly > abs ff || abs t2 > abs ff || (t1 - lm) > 0.5+ then "\n"+ else "")++pdfopTm :: PSParser T.Text+pdfopTm = do+ a <- digitParam+ spaces+ b <- digitParam+ spaces+ c <- digitParam+ spaces+ d <- digitParam+ spaces+ e <- digitParam+ spaces+ f <- digitParam+ spaces+ string "Tm"+ spaces+ st <- getState+ let ax = absolutex st+ ay = absolutey st+ lx = linex st+ ly = liney st+ lm = leftmargin st+ ff = fontfactor st+ needBreak = abs d*f > 0 && ly >= 0+ updateState (\s -> s { linex = lx+ , liney = ly+ , absolutex = a*e+ , absolutey = d*f+ , fontfactor = a*e*d*f*ff+ })+ return $ if needBreak + then T.concat ["\n", desideParagraphBreak (d*f) (d*f) lx ly lm ff]+ else if a*e > lx then " " else ""++pdfopTast :: PSParser T.Text+pdfopTast = do+ string "T*"+ st <- getState+ let ax = absolutex st+ ay = absolutey st+ lx = linex st+ ly = liney st+ updateState (\s -> s { linex = lx+ , liney = ly+ , absolutex = ax+ , absolutey = ay+ })+ return "\n"++digitParam :: PSParser Double+digitParam = do + sign <- many $ char '-'+ num <- ((++) <$> (("0"++) <$> (string ".")) <*> many1 digit)+ <|>+ ((++) <$> (many1 digit) <*> ((++) <$> (many $ char '.') <*> many digit))+ return $ read $ sign ++ num++hexParam :: Parser T.Text+hexParam = do+ char '<'+ lets <- manyTill (oneOf "0123456789abcdefABCDEF") (try $ char '>')+ return $ T.pack lets
+ src/PDF/Definition.hs view
@@ -0,0 +1,64 @@+module PDF.Definition where++import Data.ByteString (ByteString)+import Data.List (replicate, intercalate)+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy.Char8 as BSL++type PDFBS = (Int,BS.ByteString)++type PDFObj = (Int,[Obj])++type PDFStream = BSL.ByteString++type PDFxref = BSL.ByteString++data Obj = PdfDict Dict -- [(Obj, Obj)]+ | PdfText String + | PdfStream PDFStream+ | PdfNumber Double + | PdfHex String+ | PdfBool Bool+ | PdfArray [Obj]+ | PdfName String + | ObjRef Int+ | ObjOther String+ | PdfNull+ deriving (Eq)++type Dict = [(Obj,Obj)]++instance Show Obj where+ show o = toString 0 o+ +toString depth (PdfDict d) = concat $ map dictentry d+ where dictentry (PdfName n, o) = concat $ ["\n"] ++ replicate depth " " ++ [n, ": ", toString (depth+1) o]+ dictentry e = error $ "Illegular dictionary entry "++show e +toString depth (PdfText t) = t +toString depth (PdfNumber r) = show r+toString depth (PdfHex h) = h+toString depth (PdfArray a) = intercalate ", " $ map (toString depth) a+toString depth (PdfBool b) = show b+toString depth (PdfName n) = n+toString depth (ObjRef i) = show i+toString depth (ObjOther o) = o+toString depth (PdfNull) = ""+++type FontMap = [(Char,String)]++type CMap = [(Int,String)]++data PSR = PSR { linex :: Double+ , liney :: Double+ , absolutex :: Double+ , absolutey :: Double+ , leftmargin :: Double+ , top :: Double+ , bottom :: Double+ , fontfactor :: Double+ , curfont :: String+ , cmaps :: [(String, CMap)]+ , fontmaps :: [(String, FontMap)]}+ deriving (Show)+
+ src/PDF/Object.hs view
@@ -0,0 +1,392 @@+{-# LANGUAGE OverloadedStrings #-}++module PDF.Object+ ( parseTrailer+ , rootRef+ , contentsStream+ , rawContentsStream+ , rawStreamByRef+ , rawStream+ , toUnicode+ , pagesKids + , pages+ , findDict+ , findDictOfType+ , findObjThroughDict+ , findObjThroughDictByRef+ , findObjsByRef+ , parsePDFObj+ , parseRefsArray+ , getObjs + , pdfObj+ , getRefs+ , getXref+ , expandObjStm+ ) where++import Data.Char (chr)+import Data.List (find)+import Data.ByteString.UTF8 (ByteString)+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy.Char8 as BSL++import Text.Parsec hiding (many, (<|>))+import Control.Applicative+import Text.Parsec.ByteString+import Codec.Compression.Zlib (decompress)++import Debug.Trace++import PDF.Definition+import PDF.ContentStream+import PDF.Cmap+++-- parse pdf objects++getObjs :: BS.ByteString -> [PDFBS]+getObjs contents = case parse (many1 pdfObj) "" contents of+ Left err -> []+ Right rlt -> rlt++getXref :: BS.ByteString -> String+getXref contents = case parse (xref) "" contents of+ Left err -> []+ Right rlt -> rlt++pdfObj :: Parser PDFBS+pdfObj = do+ skipMany (comment <|> oneOf "\r\n")+ objn <- many1 digit <* (spaces >> oneOf "0123456789" >> string " obj")+ object <- manyTill anyChar (try $ string "endobj")+ spaces+ skipMany xref+ return $ (read objn, BS.pack object)++parsePDFObj :: PDFBS -> PDFObj+parsePDFObj (n,pdfobject) = case parse (spaces >> many1 (pdfobj <|> objother)) "" pdfobject of+ Left err -> (n,[PdfNull])+ Right obj -> (n,obj)++comment :: Parser Char+comment = do+ char '%'+ noneOf "%"+ manyTill anyChar $ oneOf "\r\n"+ return ' '++xref :: Parser String+xref = do+ spaces+ string "xref"+ spaces+ ref <- manyTill anyChar (try $ string "%%EOF")+ spaces+ return ""++stream :: Parser PDFStream+stream = do+ string "stream"+ spaces+ stm <- BSL.pack <$> manyTill anyChar (try $ string "endstream")+ return stm++pdfdictionary :: Parser Obj+pdfdictionary = PdfDict <$> (string "<<" >> spaces *> manyTill dictEntry (try $ spaces >> string ">>"))++dictEntry :: Parser (Obj, Obj)+dictEntry = (,) <$> pdfname <*> pdfobj++pdfarray :: Parser Obj+pdfarray = PdfArray <$> (string "[" >> spaces *> manyTill pdfobj (try $ spaces >> string "]"))++pdfname :: Parser Obj+pdfname = PdfName <$> ((++) <$> string "/" <*> manyTill anyChar (try $ lookAhead $ oneOf "><][)( \n\r/")) <* spaces++pdfletters :: Parser Obj+pdfletters = PdfText <$> (char '(' *> manyTill pdfletter (try $ char ')'))+ where pdfletter = (char '\\' >> oneOf "\\()") <|> noneOf "\\"++pdfstream :: Parser Obj+pdfstream = PdfStream <$> stream++pdfnumber :: Parser Obj+pdfnumber = PdfNumber <$> pdfdigit+ where pdfdigit = do + sign <- many $ char '-'+ num <- ((++) <$> (("0"++) <$> string ".") <*> many1 digit)+ <|>+ ((++) <$> (many1 digit) <*> ((++) <$> (many $ char '.') <*> many digit))+ spaces + return $ read $ sign ++ num++pdfhex :: Parser Obj+pdfhex = PdfHex <$> hex + where hex = do+ char '<'+ lets <- manyTill (oneOf "0123456789abcdefABCDEF") (try $ char '>')+ return $ lets++pdfbool :: Parser Obj+pdfbool = PdfBool <$> (True <$ string "true"+ <|> + False <$ string "false")++pdfnull :: Parser Obj+pdfnull = PdfNull <$ string "null"++pdfobj :: Parser Obj+pdfobj = choice [ try rrefs <* spaces+ , try pdfname <* spaces, try pdfnumber <* spaces, try pdfhex <* spaces+ , try pdfbool <* spaces, try pdfnull <* spaces+ , try pdfarray <* spaces, try pdfdictionary <* spaces, try pdfstream <* spaces+ , pdfletters <* spaces]++rrefs :: Parser Obj+rrefs = do + objnum <- many1 digit+ spaces+ oneOf "0123456789"+ string " R"+ spaces+ return $ ObjRef (read objnum)++objother :: Parser Obj+objother = ObjOther <$> (manyTill anyChar space)+++-- find objects++findObjsByRef :: Int -> [PDFObj] -> Maybe [Obj]+findObjsByRef x pdfobjs = case find (isRefObj (Just x)) pdfobjs of+ Just (_,objs) -> Just objs+ Nothing -> Nothing+ where+ isRefObj (Just x) (y, objs) = if x==y then True else False+ isRefObj _ _ = False++findObjThroughDictByRef :: Int -> String -> [PDFObj] -> Maybe Obj+findObjThroughDictByRef ref name objs = case findDictByRef ref objs of + Just d -> findObjThroughDict d name+ Nothing -> Nothing+ +findObjThroughDict :: Dict -> String -> Maybe Obj+findObjThroughDict d name = case find isName d of+ Just (_, o) -> Just o+ otherwise -> Nothing+ where isName (PdfName n, _) = if name == n then True else False+ isName _ = False++findDictByRef :: Int -> [PDFObj] -> Maybe Dict+findDictByRef ref objs = case findObjsByRef ref objs of+ Just os -> findDict os+ Nothing -> Nothing++findDictOfType :: String -> [Obj] -> Maybe Dict+findDictOfType typename objs = case findDict objs of+ Just d -> if isType d then Just d else Nothing + Nothing -> Nothing+ where + isType dict = (PdfName "/Type",PdfName typename) `elem` dict+ +findDict :: [Obj] -> Maybe Dict+findDict objs = case find isDict objs of+ Just (PdfDict d) -> Just d+ otherwise -> Nothing+ where + isDict :: Obj -> Bool+ isDict (PdfDict d) = True+ isDict _ = False++pages :: Dict -> Maybe Int+pages dict = case find isPagesRef dict of+ Just (_, ObjRef x) -> Just x+ Nothing -> Nothing+ where+ isPagesRef (PdfName "/Pages", ObjRef x) = True+ isPagesRef (_,_) = False+ +pagesKids :: Dict -> Maybe [Int]+pagesKids dict = case find isKidsRefs dict of+ Just (_, PdfArray arr) -> Just (parseRefsArray arr)+ Nothing -> Nothing+ where + isKidsRefs (PdfName "/Kids", PdfArray x) = True+ isKidsRefs (_,_) = False++contentsStream :: Dict -> PSR -> [PDFObj] -> PDFStream+contentsStream dict st objs = case find contents dict of+ Just (PdfName "/Contents", PdfArray arr) -> BSL.concat $ map (parsedContentStreamByRef dict st objs) (parseRefsArray arr)+ Just (PdfName "/Contents", ObjRef x) -> parsedContentStreamByRef dict st objs x+ Nothing -> error "No content to be shown"+ where+ contents (PdfName "/Contents", _) = True+ contents _ = False++rawContentsStream :: Dict -> [PDFObj] -> PDFStream+rawContentsStream dict objs = case find contents dict of+ Just (PdfName "/Contents", PdfArray arr) -> BSL.concat $ map (rawStreamByRef objs) (parseRefsArray arr)+ Just (PdfName "/Contents", ObjRef x) -> rawStreamByRef objs x+ Nothing -> error "No content to be shown"+ where+ contents (PdfName "/Contents", _) = True+ contents _ = False++parsedContentStreamByRef :: Dict -> PSR -> [PDFObj] -> Int -> PDFStream+parsedContentStreamByRef dict st objs ref = deflate (st {fontmaps=fontdict, cmaps=cmap}) $ rawStreamByRef objs ref+ where fontdict = findFontMap dict objs+ cmap = findCMap dict objs++rawStreamByRef :: [PDFObj] -> Int -> BSL.ByteString+rawStreamByRef objs x = case findObjsByRef x objs of+ Just objs -> rawStream objs+ Nothing -> error "No 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"+ where+ isStream (PdfStream s) = True+ isStream _ = False++parseRefsArray :: [Obj] -> [Int]+parseRefsArray (ObjRef x:y) = (x:parseRefsArray y)+parseRefsArray (x:y) = (parseRefsArray y)+parseRefsArray [] = []+++-- make fontmap from page's /Resources (see 3.7.2 of PDF Ref.)++findFontMap d os = encoding (getFontObjs d os) os++encoding :: Dict -> [PDFObj] -> [(String, FontMap)]+encoding dict objs = map pairwise dict+ where + pairwise (PdfName n, ObjRef r) = (n, fontMap r objs)+ pairwise x = ("",[])++findResourcesDict :: Dict -> [PDFObj] -> Maybe Dict+findResourcesDict dict objs = case find resources dict of+ Just (_, ObjRef x) -> findDictByRef x objs+ Just (_, PdfDict d) -> Just d+ otherwise -> error (show dict)+ where+ resources (PdfName "/Resources", _) = True+ resources _ = False++getFontObjs :: Dict -> [PDFObj] -> Dict+getFontObjs dict objs = case findResourcesDict dict objs of+ Just d -> case findObjThroughDict d "/Font" of+ Just (PdfDict d) -> d+ otherwise -> []+ Nothing -> []+++-- Needs rewrite!+fontMap :: Int -> [PDFObj] -> FontMap+fontMap x objs = case findObjThroughDictByRef x "/Encoding" objs of+ Just (ObjRef ref) -> case findObjThroughDictByRef ref "/Differences" objs of+ Just (PdfArray arr) -> charMap arr+ otherwise -> []+ Just (PdfName "/StandardEncoding") -> (trace "standard enc." [])+ Just (PdfName "/MacRomanEncoding") -> (trace "mac roman enc." [])+ Just (PdfName "/MacExpertEncoding") -> (trace "mac expert enc." [])+ Just (PdfName "/WinAnsiEncoding") -> (trace "win ansi enc." [])+ otherwise -> case findObjThroughDictByRef x "/FontDescriptor" objs of+ Just (ObjRef ref) -> case findObjThroughDictByRef ref "/CharSet" objs of+ Just (PdfText str) -> []+ otherwise -> []+ otherwise -> []++charMap :: [Obj] -> FontMap+charMap objs = fontmap objs 0+ where fontmap (PdfNumber x : PdfName n : xs) i = + if i < truncate x then + (chr $ truncate x, n) : (fontmap xs $ incr x)+ else + (chr $ i, n) : (fontmap xs $ i+1)+ fontmap (PdfName n : xs) i = (chr i, n) : (fontmap xs $ i+1)+ fontmap [] i = []+ incr x = (truncate x) + 1++findCMap d os = cMap (getFontObjs d os) os++cMap :: Dict -> [PDFObj] -> [(String, CMap)]+cMap dict objs = map pairwise dict+ where+ pairwise (PdfName n, ObjRef r) = (n, toUnicode r objs)+ pairwise x = ("", [])++toUnicode :: Int -> [PDFObj] -> CMap+toUnicode x objs = case findObjThroughDictByRef x "/Encoding" objs of+ Just (PdfName "/Identity-H") -> case findObjThroughDictByRef x "/ToUnicode" objs of+ Just (ObjRef ref) -> (parseCMap $ rawStreamByRef objs ref)+ otherwise -> []+ otherwise -> []+++-- find root ref from Trailer or Cross-Reference Dictionary++parseTrailer :: BS.ByteString -> Maybe Dict+parseTrailer bs = case parse trailer "" bs of+ Left err -> Nothing+ Right rlt -> Just (parseCRDict rlt)+ where trailer :: Parser BS.ByteString+ trailer = do+ manyTill anyChar (try $ string "trailer")+ t <- manyTill anyChar (try $ string "startxref")+ return $ BS.pack t++parseCRDict :: BS.ByteString -> Dict+parseCRDict rlt = case parse (spaces >> pdfdictionary <* spaces) "" rlt of+ Left err -> error $ show err+ Right (PdfDict dict) -> dict+ Right other -> error "Could not find Cross-Reference dictionary"++rootRef :: BS.ByteString -> Maybe Int+rootRef bs = case parseTrailer bs of+ Just dict -> getRefs isRootRef dict+ Nothing -> rootRefFromCRStream bs++rootRefFromCRStream :: BS.ByteString -> Maybe Int+rootRefFromCRStream bs =+ let offset = (read . BS.unpack . head . drop 1 . reverse . BS.lines $ bs) :: Int+ crstrm = snd . head . getObjs $ BS.drop offset bs+ crdict = parseCRDict crstrm+ in getRefs isRootRef $ crdict++isRootRef (PdfName "/Root", ObjRef x) = True+isRootRef (_,_) = False++getRefs :: ((Obj,Obj) -> Bool) -> Dict -> Maybe Int+getRefs pred dict = case find pred dict of+ Just (_, ObjRef x) -> Just x+ Nothing -> Nothing+++-- expand PDF 1.5 Object Stream ++expandObjStm :: [PDFObj] -> [PDFObj]+expandObjStm os = concat $ map objStm os++objStm :: PDFObj -> [PDFObj]+objStm (n, obj) = case findDictOfType "/ObjStm" obj of+ Nothing -> [(n,obj)]+ Just _ -> getPdfObjStm n $ BS.pack $ BSL.unpack $ rawStream obj+ +refOffset :: Parser ([(Int, Int)], String)+refOffset = spaces *> ((,) + <$> many1 ((\r o -> (read r :: Int, read o :: Int)) + <$> (many1 digit <* spaces) + <*> (many1 digit <* spaces))+ <*> (manyTill anyChar (lookAhead $ string "<<") *> many1 anyChar))++getPdfObjStm n s = + let (location, objstr) = case parse refOffset "" s of+ Right val -> val+ Left err -> error $ "Failed to parse Object Stream: "+ in map (\(r,o) -> (r, parseDict $ BS.pack $ drop o objstr)) location+ where parseDict s' = case parse pdfdictionary "" s' of+ Right obj -> [obj]+ Left err -> error "Failed to parse obj"
+ src/PDF/Outlines.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE OverloadedStrings #-}++module PDF.Outlines+ ( getOutlines+ ) where++import Debug.Trace++import Data.List (find)+import PDF.Definition+import PDF.Object+import PDF.PDFIO++data PDFOutlines = PDFOutlinesTree [PDFOutlines]+ | PDFOutlinesEntry { dest :: Int+ , text :: String+ , subs :: PDFOutlines+ }+ | PDFOutlinesNE+ deriving (Show)++getOutlines filename = do+ dict <- outlineObjFromFile filename+ objs <- getPDFObjFromFile filename + firstref <- case findFirst dict of+ Just r -> return r+ Nothing -> error "No top level outline entry."+ firstdict <- case findObjsByRef firstref objs of+ Just [PdfDict d] -> return $ d+ Nothing -> error $ "No Object with Ref " ++ show firstref+ showOutlines 0 $ gatherOutlines firstdict objs++gatherChildren dict objs = case findFirst dict of+ Just r -> case findObjsByRef r objs of+ Just [PdfDict d] -> gatherOutlines d objs+ Nothing -> error $ "No Object with Ref " ++ show r+ Nothing -> PDFOutlinesNE++gatherOutlines dict objs =+ let c = gatherChildren dict objs+ in case findNext dict of + Just r -> case findObjsByRef r objs of+ Just [PdfDict d] -> PDFOutlinesTree (PDFOutlinesEntry { dest = head $ findDest dict+ , text = findTitle dict objs+ , subs = c}+ : [gatherOutlines d objs])+ Nothing -> error $ "No Object with Ref " ++ show r+ Nothing -> PDFOutlinesEntry { dest = head $ findDest dict+ , text = findTitle dict objs+ , subs = PDFOutlinesNE}++showOutlines :: Int -> PDFOutlines -> IO ()+showOutlines depth (PDFOutlinesEntry {dest=d, text=t, subs=s}) = putStrLn (replicate depth ' ' ++ t) >> showOutlines (depth+1) s+showOutlines depth (PDFOutlinesTree os) = mapM_ (showOutlines (depth)) os+showOutlines depth PDFOutlinesNE = putStr ""++outlines :: Dict -> Int+outlines dict = case find isOutlinesRef dict of+ Just (_, ObjRef x) -> x+ Nothing -> error "There seems no /Outlines in the root"+ where+ isOutlinesRef (PdfName "/Outlines", ObjRef x) = True+ isOutlinesRef (_,_) = False++outlineObjFromFile :: String -> IO Dict+outlineObjFromFile filename = do+ objs <- getPDFObjFromFile filename+ rootref <- getRootRef filename+ rootobj <- case findObjsByRef rootref objs of+ Just os -> return os+ Nothing -> error "Could not get root object."+ outlineref <- case findDict rootobj of+ Just dict -> return $ outlines dict+ Nothing -> error "Something wrong..."+ case findObjsByRef outlineref objs of+ Just [PdfDict d] -> return d+ Nothing -> error "Could not get outlines object"++findTitle dict objs = + case findObjThroughDict dict "/Title" of+ Just (PdfText s) -> s+ Just (ObjRef r) -> case findObjsByRef r objs of+ Just [PdfText s] -> s+ Nothing -> error $ "No title object in "++(show r)+ Nothing -> error "No title object."++findDest dict = + case findObjThroughDict dict "/Dest" of+ Just (PdfArray a) -> parseRefsArray a+ Nothing -> error "No destination object."++findNext dict = + case findObjThroughDict dict "/Next" of+ Just (ObjRef x) -> Just x+ Nothing -> Nothing++findFirst dict =+ case findObjThroughDict dict "/First" of+ Just (ObjRef x) -> Just x+ Nothing -> Nothing
+ src/PDF/PDFIO.hs view
@@ -0,0 +1,52 @@+module PDF.PDFIO ( getObjectByRef+ , getPDFBSFromFile+ , getPDFObjFromFile+ , getRootRef+ , getRootObj+ ) where++import PDF.Definition+import PDF.Object++import qualified Data.ByteString.Char8 as BS+++-- IO utilities++getPDFBSFromFile :: String -> IO [PDFBS]+getPDFBSFromFile f = do+ c <- BS.readFile f+ let bs = getObjs c+ return bs++getPDFObjFromFile :: String -> IO [PDFObj]+getPDFObjFromFile f = do+ c <- BS.readFile f+ let obj = expandObjStm $ map parsePDFObj $ getObjs c+ return obj++getObjectByRef :: Int -> IO [PDFObj] -> IO [Obj]+getObjectByRef ref pdfobjs = do+ objs <- pdfobjs+ case findObjsByRef ref objs of+ Just os -> return $ os+ Nothing -> error $ "No Object with Ref " ++ show ref++getRootRefFromFile :: String -> IO (Maybe Int)+getRootRefFromFile f = do+ c <- BS.readFile f+ return $ rootRef c++getRootRef filename = do+ c <- BS.readFile filename+ let n = rootRef c+ case n of+ Just i -> return i+ Nothing -> error "Could not find rood object"+ +getRootObj filename = do+ rootref <- getRootRef filename+ objs <- getPDFObjFromFile filename+ case findObjsByRef rootref objs of+ Just os -> return os+ Nothing -> error "Could not get root object"