chore(apc): fix acknowledging mechanism after tests

This commit is contained in:
Steffen Jost 2023-03-22 15:01:33 +00:00
parent 81a30fadc4
commit 326ca71875

View File

@ -30,8 +30,8 @@ import Utils.Print
-- import qualified Data.Set as Set
import Handler.Utils
import Handler.Utils.Csv
import qualified Data.Csv as Csv
-- import Handler.Utils.Csv
-- import qualified Data.Csv as Csv
-- avoids repetition of local definitions
single :: (k,a) -> Map k a
@ -374,10 +374,10 @@ postPrintAckR ackDay numAck chksm = do
-- no header csv, containing a single column of lms identifiers (logins)
-- instance Csv.FromRecord LmsIdent -- default suffices
instance Csv.FromRecord Text where
parseRecord v
| length v == 1 = v Csv..! 1
| otherwise = mzero
-- instance Csv.FromRecord Text where
-- parseRecord v
-- | length v >= 1 = v Csv..! 0
-- | otherwise = pure "ERROR"
postPrintAckDirectR :: Handler Html
postPrintAckDirectR = do
@ -386,7 +386,9 @@ postPrintAckDirectR = do
[(fhead,file)] -> do
runDB $ do
enr <- try $ runConduit $ fileSource file
.| decodeCsvPositional Csv.NoHeader
-- .| decodeCsvPositional Csv.NoHeader -- decode by separator position
.| decodeUtf8C -- no CSV, just convert each line to a single text
.| linesUnboundedC
.| sinkList
case enr of
Left (e :: SomeException) -> do -- catch all to avoid ok220 in case of any error
@ -398,7 +400,7 @@ postPrintAckDirectR = do
nrApcIds <- updateWhereCount
[PrintJobAcknowledged ==. Nothing, PrintJobApcIdent <-. reqIds]
[PrintJobAcknowledged =. Just now]
nrOk <- if nrApcIds > 0 && nrReq > 0
nrOk <- if nrApcIds <= 0 && nrReq > 0
then updateWhereCount -- for downwards compatibility only
[PrintJobAcknowledged ==. Nothing, PrintJobLmsUser <-. (Just . LmsIdent . dropPrefixText "lms-" <$> reqIds)]
[PrintJobAcknowledged =. Just now]
@ -412,8 +414,9 @@ postPrintAckDirectR = do
$logInfoS "APC" msg
return (ok200, msg)
| otherwise -> do
forM_ reqIds $ \t -> $logInfoS "APC" $ "Received APC Identifier: \"" <> t <> "\""
let msg = "Warning: Only " <> tshow nrOk <> " print jobs out of " <> tshow nrReq <> " were acknowledged as printed, for file " <> fhead
$logWarnS "APC" msg
$logWarnS "APC" msg
return (ok200, msg)
[] -> do
let msg = "Error: No file received. A file of lms identifiers must be supplied for print job acknowledging."