init.part2

git-svn-id: https://freearc.svn.sourceforge.net/svnroot/freearc@2 3a4f7f31-9599-433d-91b1-573e8b61252c

Arc.hs

@@ -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
+