blob: 2fbad39f76431f7f7eb1dd4b6eb0889b4e5f153b (
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
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
(define-module (hnh util io)
:use-module ((hnh util) :select (begin1))
:use-module ((ice-9 rdelim) :select (read-line read-string))
:export (open-input-port
open-output-port
read-lines
with-atomic-output-to-file
call-with-tmpfile
read-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))))
(define* (call-with-tmpfile proc key: (tmpl "/tmp/file-XXXXXXX"))
(let* ((filename (string-copy tmpl))
(port (mkstemp! filename)))
(with-continuation-barrier
(lambda ()
(begin1
(proc port filename)
(close-port port))))))
(define (read-file path)
(call-with-input-file path read-string))
|
