File: datapacker.hs

package info (click to toggle)
datapacker 1.0.2
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, sid
  • size: 128 kB
  • sloc: haskell: 228; makefile: 78
file content (156 lines) | stat: -rw-r--r-- 6,020 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
{- 
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"