ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 21:38:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

Move 'with-atomic-file-output' to (guix utils).

Browse source 
* guix/scripts/substitute-binary.scm (with-atomic-file-output): Move to...
* guix/utils.scm (with-atomic-file-output): ... here.
This commit is contained in:
Ludovic Courtès 2013-12-29 15:51:07 +01:00
parent 9501d7745e
commit 04d4c8a439
3 changed files with 17 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
.dir-locals.el
View file

@ -20,6 +20,7 @@
(eval . (put 'substitute-keyword-arguments 'scheme-indent-function 1)) (eval . (put 'substitute-keyword-arguments 'scheme-indent-function 1))
(eval . (put 'with-error-handling 'scheme-indent-function 0)) (eval . (put 'with-error-handling 'scheme-indent-function 0))
(eval . (put 'with-mutex 'scheme-indent-function 1)) (eval . (put 'with-mutex 'scheme-indent-function 1))
(eval . (put 'with-atomic-file-output 'scheme-indent-function 1))
(eval . (put 'syntax-parameterize 'scheme-indent-function 1)) (eval . (put 'syntax-parameterize 'scheme-indent-function 1))
(eval . (put 'with-monad 'scheme-indent-function 1)) (eval . (put 'with-monad 'scheme-indent-function 1))

16
guix/scripts/substitute-binary.scm
View file

@ -72,21 +72,6 @@ (define %narinfo-expired-cache-entry-removal-delay
;; How often we want to remove files corresponding to expired cache entries. ;; How often we want to remove files corresponding to expired cache entries.
(* 7 24 3600)) (* 7 24 3600))
(define (with-atomic-file-output file proc)
"Call PROC with 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)))
(with-throw-handler #t
(lambda ()
(let ((result (proc out)))
(close out)
(rename-file template file)
result))
(lambda (key . args)
(false-if-exception (delete-file template))))))
;; In Guile 2.0.9, `regexp-exec' is thread-unsafe, so work around it. ;; In Guile 2.0.9, `regexp-exec' is thread-unsafe, so work around it.
;; See <http://bugs.gnu.org/14404>. ;; See <http://bugs.gnu.org/14404>.
(set! regexp-exec (set! regexp-exec
@ -594,7 +579,6 @@ (define (guix-substitute-binary . args)
;;; Local Variables: ;;; Local Variables:
;;; eval: (put 'with-atomic-file-output 'scheme-indent-function 1)
;;; eval: (put 'with-timeout 'scheme-indent-function 1) ;;; eval: (put 'with-timeout 'scheme-indent-function 1)
;;; End: ;;; End:

16
guix/utils.scm
View file

@ -67,6 +67,7 @@ (define-module (guix utils)
file-extension file-extension
file-sans-extension file-sans-extension
call-with-temporary-output-file call-with-temporary-output-file
with-atomic-file-output
fold2 fold2
filtered-port)) filtered-port))
@ -426,6 +427,21 @@ (define (call-with-temporary-output-file proc)
(false-if-exception (close out)) (false-if-exception (close out))
(false-if-exception (delete-file template)))))) (false-if-exception (delete-file template))))))
(define (with-atomic-file-output file proc)
"Call PROC with 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)))
(with-throw-handler #t
(lambda ()
(let ((result (proc out)))
(close out)
(rename-file template file)
result))
(lambda (key . args)
(false-if-exception (delete-file template))))))
(define fold2 (define fold2
(case-lambda (case-lambda
((proc seed1 seed2 lst) ((proc seed1 seed2 lst)