diff options
author | Andrew Cady <d@jerkface.net> | 2018-03-15 07:46:38 -0400 |
---|---|---|
committer | Andrew Cady <d@jerkface.net> | 2018-03-15 07:48:26 -0400 |
commit | 511913f92b667e8d7ca2252ec23433bcda6c43ec (patch) | |
tree | 83eab1474ea9262c614b47b3c8fe82d4dcfc391e | |
parent | e4ad9a4b5512ed3a7779ae848f2c95df24ee46b8 (diff) |
Two fixes
1. Avoid a race condition (PDF gets copied before CUPS fully writes it).
2. Work aaround PDFToPrinter.exe limitation (cannot render some text) by
running PDFs through ImageMagick to rasterize them.
-rw-r--r-- | Main.hs | 43 | ||||
-rw-r--r-- | package.yaml | 2 |
2 files changed, 42 insertions, 3 deletions
@@ -1,4 +1,5 @@ | |||
1 | {-# LANGUAGE NoImplicitPrelude #-} | 1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} |
2 | {-# LANGUAGE NoImplicitPrelude #-} | ||
2 | module Main where | 3 | module Main where |
3 | import Rebase.Prelude | 4 | import Rebase.Prelude |
4 | 5 | ||
@@ -7,6 +8,11 @@ import Options.Applicative (execParser, help, helper, info, long, | |||
7 | import System.Directory (createDirectoryIfMissing, renameFile) | 8 | import System.Directory (createDirectoryIfMissing, renameFile) |
8 | import System.FilePath (takeFileName, (</>)) | 9 | import System.FilePath (takeFileName, (</>)) |
9 | import System.FSNotify (Event (..), watchDir, withManager) | 10 | import System.FSNotify (Event (..), watchDir, withManager) |
11 | import System.IO.Temp (withSystemTempDirectory) | ||
12 | import System.Posix.Files (fileMode, getFileStatus, | ||
13 | intersectFileModes, nullFileMode, | ||
14 | otherReadMode) | ||
15 | import System.Posix.Types (FileMode) | ||
10 | import System.Process.Typed (proc, runProcess) | 16 | import System.Process.Typed (proc, runProcess) |
11 | 17 | ||
12 | pdfDirectory, seenDir, pdfPrinterExecutable :: FilePath | 18 | pdfDirectory, seenDir, pdfPrinterExecutable :: FilePath |
@@ -47,9 +53,40 @@ pdfPrinter f = | |||
47 | runProcessVerbose pdfPrinterExecutable [f] >> | 53 | runProcessVerbose pdfPrinterExecutable [f] >> |
48 | moveFileIntoDir f seenDir | 54 | moveFileIntoDir f seenDir |
49 | 55 | ||
56 | hasMode :: FileMode -> FileMode -> Bool | ||
57 | hasMode = ((.).(.)) (/= nullFileMode) intersectFileModes | ||
58 | |||
59 | newtype Milliseconds = Milliseconds Integer deriving (Num, Show, Eq, Ord) | ||
60 | waitUntil :: (IO Bool) -> Milliseconds -> IO () | ||
61 | waitUntil cond maxWait = do | ||
62 | r <- cond | ||
63 | when (maxWait > 0 && not r) $ do | ||
64 | threadDelay $ 100 * 1000 | ||
65 | waitUntil cond (maxWait - 100) | ||
66 | |||
67 | waitUntilReadable :: FilePath -> Milliseconds -> IO () | ||
68 | waitUntilReadable f = waitUntil $ hasMode otherReadMode . fileMode <$> getFileStatus f | ||
69 | |||
50 | pdfSender :: String -> FilePath -> IO () | 70 | pdfSender :: String -> FilePath -> IO () |
51 | pdfSender target f = | 71 | pdfSender target f = do |
52 | runProcessVerbose "rsync" ["--remove-source-files", f, target] >> return () | 72 | withSystemTempDirectory "pdf-autoprint." $ \dir -> do |
73 | -- CUPS creates the file (with its final name) and then appends to it, | ||
74 | -- rather than atomically renaming a fully-written file into place. Luckily | ||
75 | -- we can still detect when the file is fully-written because CUPS will | ||
76 | -- change the permissions from 600 to 644 after it is. Thus we poll until | ||
77 | -- the permissions change. This isn't really the best approach; we could use | ||
78 | -- fs notifications here too. We currently do get a 'Modified' event on the | ||
79 | -- file, with which we do nothing. However, I am not sure that this event is | ||
80 | -- not triggered too early. | ||
81 | waitUntilReadable f (100*1000) | ||
82 | |||
83 | -- `PDFToPrinter.exe` will render text on (at least) the IRS tax forms as | ||
84 | -- horrible pixelated smudgy blobs. This `convert` command will render the | ||
85 | -- text into a rasterized PDF that `PDFToPrinter.exe` can handle well. | ||
86 | let converted = dir </> takeFileName f | ||
87 | void $ runProcessVerbose "convert" ["-density", "300", f, converted] | ||
88 | |||
89 | void $ runProcessVerbose "rsync" ["--remove-source-files", converted, target] | ||
53 | 90 | ||
54 | handlePdfsForever :: FilePath -> (FilePath -> IO ()) -> IO () | 91 | handlePdfsForever :: FilePath -> (FilePath -> IO ()) -> IO () |
55 | handlePdfsForever dir h = handleEventsForever dir (handleAdds (".pdf" `isSuffixOf`) h) | 92 | handlePdfsForever dir h = handleEventsForever dir (handleAdds (".pdf" `isSuffixOf`) h) |
diff --git a/package.yaml b/package.yaml index 3dfc2f3..1af60b7 100644 --- a/package.yaml +++ b/package.yaml | |||
@@ -13,6 +13,8 @@ dependencies: | |||
13 | - typed-process | 13 | - typed-process |
14 | - filepath | 14 | - filepath |
15 | - optparse-applicative | 15 | - optparse-applicative |
16 | - temporary | ||
17 | - unix | ||
16 | 18 | ||
17 | executables: | 19 | executables: |
18 | pdf-autoprint: | 20 | pdf-autoprint: |