summaryrefslogtreecommitdiff
path: root/guix/build/utils.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2012-10-16 17:28:11 +0200
committerLudovic Courtès <ludo@gnu.org>2012-10-16 17:31:16 +0200
commitdcd72906545816938d16af3afca0ffa9e4ce3dcf (patch)
tree36d287f207f20a7ac122ed7010728a9612162038 /guix/build/utils.scm
parentdf1fab5837ccecb952faf2bacf67b2d9c737af42 (diff)
utils: Add `with-atomic-file-replacement'.
* guix/build/utils.scm (with-atomic-file-replacement): New procedure. (substitute): Use it.
Diffstat (limited to 'guix/build/utils.scm')
-rw-r--r--guix/build/utils.scm72
1 files changed, 42 insertions, 30 deletions
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 148f62ec51..20e8cdf3e8 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -32,6 +32,7 @@
alist-cons-before
alist-cons-after
alist-replace
+ with-atomic-file-replacement
substitute
substitute*
dump-port
@@ -157,45 +158,55 @@ An error is raised when no such pair exists."
;;; Text substitution (aka. sed).
;;;
-(define (substitute file pattern+procs)
- "PATTERN+PROCS is a list of regexp/two-argument procedure. For each line
-of FILE, and for each PATTERN that it matches, call the corresponding PROC
-as (PROC LINE MATCHES); PROC must return the line that will be written as a
-substitution of the original line."
- (let* ((rx+proc (map (match-lambda
- (((? regexp? pattern) . proc)
- (cons pattern proc))
- ((pattern . proc)
- (cons (make-regexp pattern regexp/extended)
- proc)))
- pattern+procs))
- (template (string-append file ".XXXXXX"))
+(define (with-atomic-file-replacement file proc)
+ "Call PROC with two arguments: an input port for FILE, and an output
+port for the file that is going to replace FILE. Upon success, FILE is
+atomically replaced by what has been written to the output port, and
+PROC's result is returned."
+ (let* ((template (string-append file ".XXXXXX"))
(out (mkstemp! template))
(mode (stat:mode (stat file))))
(with-throw-handler #t
(lambda ()
(call-with-input-file file
(lambda (in)
- (let loop ((line (read-line in 'concat)))
- (if (eof-object? line)
- #t
- (let ((line (fold (lambda (r+p line)
- (match r+p
- ((regexp . proc)
- (match (list-matches regexp line)
- ((and m+ (_ _ ...))
- (proc line m+))
- (_ line)))))
- line
- rx+proc)))
- (display line out)
- (loop (read-line in 'concat)))))))
- (close out)
- (chmod template mode)
- (rename-file template file))
+ (let ((result (proc in out)))
+ (close out)
+ (chmod template mode)
+ (rename-file template file)
+ result))))
(lambda (key . args)
(false-if-exception (delete-file template))))))
+(define (substitute file pattern+procs)
+ "PATTERN+PROCS is a list of regexp/two-argument procedure. For each line
+of FILE, and for each PATTERN that it matches, call the corresponding PROC
+as (PROC LINE MATCHES); PROC must return the line that will be written as a
+substitution of the original line."
+ (let ((rx+proc (map (match-lambda
+ (((? regexp? pattern) . proc)
+ (cons pattern proc))
+ ((pattern . proc)
+ (cons (make-regexp pattern regexp/extended)
+ proc)))
+ pattern+procs)))
+ (with-atomic-file-replacement file
+ (lambda (in out)
+ (let loop ((line (read-line in 'concat)))
+ (if (eof-object? line)
+ #t
+ (let ((line (fold (lambda (r+p line)
+ (match r+p
+ ((regexp . proc)
+ (match (list-matches regexp line)
+ ((and m+ (_ _ ...))
+ (proc line m+))
+ (_ line)))))
+ line
+ rx+proc)))
+ (display line out)
+ (loop (read-line in 'concat)))))))))
+
(define-syntax let-matches
;; Helper macro for `substitute*'.
@@ -329,4 +340,5 @@ patched, #f otherwise."
;;; eval: (put 'call-with-output-file/atomic 'scheme-indent-function 1)
;;; eval: (put 'with-throw-handler 'scheme-indent-function 1)
;;; eval: (put 'let-matches 'scheme-indent-function 3)
+;;; eval: (put 'with-atomic-file-replacement 'scheme-indent-function 1)
;;; End: