diff --git a/messages/uniworx/categories/print/de-de-formal.msg b/messages/uniworx/categories/print/de-de-formal.msg index 1eb9eb034..32fe30556 100644 --- a/messages/uniworx/categories/print/de-de-formal.msg +++ b/messages/uniworx/categories/print/de-de-formal.msg @@ -4,6 +4,7 @@ PJActAcknowledge: Druck und Versand bestätigen PJActReprint: Erneut drucken über APC +PJActReprintIgnoreReroute: Drucken auch bei aktiver Mail-Umleitung erzwingen PrintJobName: Bezeichnung PrintJobFilename: Dateiname PrintJobId !ident-ok: Id diff --git a/messages/uniworx/categories/print/en-eu.msg b/messages/uniworx/categories/print/en-eu.msg index a1090de43..053fd1a7e 100644 --- a/messages/uniworx/categories/print/en-eu.msg +++ b/messages/uniworx/categories/print/en-eu.msg @@ -4,6 +4,7 @@ PJActAcknowledge: Acknowledge printing and mailing PJActReprint: Print again via APC +PJActReprintIgnoreReroute: Force printing to APC, even if mail-reroute-to option is active PrintJobName: Description PrintJobFilename: Filename PrintJobId: Id diff --git a/src/Handler/PrintCenter.hs b/src/Handler/PrintCenter.hs index 90889c63d..0d2455400 100644 --- a/src/Handler/PrintCenter.hs +++ b/src/Handler/PrintCenter.hs @@ -127,7 +127,7 @@ nullaryPathPiece ''PJTableAction $ camelToPathPiece' 2 embedRenderMessage ''UniWorX ''PJTableAction id -- Not yet needed, since there is no additional data for now: -data PJTableActionData = PJActAcknowledgeData | PJActReprintData +data PJTableActionData = PJActAcknowledgeData | PJActReprintData { ignoreReroute :: Maybe Bool } deriving (Eq, Ord, Read, Show, Generic) type PJTableExpr = ( E.SqlExpr (Entity PrintJob) @@ -192,7 +192,7 @@ mkPJTable = do dbtRowKey = queryPrintJob >>> (E.^. PrintJobId) dbtProj = dbtProjId dbtColonnade = mconcat - [ dbSelectIf (applying _2) id (return . view (resultPrintJob . _entityKey)) (\r -> isNothing $ r ^. resultPrintJob . _entityVal . _printJobAcknowledged) + [ dbSelect (applying _2) id (return . view (resultPrintJob . _entityKey)) -- condition for dbSelectIf: (\r -> isNothing $ r ^. resultPrintJob . _entityVal . _printJobAcknowledged) , sortable (Just "created") (i18nCell MsgPrintJobCreated) $ \( view $ resultPrintJob . _entityVal . _printJobCreated -> t) -> dateTimeCell t , sortable (Just "acknowledged") (i18nCell MsgPrintJobAcknowledged) $ \( view $ resultPrintJob . _entityVal . _printJobAcknowledged -> t) -> maybeDateTimeCell t , sortable (Just "filename") (i18nCell MsgPrintPDF) $ \r -> let k = r ^. resultPrintJob . _entityKey @@ -262,7 +262,8 @@ mkPJTable = do = let acts :: Map PJTableAction (AForm Handler PJTableActionData) acts = mconcat [ singletonMap PJActAcknowledge $ pure PJActAcknowledgeData - , singletonMap PJActReprint $ pure PJActReprintData + , singletonMap PJActReprint $ PJActReprintData + <$> aopt checkBoxField (fslI MsgPJActReprintIgnoreReroute) Nothing ] in renderAForm FormStandard $ (, mempty) . First . Just @@ -292,15 +293,23 @@ postPrintCenterR = do num <- runDB $ updateWhereCount [PrintJobAcknowledged ==. Nothing, PrintJobId <-. pjIds] [PrintJobAcknowledged =. Just now] addMessageI Success $ MsgPrintJobAcknowledge num reloadKeepGetParams PrintCenterR - (PJActReprintData, Set.toList -> pjIds) -> do - let countOk = either (const $ Sum 0) (const $ Sum 1) - oks <- runDB $ forM pjIds $ fmap countOk . reprintPDF + (PJActReprintData{ignoreReroute}, Set.toList -> pjIds) -> do + let countOk = either (const $ Sum 0) (const $ Sum 1) + oks <- runDB $ forM pjIds $ fmap countOk . reprintPDF (fromMaybe False ignoreReroute) let nr_oks = getSum $ mconcat oks nr_tot = length pjIds mstat = bool Warning Success $ nr_oks == nr_tot addMessageI mstat $ MsgPrintJobReprint nr_oks nr_tot reloadKeepGetParams PrintCenterR - + siteConf <- getYesod + let lprConf = siteConf ^. _appLprConf + reroute = siteConf ^. _appMailRerouteTo + lprWgt = [whamlet| + LPR Konfiguration ist #{lprQueue lprConf}@#{lprHost lprConf}:#{lprPort lprConf} +
+ $maybe _ <- reroute + Mail-reroute-to ist gesetzt, somit werden alle lpr Kommandos unterdrückt! + |] siteLayoutMsg MsgMenuApc $ do setTitleI MsgMenuApc $(widgetFile "print-center") -- i18nWidgetFile? Currently no text contained; displays just the table only diff --git a/src/Utils/Print.hs b/src/Utils/Print.hs index 313ffb333..7735f1f09 100644 --- a/src/Utils/Print.hs +++ b/src/Utils/Print.hs @@ -278,12 +278,12 @@ printLetter' pji pdf = do insert_ PrintJob {..} return $ Right (ok, printJobFilename) -reprintPDF :: PrintJobId -> DB (Either Text Text) -reprintPDF pjid = maybeM (return $ Left "Print job id is unknown.") reprint $ get pjid +reprintPDF :: Bool -> PrintJobId -> DB (Either Text Text) +reprintPDF ignoreReroute pjid = maybeM (return $ Left "Print job id is unknown.") reprint $ get pjid where reprint :: PrintJob -> DB (Either Text Text) reprint pj@PrintJob{..} = do - result <- lprPDF printJobFilename $ LBS.fromStrict printJobFile + result <- lprPDF' ignoreReroute printJobFilename $ LBS.fromStrict printJobFile whenIsRight result $ const $ do now <- liftIO getCurrentTime insert_ pj{ printJobAcknowledged = Nothing @@ -460,26 +460,29 @@ encryptPDF pw bs = over _Left (decodeUtf8 . LBS.toStrict) . exit2either <$> read -- | Internal only, use `printLetter` instead lprPDF :: (MonadHandler m, HasAppSettings (HandlerSite m)) => FilePath -> LBS.ByteString -> m (Either Text Text) -lprPDF (sanitizeCmdArg' -> jb) bs = do - mbLprServerArg <- getLprServerArg - case mbLprServerArg of - Nothing -> return $ Right "Print command ignored due to setting 'mail-reroute-to' being set." - Just lprServerArg -> do - let pc = setStdin (byteStringInput bs) $ - proc "lpr" $ - jobname ++ -- -J jobname -- a name for job identification at printing site - [ lprServerArg -- -P queue@hostname:port - , "-" -- read from stdin - ] - jobname | null jb = [] - | otherwise = ["-J " <> jb] - exit2either <$> readProcess' pc - where +lprPDF = lprPDF' False + +lprPDF' :: (MonadHandler m, HasAppSettings (HandlerSite m)) => Bool -> FilePath -> LBS.ByteString -> m (Either Text Text) +lprPDF' ignoreReroute (sanitizeCmdArg' -> jb) bs = maybeM hdlFail hdlLpr getLprServerArg + where + hdlFail = return $ Right "Print command ignored due to setting 'mail-reroute-to' being set." + + hdlLpr lprServerArg = do + let pc = setStdin (byteStringInput bs) $ + proc "lpr" $ + jobname ++ -- -J jobname -- a name for job identification at printing site + [ lprServerArg -- -P queue@hostname:port + , "-" -- read from stdin + ] + jobname | null jb = [] + | otherwise = ["-J " <> jb] + exit2either <$> readProcess' pc + getLprServerArg = do rerouteMail <- getsYesod $ view _appMailRerouteTo - case rerouteMail of - Just _ -> return Nothing - Nothing -> do + case (ignoreReroute, rerouteMail) of + (False, Just _) -> return Nothing + _ -> do LprConf{..} <- getsYesod $ view _appLprConf return . Just $ "-P " <> lprQueue <> "@" <> lprHost <> ":" <> show lprPort diff --git a/templates/print-center.hamlet b/templates/print-center.hamlet index 6f6008a5c..1cac8e15e 100644 --- a/templates/print-center.hamlet +++ b/templates/print-center.hamlet @@ -6,4 +6,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later

- ^{pjTable} \ No newline at end of file + ^{pjTable} + +

+ ^{modal "APC Konfiguration" (Right lprWgt)} \ No newline at end of file