datapacker 1.0.0 → 1.0.0.1

raw patch · 4 files changed

+143/−2 lines, 4 files

Files

Actions.hs +83/−0
Scan.hs +32/−0
Types.hs +25/−0
datapacker.cabal +3/−2

+ Actions.hs view

@@ -0,0 +1,83 @@+{- +Copyright (C) 2006-2008 John Goerzen <jgoerzen@complete.org>++This program is distributed in the hope that it will be useful, but+WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU+General Public License for more details.+-}++module Actions(runAction) where+import Types+import Text.Printf+import Data.List+import System.FilePath+import System.Posix.Files+import System.Directory+import System.Process+import System.Environment+import System.Exit+import Control.Monad++runAction :: RunInfo -> [(Integer, [FilePath])] -> IO ()+runAction ri resultlist =+    case action ri of+      Print -> action_print ri resultlist+      PrintFull -> action_printfull ri resultlist+      Print0 -> action_print0 ri resultlist+      Hardlink -> action_hardlink ri resultlist+      Symlink -> action_symlink ri resultlist+      Exec x -> action_exec x ri resultlist++formatBin :: RunInfo -> Integer -> String+formatBin ri bin = printf (binFmt ri) bin++action_print :: RunInfo -> [(Integer, [FilePath])] -> IO ()+action_print ri =+    putStr . unlines . concatMap procBin+    where procBin (bin, fp) = map (procLine (formatBin ri bin)) fp+          procLine bin fp = bin ++ "\t" ++ fp++action_printfull :: RunInfo -> [(Integer, [FilePath])] -> IO ()+action_printfull ri =+    putStr . unlines . map toLine+    where toLine (bin, files) =+              formatBin ri bin ++ "\t" ++ (concat . intersperse "\t" $ files)++action_print0 :: RunInfo -> [(Integer, [FilePath])] -> IO ()+action_print0 ri =+    putStr . concatMap toLine+    where toLine (bin, files) = concatMap (fmtFile (formatBin ri bin)) files+          fmtFile binstr file =+              binstr ++ "\0" ++ file ++ "\0"++action_hardlink :: RunInfo -> [(Integer, [FilePath])] -> IO ()+action_hardlink = action_link createLink++action_symlink :: RunInfo -> [(Integer, [FilePath])] -> IO ()+action_symlink = action_link createSymbolicLink++action_link :: (FilePath -> FilePath -> IO ()) -> RunInfo -> [(Integer, [FilePath])] -> IO ()+action_link func ri =+    mapM_ makeLink+    where makeLink (bin, fpl) = +              mapM_ (makeLink' (formatBin ri bin)) fpl+          makeLink' bin fp =+              do createDirectoryIfMissing False bin+                 func fp (bin ++ "/" ++ takeFileName fp)++action_exec :: String -> RunInfo -> [(Integer, [FilePath])] -> IO ()+action_exec cmd ri inp =+    do baseenv <- getEnvironment+       let shell = case lookup "SHELL" baseenv of+                     Nothing -> "/bin/sh"+                     Just x -> x+       mapM_ (execCommand shell) inp+    where execCommand sh (bin, fpl) = +              do ph <- runProcess sh (["-c", cmd, sh, formatBin ri bin] ++ fpl)+                       Nothing Nothing Nothing Nothing Nothing +                 ec <- waitForProcess ph+                 when (ec /= ExitSuccess)+                      (fail $ "action_exec: command failed on bin " ++ +                            formatBin ri bin ++ ": " ++ show ec)+

+ Scan.hs view

@@ -0,0 +1,32 @@+{- +Copyright (C) 2006-2008 John Goerzen <jgoerzen@complete.org>++This program is distributed in the hope that it will be useful, but+WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU+General Public License for more details.+-}++module Scan(scan) where+import Types+import Control.Monad(liftM)+import System.Posix.Files+import System.Log.Logger+import Data.List+import Data.BinPacking++scan :: RunInfo -> [FilePath] -> IO [[Result]]+scan ri fplist =+    do sizes <- (liftM concat $ mapM getSize fplist)+       let func = if preserveOrder ri then packByOrder else packLargeFirst+       case func bins sizes of+         Left x -> fail (show x)+         Right x -> return x+    where getSize f = +              do s <- getFileStatus f+                 if isRegularFile s+                    then return [(fromIntegral (fileSize s), f)]+                    else do warningM "scan" $ "Warning: file " ++ f ++ " is not a regular file; skipping"+                            return []+                    +          bins = firstBinSize ri : repeat (binSize ri)

+ Types.hs view

@@ -0,0 +1,25 @@+{- +Copyright (C) 2006-2008 John Goerzen <jgoerzen@complete.org>++This program is distributed in the hope that it will be useful, but+WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU+General Public License for more details.+-}++module Types where++data Action = Print | PrintFull | Print0 | Exec String | Hardlink | Symlink+            deriving (Eq, Ord, Read, Show)++data RunInfo = +    RunInfo {binSize :: Integer,+             firstBinSize :: Integer,+             preserveOrder :: Bool,+             readNull :: Bool,+             binFmt :: String,+             action :: Action}+    deriving (Eq, Ord, Read, Show)++-- (Size, filepath)+type Result = (Integer, FilePath)

datapacker.cabal view

@@ -1,5 +1,5 @@ Name: datapacker-Version: 1.0.0+Version: 1.0.0.1 License: GPL Maintainer: John Goerzen <jgoerzen@complete.org> Author: John Goerzen@@ -9,7 +9,7 @@ extra-source-files: COPYING, datapacker.sgml, Makefile, INSTALL homepage: http://software.complete.org/datapacker Build-type: Simple-Category: Network+Category: System Synopsis: Tool to help pack files into the minimum number of CDs/DVDs/etc Description: datapacker is a tool to group files by size. It is  designed to group files such that they fill fixed-size containers@@ -31,6 +31,7 @@  Executable: datapacker Main-Is: datapacker.hs+Other-Modules: Actions, Scan, Types     GHC-Options: -O2 -Wall