blob: d638ebb403ca11876b0b562fb8e6879d84bfae59 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
|
(define-module (hnh util io)
:use-module ((hnh util) :select (begin1))
:use-module ((ice-9 rdelim) :select (read-line))
:export (open-input-port
open-output-port
read-lines
with-atomic-output-to-file))
(define (open-input-port str)
(if (string=? "-" str)
(current-input-port)
(open-input-file str)))
(define (open-output-port str)
(if (string=? "-" str)
(current-output-port)
(open-output-file str)))
(define (read-lines port)
(let ((line (read-line port)))
(if (eof-object? line)
'() (cons line (read-lines port)))))
;; Same functionality as the regular @var{with-output-to-file}, but
;; with the difference that either everything is written, or nothing
;; is written, and if anything is written it's all written atomicaly at
;; once (the original file will never contain an intermidiate state).
;; Does NOT handle race conditions between threads.
;;
;; propagates the return value of @var{thunk} upon successfully writing
;; the file, and @code{#f} otherwise.
(define (with-atomic-output-to-file filename thunk)
;; copy to enusre writable string
(define tmpfile (string-copy (string-append
(dirname filename)
file-name-separator-string
"." (basename filename)
"XXXXXX")))
(define port #f)
(dynamic-wind
(lambda () (set! port (mkstemp! tmpfile)))
(lambda ()
(begin1
(with-output-to-port port thunk)
;; Closing a port forces a write, due to buffering
;; some of the errors that logically would come
;; from write calls are first raised here. But since
;; crashing is acceptable here, that's fine.
(close-port port)
(rename-file tmpfile filename)))
(lambda ()
(when (access? tmpfile F_OK)
;; I'm a bit unclear on how to trash our write buffer.
;; hopefully first removing the file, followed by closing
;; the port is enough for the kernel to do the sensible
;; thing.
(delete-file tmpfile)
(close-port port)
;; `when' defaults to the truthy `()', see (calp util)
;; (note that #<unspecified> is thruthy, but shouldn't be
;; counted on, since anything with an unspecified return
;; value might as well return #f)
#f))))
|