Commits

Sergey Astanin  committed 41abfb0

New examples, updated .cabal to include examples and tests in the sdist tarball.

  • Participants
  • Parent commits 6e01731
  • Tags 0.1.0

Comments (0)

Files changed (6)

File Codec/Archive/LibZip.hs

 {- | Monadic interface to @libzip@.
 
 Most of the operations on zip archive happen within 'Archive' monad
-(see 'withArchive'). Operations which require a file in the archive
-to be open are performed within 'Entry' monad (see 'fromFile').
-
+(see 'withArchive').
+Partial reading of the files in the archive may be performed from
+within 'Entry' monad (see 'fromFile').
 Both 'Archive' and 'Entry' are monad transformers over 'IO', and allow
 for IO with single and double 'lift'ing respectingly.
 
-Example. Reading a byte range from a file in the archive:
+Note: LibZip does not handle text encodings. Even if its API accepts
+'String's (e.g. in 'sourceBuffer'), character codes above 255 should
+not be used.  The user is responsible of proper encoding the text
+data.
+
+/Examples/
+
+List files in the zip archive:
 
 @
 import System.Environment (getArgs)
 import Codec.Archive.LibZip
 
 main = do
-  (zipfile:innerfile:_) <- getArgs
-  withArchive [] zipfile $
-    fromFile [] innerfile $ do
-      skipBytes 10
-      next10 <- readBytes 10
-      lift . lift $ putStrLn $ \"Bytes from 11 to 20: \" ++ next10
+  (zipfile:_) <- getArgs
+  files <- withArchive [] zipfile $ fileNames []
+  mapM_ putStrLn files
 @
+
+Create a zip archive and a add file to the archive:
+
+@
+import System.Environment (getArgs)
+import Codec.Archive.LibZip
+
+main = do
+  (zipfile:_) <- getArgs
+  withArchive [CreateFlag] zipfile $ do
+     zs <- sourceBuffer \"Hello World!\"
+     addFile \"hello.txt\" zs
+@
+
+Extract and print a file from the zip archive:
+
+@
+import System.Environment (getArgs)
+import Codec.Archive.LibZip
+
+main = do
+  (zipfile:file:_) <- getArgs
+  bytes <- withArchive [] zipfile $ fileContents [] file
+  putStrLn bytes
+@
+
+See also an implementation of a simple zip archiver @hzip.hs@ in the
+@examples/@ directory of the source distribution.
+
 -}
 module Codec.Archive.LibZip
     (

File LibZip.cabal

 Cabal-Version:  >= 1.2.3
 Tested-With:    GHC == 6.12.1
 
+Extra-Source-Files:
+    examples/legacyUnzip.hs, examples/hzip.hs
+  , runTests.hs, Tests/Common.hs, Tests/LegacyTests.hs
+  , Tests/MonadicTests.hs, Tests/test.zip
+
 Library
   Extensions:
       ForeignFunctionInterface

File Tests/Tests.hs

-import Codec.Archive.LibZip
-
-import Tests.Common
-import Tests.LegacyTests (legacyTests)
-
-import System.Exit
-import Test.HUnit
-import qualified Control.Exception as E
-
-monadicTests = TestList
-  [ "read list of files" ~: do
-      files <- withArchive [] testzip $ fileNames []
-      files @?= testfiles
-  , "read file size" ~: do
-      sz <- withArchive [] testzip $ fileSize [] lastfile
-      sz @?= lastfilesize
-  , "case-insensitive file names" ~: do
-      sz <- withArchive [] testzip $
-              fileSize [FileNOCASE] (map2 toUpper toLower $ lastfile)
-      sz @?= lastfilesize
-  , "open error if exists (with ExclFlag)" ~: do
-      err <- catchZipError
-             (withArchive [ExclFlag] testzip $ lift $ E.throwIO ErrOK)
-             (return . id)
-      err @?= ErrEXISTS
-  , "open error if archive does not exists" ~: do
-      err <- catchZipError
-             (withArchive [] "notexists.zip" $ return ErrOK)
-             (return . id)
-      err @?= ErrOPEN
-  , "read file" ~: do
-      txt <- withArchive [] testzip $ fileContents [] lastfile
-      txt @?= world_txt
-  , "read file by index" ~: do
-      txt <- withArchive [] testzip $ fileContentsIx [] (length testfiles - 1)
-      txt @?= world_txt
-  , "skipBytes/readBytes" ~: do
-      txt <- withArchive [] testzip $
-               fromFile [] lastfile $ do
-                  skipBytes 13
-                  readBytes 10
-      txt @?= (take 10 . drop 13 $ world_txt)
-  ]
-
-allTests = TestList
-  [ "Legacy API" ~: legacyTests
-  , "Monadic API" ~: monadicTests
-  ]
-
-main = do
-  result <- runTestTT allTests
-  if (errors result + failures result) > 0
-    then exitFailure
-    else exitSuccess
-

File examples/hzip.hs

+-- A utility to list, add or extract files in a zip archive.
+--
+-- This is an example of using LibZip library.
+--
+-- (c) Sergey Astanin 2010
+-- License: BSD3
+--
+import Codec.Archive.LibZip
+
+import Control.Monad (liftM, when)
+import Data.List (intercalate)
+import System.Directory (createDirectoryIfMissing, doesDirectoryExist, getCurrentDirectory, getDirectoryContents, makeRelativeToCurrentDirectory)
+import System.Environment (getArgs)
+import System.FilePath (joinPath, splitDirectories, takeDirectory)
+import System.IO (stderr, hPutStr, hPutStrLn)
+
+usage :: String
+usage =  unlines
+  [ "Usage: hzip [l|a|x] archive.zip [files]"
+  , "         l     list files in the archives"
+  , "         a     add/update files or directories in the archive recursively"
+  , "         x     extract files from the archive to the current direcotory"
+  ]
+
+main :: IO ()
+main = do
+  args <- getArgs
+  case args of
+    ("l":archive:_) -> list archive
+    ("a":archive:files) -> mapM mkRel files >>= add archive
+    ("x":archive:files) -> getCurrentDirectory >>= \d -> extract d archive files
+    _ -> hPutStr stderr usage
+  where
+    mkRel = makeRelativeToCurrentDirectory
+
+list :: FilePath -> IO ()
+list archive = do
+  stats <- withArchive [] archive $ do
+             n <- numFiles
+             mapM (fileStatIx []) [0..(n-1)]
+  mapM_ printEntry stats
+  where
+  printEntry e =
+    let sz = padLeft 8 . show $ zs'size e
+        mt = take 16 . show $ zs'mtime e
+        nm = zs'name e
+    in  putStrLn $ intercalate "  " [ sz, mt, nm ]
+  padLeft n s = let m = max 0 (n - length s) in replicate m ' ' ++ s
+
+add :: FilePath -> [FilePath] -> IO ()
+add archive paths = mapM_ (addEntry archive) paths
+
+-- not very effective: it opens the archive many times, but it should work
+addEntry :: FilePath -> FilePath -> IO ()
+addEntry a path = do
+  isADir <- doesDirectoryExist path
+  if isADir
+     then printErrors a path $ do
+       withArchive flags a $ mapM_ checkAddDirectory $ parents path
+       paths <- filter (`notElem` [".",".."]) `liftM` getDirectoryContents path
+       let rpaths = map (\e -> joinPath [path,e]) paths
+       add a rpaths
+     else do
+       printErrors a path $
+           withArchive flags a $ addOrUpdate path =<< sourceFile path 0 0
+  where
+    flags = [CreateFlag]
+    parents = scanl1 (\p c -> joinPath [p,c]) . splitDirectories
+    checkAddDirectory p = do
+       e1 <- nameLocate [] p
+       e2 <- nameLocate [] (p ++ "/")
+       if e1 == Nothing && e2 == Nothing
+          then addDirectory p
+          else return (-1)
+    addOrUpdate p src = do
+       exists <- nameLocate [] p
+       case exists of
+          (Just i) -> replaceFileIx i src
+          Nothing  -> addFile p src >> return ()
+    printErrors a p action =
+        catchZipError
+        ( action >> return () )
+        ( \ze -> hPutStrLn stderr $ intercalate ": " [a, p, show ze] )
+
+extract :: FilePath -> FilePath -> [FilePath] -> IO ()
+extract outdir archive onlyFiles =
+  withArchive [] archive $ do
+    n <- numFiles
+    mapM_ (extractEntry outdir onlyFiles) [0..(n-1)]
+
+-- silently overwrites existing files
+extractEntry :: FilePath -> [FilePath] -> Int -> Archive ()
+extractEntry outdir onlyFiles i = do
+  name <- fileName [] i
+  let fspath = joinPath [outdir, name]
+  let fsdir = takeDirectory fspath
+  when (null onlyFiles || name `elem` onlyFiles) $
+      if isDir name
+         then lift $ createDirectoryIfMissing True fsdir
+         else do
+           b <- fileContentsIx [] i
+           lift $ do
+                createDirectoryIfMissing True fsdir
+                writeFile fspath b  -- FIXME: should be binary 
+  where
+    isDir "" = False
+    isDir f  = last f == '/'
+

File examples/legacyUnzip.hs

+-- A simple unzip utility.
+--
+-- This is an example of using legacy LibZip-0.0 API.
+--
+module Main where
+
+import qualified Data.ByteString as B
+import Control.Monad (forM_,when)
+import System.Directory (createDirectoryIfMissing)
+import System.Environment (getArgs)
+import System.FilePath (takeDirectory)
+
+import Codec.Archive.LibZip
+
+usage = "unzip [-l] file.zip [files]"
+
+main = do
+  args <- getArgs
+  let onlyList = "-l" `elem` args
+  let args' = filter (/= "-l") args
+  case args' of
+    [] -> putStrLn usage
+    (filename:files) -> do
+      catchZipError $
+        withZip filename [] $ \z -> do
+          files' <- getFiles z []
+          forM_ files' $ \f -> do
+            when (f `elem` files || null files) $
+              if onlyList
+                then putStrLn f
+                else saveFile f =<< readZipFile z f []
+      $ \e -> putStrLn $ "Error in " ++ filename ++ ": " ++ show e
+
+saveFile f contents = do
+  if isDir f
+    then createDirectoryIfMissing True $ takeDirectory f
+    else B.writeFile f contents
+

File examples/unzip.hs

--- | A simple unzip utility (example). To build:
---
--- @
--- $ ghc -lzip --make unzip.hs
--- @
-module Main where
-
-import qualified Data.ByteString as B
-import Control.Monad (forM_,when)
-import System.Directory (createDirectoryIfMissing)
-import System.Environment (getArgs)
-import System.FilePath (takeDirectory)
-
-import Codec.Archive.LibZip
-
-usage = "unzip [-l] file.zip [files]"
-
-main = do
-  args <- getArgs
-  let onlyList = "-l" `elem` args
-  let args' = filter (/= "-l") args
-  case args' of
-    [] -> putStrLn usage
-    (filename:files) -> do
-      catchZipError $
-        withZip filename [] $ \z -> do
-          files' <- getFiles z []
-          forM_ files' $ \f -> do
-            when (f `elem` files || null files) $
-              if onlyList
-                then putStrLn f
-                else saveFile f =<< readZipFile z f []
-      $ \e -> putStrLn $ "Error in " ++ filename ++ ": " ++ show e
-
-saveFile f contents = do
-  if isDir f
-    then createDirectoryIfMissing True $ takeDirectory f
-    else B.writeFile f contents
-