fix(lpr): fix #96 by various minor improvements to PrintCenter
This commit is contained in:
parent
57842a53e7
commit
80c632df1c
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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}
|
||||
<div>
|
||||
$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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -6,4 +6,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
<section>
|
||||
<p>
|
||||
^{pjTable}
|
||||
^{pjTable}
|
||||
|
||||
<section>
|
||||
^{modal "APC Konfiguration" (Right lprWgt)}
|
||||
Reference in New Issue
Block a user