diff --git a/epub-metadata.cabal b/epub-metadata.cabal --- a/epub-metadata.cabal +++ b/epub-metadata.cabal @@ -1,5 +1,5 @@ name: epub-metadata -version: 2.1.0 +version: 2.2.0.0 cabal-version: >= 1.2 build-type: Simple license: BSD3 @@ -7,20 +7,16 @@ copyright: 2010, 2011 Dino Morelli author: Dino Morelli maintainer: Dino Morelli -stability: experimental +stability: stable homepage: http://ui3.info/d/proj/epub-metadata.html -synopsis: Library and utility for parsing and manipulating ePub OPF package data -description: Library and utility for parsing and manipulating ePub - OPF package data. An attempt has been made here to - very thoroughly implement the OPF Package Document - specification. Also included is a command-line - utility to dump OPF package data to stdout in a - human-readable form. +synopsis: Library for parsing and manipulating ePub files and OPF package data +description: Library for parsing and manipulating ePub files and OPF package data. An attempt has been made here to very thoroughly implement the OPF Package Document specification. category: Codec, Text tested-with: GHC >= 6.12.3 library - exposed-modules: Codec.Epub.IO, + exposed-modules: Codec.Epub.Archive + Codec.Epub.IO, Codec.Epub.Opf.Common, Codec.Epub.Opf.Format.Guide, Codec.Epub.Opf.Format.Manifest, @@ -36,11 +32,6 @@ Codec.Epub.Opf.Parse hs-source-dirs: src build-depends: base >= 3 && < 5, bytestring, containers, - hxt >= 9, mtl, regex-compat, zip-archive - ghc-options: -Wall - -executable epubmeta - main-is: Codec/Epub/Opf/Cli/epubmeta.hs - hs-source-dirs: src - build-depends: base >= 3 && < 5 + directory, filepath, hxt >= 9, mtl, regex-compat, + zip-archive ghc-options: -Wall diff --git a/src/Codec/Epub/Archive.hs b/src/Codec/Epub/Archive.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Epub/Archive.hs @@ -0,0 +1,58 @@ +-- Copyright: 2011 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +module Codec.Epub.Archive + ( mkEpubArchive + , readArchive + , writeArchive + ) + where + +import Codec.Archive.Zip +import Control.Monad +import qualified Data.ByteString.Lazy as B +import Data.List +import System.Directory +import System.FilePath + + +{- Recursively get a list of all files starting with the supplied + parent directory. Excluding the directories themselves and ANY + dotfiles. +-} +getRecursiveContents :: FilePath -> IO [FilePath] +getRecursiveContents parent = do + fullContents <- getDirectoryContents parent + let contents = filter (not . isPrefixOf ".") fullContents + paths <- forM contents $ \name -> do + let path = parent name + isDirectory <- doesDirectoryExist path + if isDirectory + then getRecursiveContents path + else return [path] + return $ concat paths + + +{- | Construct a zip Archive containing epub book data from the + specified directory +-} +mkEpubArchive :: FilePath -> IO Archive +mkEpubArchive rootDir = do + setCurrentDirectory rootDir + + allFiles <- getRecursiveContents "." + + flip (addFilesToArchive []) ["mimetype"] >=> + flip (addFilesToArchive [OptRecursive]) allFiles + $ emptyArchive + + +-- | Read a zip Archive from disk +readArchive :: FilePath -> IO Archive +readArchive = fmap toArchive . B.readFile + + +-- | Write a zip Archive to disk using the specified filename +writeArchive :: FilePath -> Archive -> IO () +writeArchive zipPath = (B.writeFile zipPath) . fromArchive diff --git a/src/Codec/Epub/IO.hs b/src/Codec/Epub/IO.hs --- a/src/Codec/Epub/IO.hs +++ b/src/Codec/Epub/IO.hs @@ -7,13 +7,20 @@ {- | Functions for doing some disk IO with ePub documents -} module Codec.Epub.IO - ( opfContents ) + ( opfContentsFromZip + , opfContentsFromBS + , opfContentsFromDir + , removeEncoding + , removeDoctype + ) where import Codec.Archive.Zip import Control.Arrow.ListArrows ( (>>>), deep ) import Control.Monad.Error import qualified Data.ByteString.Lazy.Char8 as B +import System.Directory +import System.FilePath import Text.Regex import Text.XML.HXT.Arrow.XmlArrow ( getAttrValue, hasName, isElem ) import Text.XML.HXT.Arrow.XmlState ( no, runX, withValidate ) @@ -32,6 +39,21 @@ (mkRegexWithOpts "]*>" False True)) "" +locateRootFile :: (MonadIO m, MonadError String m) => + FilePath -> String -> m FilePath +locateRootFile containerPath containerDoc = do + result <- liftIO $ runX ( + readString [withValidate no] containerDoc + >>> deep (isElem >>> hasName "rootfile") + >>> getAttrValue "full-path" + ) + + case result of + (p : []) -> return p + _ -> throwError $ + "ERROR: rootfile full-path missing from " ++ containerPath + + -- | Extract a file from a zip archive throwing an error on failure fileFromArchive :: MonadError String m => FilePath -> Archive -> m String @@ -42,33 +64,57 @@ (return . B.unpack . fromEntry) mbEntry --- | Get the contents of the OPF Package Document from an ePub file -opfContents :: (MonadError String m, MonadIO m) - => FilePath -- ^ path to ePub zip file - -> m String -- ^ contents of the OPF Package Document -opfContents zipPath = do +-- | Get the contents of the OPF Package Document from a ByteString +opfContentsFromBS :: (MonadError String m, MonadIO m) + => B.ByteString -- ^ contents of the zip file + -> m (FilePath, String) -- ^ path and contents of the OPF Package Document +opfContentsFromBS bytes = do + let archive = toArchive bytes + {- We need to first extract the container.xml file It's required to have a certain path and name in the epub and contains the path to what we really want, the .opf file. -} - zipFileBytes <- liftIO $ B.readFile zipPath - let archive = toArchive zipFileBytes - let containerPath = "META-INF/container.xml" containerDoc <- fileFromArchive containerPath archive - result <- liftIO $ runX ( - readString [withValidate no] containerDoc - >>> deep (isElem >>> hasName "rootfile") - >>> getAttrValue "full-path" - ) - - rootPath <- case result of - (p : []) -> return p - _ -> throwError $ - "ERROR: rootfile full-path missing from " ++ containerPath + rootPath <- locateRootFile containerPath containerDoc -- Now that we have the path to the .opf file, extract it - rootDoc <- fileFromArchive rootPath archive + rootContents <- fileFromArchive rootPath archive - return . removeEncoding . removeDoctype $ rootDoc + return (rootPath, rootContents) + + +-- | Get the contents of the OPF Package Document from an ePub file +opfContentsFromZip :: (MonadError String m, MonadIO m) + => FilePath -- ^ path to ePub zip file + -> m (FilePath, String) -- ^ path and contents of the OPF Package Document +opfContentsFromZip zipPath = do + {- Lazily read this file into a ByteString, send to + opfContentsFromBS + -} + zipFileBytes <- liftIO $ B.readFile zipPath + opfContentsFromBS zipFileBytes + + +-- | Get the contents of the OPF Package Document from an ePub file +opfContentsFromDir :: (MonadError String m, MonadIO m) + => FilePath -- ^ directory path + -> m (FilePath, String) -- ^ path and contents of the OPF Package Document +opfContentsFromDir dir = do + {- We need to first extract the container.xml file + It's required to have a certain path and name in the epub + and contains the path to what we really want, the .opf file. + -} + liftIO $ setCurrentDirectory dir + + let containerPath = "META-INF/container.xml" + containerDoc <- liftIO $ readFile containerPath + + rootPath <- locateRootFile (dir containerPath) containerDoc + + -- Now that we have the path to the .opf file, load it + rootContents <- liftIO $ readFile rootPath + + return (rootPath, rootContents) diff --git a/src/Codec/Epub/Opf/Cli/Opts.hs b/src/Codec/Epub/Opf/Cli/Opts.hs deleted file mode 100644 --- a/src/Codec/Epub/Opf/Cli/Opts.hs +++ /dev/null @@ -1,56 +0,0 @@ --- Copyright: 2010, 2011 Dino Morelli --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -module Codec.Epub.Opf.Cli.Opts - ( Options (..) - , parseOpts, usageText - ) - where - -import System.Console.GetOpt - - -data Options = Options - { optHelp :: Bool - , optVerbose :: Bool - } - - -defaultOptions :: Options -defaultOptions = Options - { optHelp = False - , optVerbose = False - } - - -options :: [OptDescr (Options -> Options)] -options = - [ Option ['h'] ["help"] - (NoArg (\opts -> opts { optHelp = True } )) - "This help text" - , Option ['v'] ["verbose"] - (NoArg (\opts -> opts { optVerbose = True } )) - "Display all OPF package info, including manifest, spine and guide" - ] - - -parseOpts :: [String] -> IO (Options, [String]) -parseOpts argv = - case getOpt Permute options argv of - (o,n,[] ) -> return (foldl (flip id) defaultOptions o, n) - (_,_,errs) -> ioError $ userError (concat errs ++ usageText) - - -usageText :: String -usageText = (usageInfo header options) ++ "\n" ++ footer - where - header = init $ unlines - [ "Usage: epubmeta [OPTIONS] EPUBFILE" - , "Examine EPUB OPF package data" - , "" - , "Options:" - ] - footer = init $ unlines - [ "Version 2.1.0 Dino Morelli " - ] diff --git a/src/Codec/Epub/Opf/Cli/epubmeta.hs b/src/Codec/Epub/Opf/Cli/epubmeta.hs deleted file mode 100644 --- a/src/Codec/Epub/Opf/Cli/epubmeta.hs +++ /dev/null @@ -1,25 +0,0 @@ --- Copyright: 2010, 2011 Dino Morelli --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -import Control.Monad.Error -import System.Environment ( getArgs ) -import System.Exit - -import Codec.Epub.Opf.Cli.Opts -import Codec.Epub.Opf.Format.Package -import Codec.Epub.Opf.Parse - - -main :: IO () -main = do - (opts, paths) <- getArgs >>= parseOpts - - when ((optHelp opts) || (null paths)) $ do - putStrLn usageText - exitWith $ ExitFailure 1 - - let zipPath = head paths - result <- runErrorT $ parseEpubOpf zipPath - - putStr $ either id (formatPackage (optVerbose opts)) result diff --git a/src/Codec/Epub/Opf/Parse.hs b/src/Codec/Epub/Opf/Parse.hs --- a/src/Codec/Epub/Opf/Parse.hs +++ b/src/Codec/Epub/Opf/Parse.hs @@ -250,22 +250,28 @@ {- | Extract the ePub OPF Package data contained in the supplied XML string -} -parseXmlToOpf :: (MonadIO m) => String -> m [Package] -parseXmlToOpf contents = - liftIO $ runX ( - readString [withValidate no] contents +parseXmlToOpf :: (MonadIO m, MonadError String m) => + String -> m Package +parseXmlToOpf contents = do + {- Improper encoding and schema declarations have been causing + havok with this parse, cruelly strip them out. -} + let cleanedContents = removeEncoding . removeDoctype $ contents + + result <- liftIO $ runX ( + readString [withValidate no] cleanedContents >>> propagateNamespaces >>> getBookData ) + case result of + (p : []) -> return p + _ -> throwError + "ERROR: Parse didn't result in a single document metadata" + -- | Given the path to an ePub file, extract the OPF Package data parseEpubOpf :: (MonadIO m, MonadError String m) => FilePath -> m Package parseEpubOpf zipPath = do - result <- opfContents zipPath >>= parseXmlToOpf - - case result of - (em : []) -> return em - _ -> throwError - "ERROR: Parse didn't result in a single document metadata" + (_, contents) <- opfContentsFromZip zipPath + parseXmlToOpf contents diff --git a/testsuite/runtests.hs b/testsuite/runtests.hs --- a/testsuite/runtests.hs +++ b/testsuite/runtests.hs @@ -2,6 +2,7 @@ -- License: BSD3 (see LICENSE) -- Author: Dino Morelli +import Control.Monad.Error import System.FilePath import Test.HUnit ( Counts, Test (..), assertEqual, runTestTT ) import Test.HUnit.Base ( Assertion ) @@ -27,9 +28,9 @@ testFull :: Test testFull = TestCase $ do xmlString <- readFile $ "testsuite" "testFull.opf" - actual <- parseXmlToOpf xmlString + actual <- runErrorT $ parseXmlToOpf xmlString let expected = - [ Package + Right Package { opVersion = "2.0" , opUniqueId = "isbn" , opMeta = Metadata @@ -118,7 +119,6 @@ } ] } - ] assertEqual "very full" expected actual @@ -127,10 +127,10 @@ -} testMinimal :: Test testMinimal = TestCase $ do - xmlString <- readFile $ "testsuite" "testMinimal.opf" - actual <- parseXmlToOpf xmlString + xmlString <- liftIO $ readFile $ "testsuite" "testMinimal.opf" + actual <- runErrorT $ parseXmlToOpf xmlString let expected = - [ Package + Right Package { opVersion = "2.0" , opUniqueId = "isbn" , opMeta = Metadata @@ -160,7 +160,6 @@ , opSpine = Spine {spineToc = "ncx", spineItemrefs = []} , opGuide = [] } - ] assertEqual "minimal" expected actual @@ -170,9 +169,9 @@ testMissingAll :: Test testMissingAll = TestCase $ do xmlString <- readFile $ "testsuite" "testMissingAll.opf" - actual <- parseXmlToOpf xmlString + actual <- runErrorT $ parseXmlToOpf xmlString let expected = - [ Package + Right Package { opVersion = "" , opUniqueId = "" , opMeta = emptyMetadata @@ -180,5 +179,4 @@ , opSpine = Spine {spineToc = "", spineItemrefs = []} , opGuide = [] } - ] assertEqual "missing all" expected actual