-
Notifications
You must be signed in to change notification settings - Fork 20
/
Arc.hs
246 lines (219 loc) · 12.9 KB
/
Arc.hs
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
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
{-# OPTIONS_GHC -cpp #-}
----------------------------------------------------------------------------------------------------
---- Îñíîâíîé ìîäóëü ïðîãðàììû. ----
---- Âûçûâàåò parseCmdline èç ìîäóëÿ Cmdline äëÿ ðàçáîðà êîìàíäíîé ñòðîêè è âûïîëíÿåò êàæäóþ ----
---- ïîëó÷åííóþ êîìàíäó. ----
---- Åñëè êîìàíäà äîëæíà îáðàáîòàòü íåñêîëüêî àðõèâîâ, òî find_archives äóáëèðóåò å¸ ----
---- äëÿ êàæäîãî èç íèõ. ----
---- Çàòåì êàæäàÿ êîìàíäà ñâîäèòñÿ ê âûïîëíåíèþ îäíîé èç ñëåäóþùèõ çàäà÷: ----
---- * èçìåíåíèå àðõèâà ñ ïîìîùüþ runArchiveCreate èç ìîäóëÿ ArcCreate (êîìàíäû a/f/m/u/j/d/ch/c/k/rr)
---- * ðàñïàêîâêà àðõèâà - runArchiveExtract - ArcExtract (êîìàíäû t/e/x) ----
---- * ïîëó÷åíèå ëèñòèíãà àðõèâà - runArchiveList - ArcList (êîìàíäû l/v) ----
---- * âîññòàíîâëåíèå àðõèâà - runArchiveRecovery - ArcRecover (êîìàíäà r) ----
---- êîòîðûì ïåðåäàþòñÿ àðãóìåíòû â ñîîòâåòñòâèè ñî ñïåöèôèêîé êîíêðåòíîé âûïîëíÿåìîé êîìàíäû. ----
---- ----
---- Ýòè ïðîöåäóðû â ñâîþ î÷åðåäü ïðÿìî èëè êîñâåííî îáðàùàþòñÿ ê ìîäóëÿì: ----
---- ArhiveFileList - äëÿ ðàáîòû ñî ñïèñêàìè àðõèâèðóåìûõ ôàéëîâ ----
---- ArhiveDirectory - äëÿ ÷òåíèÿ/çàïèñè îãëàâëåíèÿ àðõèâà ----
---- ArhiveStructure - äëÿ ðàáîòû ñî ñòðóêòóðîé àðõèâà ----
---- ByteStream - äëÿ ïðåâðàùåíèÿ êàòàëîãà àðõèâà â ïîñëåäîâàòåëüíîñòü áàéòîâ ----
---- Compression - äëÿ âûçîâà àëãîðèòìîâ óïàêîâêè, ðàñïàêîâêè è âû÷èñëåíèÿ CRC ----
---- UI - äëÿ èíôîðìèðîâàíèÿ ïîëüçîâàòåëÿ î õîäå âûïîëíÿåìûõ ðàáîò :) ----
---- Errors - äëÿ ñèãíàëèçàöèè î âîçíèêøèõ îøèáêàõ è çàïèñè â ëîãôàéë ----
---- FileInfo - äëÿ ïîèñêà ôàéëîâ íà äèñêå è ïîëó÷åíèÿ èíôîðìàöèè î íèõ ----
---- Files - äëÿ âñåõ îïåðàöèé ñ ôàéëàìè íà äèñêå è èìåíàìè ôàéëîâ ----
---- Process - äëÿ ðàçäåëåíèÿ àëãîðèòìà íà ïàðàëëåëüíûå âçàèìîäåéñòâóþùèå ïðîöåññû ----
---- Utils - äëÿ âñåõ îñòàëüíûõ âñïîìîãàòåëüíûõ ôóíêöèé ----
----------------------------------------------------------------------------------------------------
module Main where
import Prelude hiding (catch)
import Control.Concurrent
import Control.Exception
import Control.Monad
import Data.List
import System.Mem
import System.IO
import Utils
import Process
import Errors
import Files
import FileInfo
import Charsets
import Options
import Cmdline
import UI
import ArcCreate
import ArcExtract
import ArcRecover
#ifdef FREEARC_GUI
import FileManager
#endif
-- |Ãëàâíàÿ ôóíêöèÿ ïðîãðàììû
main = (doMain =<< myGetArgs) >> shutdown "" aEXIT_CODE_SUCCESS
-- |Äóáëèðóþùàÿ ãëàâíàÿ ôóíêöèÿ äëÿ èíòåðàêòèâíîé îòëàäêè
arc cmdline = doMain (words cmdline)
-- |Ïðåâðàòèòü êîìàíäíóþ ñòðîêó â íàáîð êîìàíä è âûïîëíèòü èõ
doMain args = do
#ifdef FREEARC_GUI
bg $ do -- âûïîëíÿåì â íîâîì òðåäå, íå ÿâëÿþùåìñÿ bound thread
#endif
setUncaughtExceptionHandler handler
setCtrlBreakHandler $ do -- Îðãàíèçóåì îáðàáîòêó ^Break
ensureCtrlBreak "resetConsoleTitle" (resetConsoleTitle) $ do
args <- processCmdfile args
luaLevel "Program" [("command", args)] $ do
#ifdef FREEARC_GUI
parseGUIcommands run args $ \args -> do -- Îáðàáîòêà GUI-ñïåöèôè÷íûõ âàðèàöèé êîìàíäíîé ñòðîêè
#endif
uiStartProgram -- Îòêðûòü UI
commands <- parseCmdline args -- Ïðåâðàòèòü êîìàíäíóþ ñòðîêó â ñïèñîê êîìàíä íà âûïîëíåíèå
mapM_ run commands -- Âûïîëíèòü êàæäóþ ïîëó÷åííóþ êîìàíäó
uiDoneProgram -- Çàêðûòü UI
where
handler ex = do
#ifdef FREEARC_GUI
doNothing0
#else
whenM (val programFinished) $ do
foreverM$ sleepSeconds 1 -- Åñëè ïðîãðàììà íàõîäèòñÿ â shutdown, ïîçâîëèì åìó çàâåðøèòü ïðîãðàììó
registerError$ GENERAL_ERROR$
case ex of
Deadlock -> ["0011 No threads to run: infinite loop or deadlock?"]
ErrorCall s -> [s]
other -> [show ex]
#endif
-- |Äèñïåò÷åðèçóåò êîìàíäó è îðãàíèçóåò å¸ ïîâòîðåíèå äëÿ êàæäîãî ïîäõîäÿùåãî àðõèâà
run command @ Command
{ cmd_name = cmd
, cmd_setup_command = setup_command
, opt_scan_subdirs = scan_subdirs
} = do
performGC -- ïî÷èñòèòü ìóñîð ïîñëå îáðàáîòêè ïðåäûäóùèõ êîìàíä
setup_command -- âûïîëíèòü íàñòðîéêè, íåîáõîäèìûå ïåðåä íà÷àëîì âûïîëíåíèÿ êîìàíäû
luaLevel "Command" [("command", cmd)] $ do
case (cmd) of
"create" -> find_archives False run_add command
"a" -> find_archives False run_add command
"f" -> find_archives False run_add command
"m" -> find_archives False run_add command
"mf" -> find_archives False run_add command
"u" -> find_archives False run_add command
"j" -> find_archives False run_join command
"cw" -> find_archives False run_cw command
"ch" -> find_archives scan_subdirs run_copy command
's':_ -> find_archives scan_subdirs run_copy command
"c" -> find_archives scan_subdirs run_copy command
"k" -> find_archives scan_subdirs run_copy command
'r':'r':_-> find_archives scan_subdirs run_copy command
"r" -> find_archives scan_subdirs run_recover command
"d" -> find_archives scan_subdirs run_delete command
"e" -> find_archives scan_subdirs run_extract command
"x" -> find_archives scan_subdirs run_extract command
"t" -> find_archives scan_subdirs run_test command
"l" -> find_archives scan_subdirs run_list command
"lb" -> find_archives scan_subdirs run_list command
"lt" -> find_archives scan_subdirs run_list command
"v" -> find_archives scan_subdirs run_list command
_ -> registerError$ UNKNOWN_CMD cmd aLL_COMMANDS
-- |Èùåò àðõèâû, ïîäõîäÿùèå ïîä ìàñêó arcspec, è âûïîëíÿåò çàäàííóþ êîìàíäó íà êàæäîì èç íèõ
find_archives scan_subdirs -- èñêàòü àðõèâû è â ïîäêàòàëîãàõ?
run_command -- ïðîöåäóðà, êîòîðóþ íóæíî çàïóñòèòü íà êàæäîì íàéäåííîì àðõèâå
command @ Command {cmd_arcspec = arcspec} = do
uiStartCommand command -- Îòìåòèì íà÷àëî âûïîëíåíèÿ êîìàíäû
arclist <- if scan_subdirs || is_wildcard arcspec
then find_files scan_subdirs arcspec >>== map diskName
else return [arcspec]
results <- foreach arclist $ \arcname -> do
performGC -- ïî÷èñòèòü ìóñîð ïîñëå îáðàáîòêè ïðåäûäóùèõ àðõèâîâ
luaLevel "Archive" [("arcname", arcname)] $ do
-- Åñëè óêàçàíà îïöèÿ -ad, òî äîáàâèòü ê áàçîâîìó êàòàëîãó íà äèñêå èìÿ àðõèâà (áåç ðàñøèðåíèÿ)
let add_dir = opt_add_dir command &&& (</> takeBaseName arcname)
run_command command { cmd_arcspec = error "find_archives:cmd_arcspec undefined" -- cmd_arcspec íàì áîëüøå íå ïîíàäîáèòñÿ.
, cmd_arclist = arclist
, cmd_arcname = arcname
, opt_disk_basedir = add_dir (opt_disk_basedir command)
}
uiDoneCommand command results -- äîëîæèòü î ðåçóëüòàòàõ âûïîëíåíèÿ êîìàíäû íàä âñåìè àðõèâàìè
-- |Êîìàíäû äîáàâëåíèÿ â àðõèâ: create, a, f, m, u
run_add cmd = do
msg <- i18n"0246 Found %1 files"
let diskfiles = find_and_filter_files (cmd_filespecs cmd) (uiScanning msg) find_criteria
find_criteria = FileFind{ ff_ep = opt_add_exclude_path cmd
, ff_scan_subdirs = opt_scan_subdirs cmd
, ff_include_dirs = opt_include_dirs cmd
, ff_no_nst_filters = opt_no_nst_filters cmd
, ff_filter_f = add_file_filter cmd
, ff_group_f = opt_find_group cmd.$Just
, ff_arc_basedir = opt_arc_basedir cmd
, ff_disk_basedir = opt_disk_basedir cmd}
runArchiveAdd cmd{ cmd_diskfiles = diskfiles -- ôàéëû, êîòîðûå íóæíî äîáàâèòü ñ äèñêà
, cmd_archive_filter = const True } -- ôèëüòð îòáîðà ôàéëîâ èç îòêðûâàåìûõ àðõèâîâ
-- |Êîìàíäà ñëèÿíèÿ àðõèâîâ: j
run_join cmd @ Command { cmd_filespecs = filespecs
, opt_noarcext = noarcext
} = do
msg <- i18n"0247 Found %1 archives"
let arcspecs = map (addArcExtension noarcext) filespecs -- äîáàâèì ê èìåíàì ðàñøèðåíèå ïî óìîë÷àíèþ (".arc")
arcnames = map diskName ==<< find_and_filter_files arcspecs (uiScanning msg) find_criteria
find_criteria = FileFind{ ff_ep = opt_add_exclude_path cmd
, ff_scan_subdirs = opt_scan_subdirs cmd
, ff_include_dirs = Just False
, ff_no_nst_filters = opt_no_nst_filters cmd
, ff_filter_f = add_file_filter cmd
, ff_group_f = Nothing
, ff_arc_basedir = ""
, ff_disk_basedir = opt_disk_basedir cmd}
runArchiveAdd cmd{ cmd_added_arcnames = arcnames -- äîïîëíèòåëüíûå âõîäíûå àðõèâû
, cmd_archive_filter = const True } -- ôèëüòð îòáîðà ôàéëîâ èç îòêðûâàåìûõ àðõèâîâ
-- |Êîìàíäû êîïèðîâàíèÿ àðõèâà ñ âíåñåíèåì èçìåíåíèé: ch, c, k. s, rr
run_copy = runArchiveAdd . setArcFilter full_file_filter
-- |Êîìàíäà óäàëåíèÿ èç àðõèâà: d
run_delete = runArchiveAdd . setArcFilter ((not.).full_file_filter)
-- |Êîìàíäû èçâëå÷åíèÿ èç àðõèâà: e, x
run_extract = runArchiveExtract pretestArchive . setArcFilter (test_dirs extract_file_filter)
-- |Êîìàíäà òåñòèðîâàíèÿ àðõèâà: t
run_test = runArchiveExtract pretestArchive . setArcFilter (test_dirs full_file_filter)
-- |Êîìàíäû ïîëó÷åíèÿ ëèñòèíãà àðõèâà: l, v
run_list = runArchiveList pretestArchive . setArcFilter (test_dirs full_file_filter)
-- |Êîìàíäà çàïèñè àðõèâíîãî êîììåíòàðèÿ â ôàéë: cw
run_cw = runCommentWrite
-- |Êîìàíäà âîññòàíîâëåíèÿ àðõèâà: r
run_recover = runArchiveRecovery
-- |Just shortcut
runArchiveAdd = runArchiveCreate pretestArchive writeRecoveryBlocks
{-# NOINLINE find_archives #-}
{-# NOINLINE run_add #-}
{-# NOINLINE run_join #-}
{-# NOINLINE run_copy #-}
{-# NOINLINE run_delete #-}
{-# NOINLINE run_extract #-}
{-# NOINLINE run_test #-}
{-# NOINLINE run_list #-}
----------------------------------------------------------------------------------------------------
---- Êðèòåðèè îòáîðà ôàéëîâ, ïîäëåæàùèõ îáðàáîòêå, äëÿ ðàçëè÷íûõ òèïîâ êîìàíä ----------------------
----------------------------------------------------------------------------------------------------
-- |Óñòàíîâèòü â cmd ïðåäèêàò âûáîðà èç àðõèâà îáðàáàòûâàåìûõ ôàéëîâ
setArcFilter filter cmd = cmd {cmd_archive_filter = filter cmd}
-- |Îòîáðàòü ôàéëû â ñîîòâåòñòâèè ñ ôèëüòðîì opt_file_filter, çà èñêëþ÷åíèåì
-- îáðàáàòûâàåìûõ ýòîé êîìàíäîé àðõèâîâ è âðåìåííûõ ôàéëîâ, ñîçäàâàåìûõ ïðè àðõèâàöèè
add_file_filter cmd = all_functions [opt_file_filter cmd, not.overwrite_f cmd]
-- |Îòîáðàòü ôàéëû â ñîîòâåòñòâèè ñ ôèëüòðîì full_file_filter, çà èñêëþ÷åíèåì
-- îáðàáàòûâàåìûõ ýòîé êîìàíäîé àðõèâîâ è âðåìåííûõ ôàéëîâ, ñîçäàâàåìûõ ïðè àðõèâàöèè
extract_file_filter cmd = all_functions [full_file_filter cmd, not.overwrite_f cmd]
-- |Îòáèðàåò ñðåäè ôàéëîâ, ìàñêè êîòîðûõ óêàçàíû â êîìàíäíîé ñòðîêå,
-- ñîîòâåòñòâóþùèå ôèëüòðó opt_file_filter
full_file_filter cmd = all_functions
[ match_filespecs (opt_match_with cmd) (cmd_filespecs cmd) . fiFilteredName
, opt_file_filter cmd
]
-- |Îòáèðàåò îáðàáàòûâàåìûå àðõèâû è âðåìåííûå ôàéëû, ñîçäàâàåìûå ïðè àðõèâàöèè,
-- à òàêæå ôàéëû, êîòîðûå ìîãóò èõ ïåðåçàïèñàòü ïðè ðàñïàêîâêå
overwrite_f cmd = in_arclist_or_temparc . fiDiskName
where in_arclist_or_temparc filename =
fpFullname filename `elem` cmd_arclist cmd
|| all_functions [(temparc_prefix `isPrefixOf`), (temparc_suffix `isSuffixOf`)]
(fpBasename filename)
-- |Äîáàâèòü â ôèëüòð îòáîðà ôàéëîâ `filter_f` îòáîð êàòàëîãîâ â ñîîòâåòñòâèè ñ îïöèÿìè êîìàíäû `cmd`
test_dirs filter_f cmd fi = if fiIsDir fi
then opt_x_include_dirs cmd
else filter_f cmd fi