Browse Source

utils: Add `with-atomic-file-replacement'.

* guix/build/utils.scm (with-atomic-file-replacement): New procedure.
  (substitute): Use it.
version-0.8.3
Ludovic Courtès 10 years ago
parent
commit
dcd7290654
  1. 72
      guix/build/utils.scm

72
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:

Loading…
Cancel
Save