forked from svn2github/freearc
-
Notifications
You must be signed in to change notification settings - Fork 1
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
git-svn-id: https://freearc.svn.sourceforge.net/svnroot/freearc@2 3a4f7f31-9599-433d-91b1-573e8b61252c
- Loading branch information
bulatz
committed
Jan 26, 2009
1 parent
418a7eb
commit 25163b9
Showing
193 changed files
with
37,378 additions
and
0 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,235 @@ | ||
{-# 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 | ||
setUncaughtExceptionHandler handler | ||
setCtrlBreakHandler $ do -- Îðãàíèçóåì îáðàáîòêó ^Break | ||
ensureCtrlBreak (resetConsoleTitle) $ do | ||
luaLevel "Program" [("command", args)] $ do | ||
#ifdef FREEARC_GUI | ||
if length args < 2 -- Ïðè âûçîâå ïðîãðàììû áåç àðãóìåíòîâ èëè ñ îäíèì àðãóìåíòîì (èìåíåì êàòàëîãà/àðõèâà) | ||
then myGUI run args -- çàïóñêàåì ïîëíîöåííûé Archive Manager | ||
else do -- à èíà÷å - ïðîñòî îòðàáàòûâàåì êîìàíäû (äå)àðõèâàöèè | ||
#endif | ||
uiStartProgram -- Îòêðûòü UI | ||
commands <- parseCmdline args -- Ïðåâðàòèòü êîìàíäíóþ ñòðîêó â ñïèñîê êîìàíä íà âûïîëíåíèå | ||
mapM_ run commands -- Âûïîëíèòü êàæäóþ ïîëó÷åííóþ êîìàíäó | ||
uiDoneProgram -- Çàêðûòü UI | ||
where | ||
handler ex = registerError$ GENERAL_ERROR$ | ||
case ex of | ||
Deadlock -> "no threads to run: infinite loop or deadlock?" | ||
ErrorCall s -> s | ||
other -> show ex | ||
|
||
|
||
-- |Äèñïåò÷åðèçóåò êîìàíäó è îðãàíèçóåò å¸ ïîâòîðåíèå äëÿ êàæäîãî ïîäõîäÿùåãî àðõèâà | ||
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 | ||
"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 | ||
|
Oops, something went wrong.