From f238017f51e040bd547132a1813ea6358380efc0 Mon Sep 17 00:00:00 2001 From: bulatz Date: Sun, 1 Mar 2009 00:37:57 +0000 Subject: [PATCH] Errors.hs: finished fixing error handling (at least now it can cancel GUI operations w/o destroying whole program :) git-svn-id: https://freearc.svn.sourceforge.net/svnroot/freearc@117 3a4f7f31-9599-433d-91b1-573e8b61252c --- ArcvProcessExtract.hs | 8 ++++---- ArcvProcessRead.hs | 2 +- Compression.hs | 4 ++-- Errors.hs | 25 +++++++++++-------------- FileManager.hs | 14 +++++++------- UIBase.hs | 4 ++-- 6 files changed, 27 insertions(+), 30 deletions(-) diff --git a/ArcvProcessExtract.hs b/ArcvProcessExtract.hs index 519e824..2931434 100644 --- a/ArcvProcessExtract.hs +++ b/ArcvProcessExtract.hs @@ -48,11 +48,11 @@ decompress_PROCESS command count_cbytes pipe = do state <- ref (error "Decompression state is not initialized!") repeat_until $ do decompress_block command cfile state count_cbytes pipe - programTerminated' <- val programTerminated - when programTerminated' $ do - sendP pipe (error "Operation terminated by user", aFREEARC_ERRCODE_OPERATION_TERMINATED) + operationTerminated' <- val operationTerminated + when operationTerminated' $ do + sendP pipe (error "Decompression terminated", aFREEARC_ERRCODE_OPERATION_TERMINATED) (x,_,_) <- val state - return (x == aSTOP_DECOMPRESS_THREAD || programTerminated') + return (x == aSTOP_DECOMPRESS_THREAD || operationTerminated') {-# NOINLINE decompress_block #-} diff --git a/ArcvProcessRead.hs b/ArcvProcessRead.hs index 29bf65c..7615c8e 100644 --- a/ArcvProcessRead.hs +++ b/ArcvProcessRead.hs @@ -56,7 +56,7 @@ notTheEnd _ = True create_archive_structure_AND_read_files_PROCESS command archive oldarc files processDir arcComment writeRecoveryBlocks results backdoor pipe = do initPos <- archiveGetPos archive -- При возникновении ошибки установим флаг для прерывания работы c_compress() - handleCtrlBreak (programTerminated =: True) $ do + handleCtrlBreak (operationTerminated =: True) $ do -- Создадим процесс для распаковки файлов из входных архивов и гарантируем его корректное завершение bracketCtrlBreak (runAsyncP$ decompress_PROCESS command doNothing) ( \decompress_pipe -> do sendP decompress_pipe Nothing; joinP decompress_pipe) diff --git a/Compression.hs b/Compression.hs index 3251ca6..4faa1c2 100644 --- a/Compression.hs +++ b/Compression.hs @@ -268,8 +268,8 @@ freearcDecompress num method = checkingCtrlBreak num (Com -- исключений, добавим к процедурам чтения/записи явные проверки checkingCtrlBreak num action callback = do let checked_callback what buf size auxdata = do - programTerminated' <- val programTerminated - if programTerminated' + operationTerminated' <- val operationTerminated + if operationTerminated' then return CompressionLib.aFREEARC_ERRCODE_OPERATION_TERMINATED -- foreverM doNothing0 else callback what buf size -- diff --git a/Errors.hs b/Errors.hs index 74c3809..2d129fb 100644 --- a/Errors.hs +++ b/Errors.hs @@ -87,21 +87,18 @@ setCtrlBreakHandler action = do -- |Вызвать fail, если установлен флаг аварийного завершения программы failOnTerminated = do - whenM (val programTerminated) $ do - -- unlessM (val fileManagerMode) $ do - fail$ errormsg TERMINATED + whenM (val operationTerminated) $ do + fail "" --- |Обработка Ctrl-Break сводится к выполнению финализаторов и +-- |Обработка Ctrl-Break и нажатия на Cancel сводится к выполнению финализаторов и -- установке спец. флага, который проверяется коллбэками, вызываемыми из Си onBreak event = terminateOperation terminateOperation = do isFM <- val fileManagerMode registerError$ iif isFM OP_TERMINATED TERMINATED -shutdown msg_ exitCode_ = do - programTerminated' <- val programTerminated - let (msg, exitCode) | programTerminated' = (errormsg TERMINATED, aEXIT_CODE_USER_BREAK) - | otherwise = (msg_, exitCode_) +-- |Принудительно завершает выполнение программы с заданным exitCode и печатью сообщения msg +shutdown msg exitCode = do separator' =: ("","\n") log_separator' =: "\n" fin <- val finalizers @@ -110,7 +107,7 @@ shutdown msg_ exitCode_ = do w <- val warnings case w of - 0 -> when (exitCode==aEXIT_CODE_SUCCESS) $ condPrintLineLn "k"$ "All OK" + 0 -> when (exitCode==aEXIT_CODE_SUCCESS) $ condPrintLineLn "k" "All OK" _ -> condPrintLineLn "n"$ "There were "++show w++" warning(s)" ignoreErrors (msg &&& condPrintLineLn "n" msg) condPrintLineLn "e" "" @@ -165,14 +162,14 @@ curId :: IORef Int curId = unsafePerformIO (ref 0) {-# NOINLINE curId #-} --- |Список действий, которые надо выполнить перед выходом по ^Break +-- |Список действий, которые надо выполнить перед аварийным завершением программы finalizers :: IORef [(Int, IO ())] finalizers = unsafePerformIO (ref []) {-# NOINLINE finalizers #-} --- |Этот флаг устанавливается после того, как пользователь нажал Ctrl-Break -programTerminated = unsafePerformIO (ref False) -{-# NOINLINE programTerminated #-} +-- |Флаг, показывающий что мы находимся в режиме прерывания текущей операции +operationTerminated = unsafePerformIO (ref False) +{-# NOINLINE operationTerminated #-} -- |Режим работы файл-менеджера: при этом terminateOperation обрабатывается по-другому - мы дожидаемся завершения всех тредов упаковки и распаковки fileManagerMode = unsafePerformIO (ref False) @@ -383,7 +380,7 @@ registerError err = do -- иначе - просто совершаем аварийный выход из программы unlessM (val fileManagerMode) $ do shutdown ("ERROR: "++msg) (errcode err) - programTerminated =: True + operationTerminated =: True fail "" -- |Запись предупреждения в логфайл и вывод его на экран diff --git a/FileManager.hs b/FileManager.hs index 33a3132..d2ec61d 100644 --- a/FileManager.hs +++ b/FileManager.hs @@ -490,15 +490,15 @@ myGUI run args = do ---------------------------------------------------------------------------------------------------- -- При выполнении операций не выходим по исключениям, а печатаем сообщения о них в логфайл - let handleErrors action x = do programTerminated =: False - (action x `catch` handler) `finally` (programTerminated =: False) + let handleErrors action x = do operationTerminated =: False + (action x `catch` handler) `finally` (operationTerminated =: False) where handler ex = do - programTerminated' <- val programTerminated + operationTerminated' <- val operationTerminated errmsg <- case ex of - _ | programTerminated' -> i18n"0010 Operation interrupted!" - Deadlock -> i18n"0011 No threads to run: infinite loop or deadlock?" - ErrorCall s -> return s - other -> return$ showsPrec 0 other "" + _ | operationTerminated' -> i18n"0010 Operation interrupted!" + Deadlock -> i18n"0011 No threads to run: infinite loop or deadlock?" + ErrorCall s -> return s + other -> return$ showsPrec 0 other "" with' (val log_separator') (log_separator'=:) $ \_ -> do log_separator' =: "" io$ condPrintLineLn "w" errmsg diff --git a/UIBase.hs b/UIBase.hs index 488208a..5944e45 100644 --- a/UIBase.hs +++ b/UIBase.hs @@ -87,9 +87,9 @@ syncUI = withMVar mvarSyncUI . const; mvarSyncUI = unsafePerformIO$ newMVar "mv indicatorThread secs output = backgroundThread secs $ do whenM (val aProgressIndicatorEnabled) $ do - aProgramTerminated <- val programTerminated + operationTerminated' <- val operationTerminated (indicator, arcname, direction, b, bytes', total') <- val aProgressIndicatorState - when (indicator /= NoIndicator && not aProgramTerminated) $ do + when (indicator /= NoIndicator && not operationTerminated') $ do bytes <- bytes' b; total <- total' -- Отношение объёма обработанных данных к общему объёму let processed = total>0 &&& (fromIntegral bytes / fromIntegral total :: Double)