datapacker

{- 

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     : Main

   Copyright  : Copyright (C) 2008 John Goerzen

   License    : GNU GPL, version 3 or above; see COPYRIGHT for details

   Maintainer : John Goerzen <jgoerzen@complete.org>

   Stability  : provisional

   Portability: portable

Written by John Goerzen, jgoerzen\@complete.org

-}

import System.Log.Logger

import System.Log.Handler.Simple

import System.IO(stderr)

import System.Console.GetOpt.Utils

import System.Console.GetOpt

import System.Environment

import Data.Quantity

import Data.List

import System.Exit

import Control.Monad

import Types

import Scan

import Data.List.Utils(split)

import Actions

main :: IO ()

main = 

    do updateGlobalLogger "" (setLevel INFO)

       argv <- getArgs

       case getOpt RequireOrder options argv of

         (o, n, []) -> worker o n

         (_, _, errors) -> usageerror (concat errors) -- ++ usageInfo header options)

options :: [OptDescr (String, String)]       

options = [

           Option "0" ["null"] (NoArg ("0", ""))

                  "Input items terminated by null character",

           Option "a" ["action"] (ReqArg (stdRequired "a") "ACTION")

                  "Give action for output.  Options are:\n\

                  \print     print each record with a newline\n\

                  \          after [default]\n\

                  \printfull print one line for each bin\n\

                  \print0    print each record with NULL after\n\

                  \exec:CMD  Execute CMD in the shell for each\n\

                  \record\n\

                  \hardlink  Hard link items into bins\n\

                  \symlink   Symlink items into bins",

           Option "b" ["binfmt"] (ReqArg (stdRequired "b") "FORMAT")

                  "Gives bin name format in printf style.\n\

                  \Tip: this can include a directory.\n\

                  \default: %03d",

           Option "d" ["debug"] (NoArg ("d", "")) "Enable debugging",

           Option "D" ["deep-links"] (NoArg ("D", "")) "Enable deep bin directories",

           Option "p" ["preserve-order"] (NoArg ("p", ""))

                  "Don't reorder files for maximum packing",

           Option "s" ["size"] (ReqArg (stdRequired "s") "SIZE")

                  "Size of each output bin",

           Option "S" ["size-first"] (ReqArg (stdRequired "S") "SIZE")

                  "Override size of first output bin",

           Option "" ["sort"] (NoArg ("sort", "")) "Sort input; useless without -p",

           Option "" ["help"] (NoArg ("help", "")) "Display this help"]

worker :: [(String, String)] -> [FilePath] -> IO ()

worker args files =

    do when (lookup "help" args == Just "") $ usageerror ""

       when (lookup "d" args == Just "") 

            (updateGlobalLogger "" (setLevel DEBUG))

       handler <- streamHandler stderr DEBUG

       updateGlobalLogger "" (setHandlers [handler])

       runinfo <- case parseArgs args of

                       Left x -> usageerror x

                       Right x -> return x

       when (files == [])

            (usageerror "One or more files, or \"-\", must be specified")

       files_scan <- if files == ["-"]

                        then readFileList (readNull runinfo)

                        else return files

       let listToProc = if sortFiles runinfo then sort files_scan else files_scan

       results <- scan runinfo listToProc

       let numberedResults = zip [1..] (map (map snd) results)

       runAction runinfo numberedResults

readFileList :: Bool -> IO [FilePath]

readFileList nullsep =

    do c <- getContents

       return (splitfunc c)

    where splitfunc 

              | nullsep = filter (/= "") . split "\0"

              | otherwise = lines

parseArgs :: [(String, String)] -> Either String RunInfo

parseArgs args =

    do size <- case lookup "s" args of

                 Nothing -> fail "Missing required argument --size"

                 Just x -> parseNumInt binaryOpts True x

       first <- case lookup "S" args of

                  Nothing -> return size

                  Just x -> parseNumInt binaryOpts True x

       let po = case lookup "p" args of

                  Nothing -> False

                  Just _ -> True

       let n = case lookup "0" args of

                 Nothing -> False

                 Just _ -> True

       let b = case lookup "b" args of

                 Nothing -> "%03d"

                 Just x -> x

       let deeplinks = case lookup "D" args of

                        Nothing -> False

                        Just _ -> True

       let dosort = case lookup "sort" args of

                      Nothing -> False

                      Just _ -> True

       a <- case lookup "a" args of

              Nothing -> return Print

              Just "print" -> return Print

              Just "printfull" -> return PrintFull

              Just "print0" -> return Print0

              Just "hardlink" -> return Hardlink

              Just "symlink" -> return Symlink

              Just x -> 

                  if "exec:" `isPrefixOf` x

                     then return (Exec (drop 5 x))

                     else fail $ "Unknown action: " ++ show x

       return $ RunInfo {binSize = size, firstBinSize = first,

                         preserveOrder = po, readNull = n, binFmt = b,

                         action = a, deepLinks = deeplinks, sortFiles = dosort}

usageerror :: String -> IO t

usageerror errormsg =

    do putStrLn errormsg

       putStrLn (usageInfo header options)

       putStrLn "If the single value \"-\" is given for inputfiles, the list of files"

       putStrLn "is read from stdin."

       exitFailure

header :: String

header = "\nUsage: datapacker [options] --size=n inputfiles\n\n\

         \Available options are:\n"