utils: Add a `progress' parameter to `dump-port'.

* guix/build/utils.scm (dump-port): Add a `progress' keyword parameter.
  Call it after each transfer.
This commit is contained in:
Ludovic Courtès 2012-12-20 01:34:42 +01:00
parent 0f09955213
commit a18b4d085b
1 changed files with 13 additions and 5 deletions

View File

@ -371,17 +371,25 @@ all subject to the substitutions."
;;; Patching shebangs---e.g., /bin/sh -> /nix/store/xyz...-bash/bin/sh. ;;; Patching shebangs---e.g., /bin/sh -> /nix/store/xyz...-bash/bin/sh.
;;; ;;;
(define* (dump-port in out #:key (buffer-size 16384)) (define* (dump-port in out
#:key (buffer-size 16384)
(progress (lambda (t k) (k))))
"Read as much data as possible from IN and write it to OUT, using "Read as much data as possible from IN and write it to OUT, using
chunks of BUFFER-SIZE bytes." chunks of BUFFER-SIZE bytes. Call PROGRESS after each successful
transfer of BUFFER-SIZE bytes or less, passing it the total number of
bytes transferred and the continuation of the transfer as a thunk."
(define buffer (define buffer
(make-bytevector buffer-size)) (make-bytevector buffer-size))
(let loop ((bytes (get-bytevector-n! in buffer 0 buffer-size))) (let loop ((total 0)
(bytes (get-bytevector-n! in buffer 0 buffer-size)))
(or (eof-object? bytes) (or (eof-object? bytes)
(begin (let ((total (+ total bytes)))
(put-bytevector out buffer 0 bytes) (put-bytevector out buffer 0 bytes)
(loop (get-bytevector-n! in buffer 0 buffer-size)))))) (progress total
(lambda ()
(loop total
(get-bytevector-n! in buffer 0 buffer-size))))))))
(define patch-shebang (define patch-shebang
(let ((shebang-rx (make-regexp "^[[:blank:]]*([[:graph:]]+)(.*)$"))) (let ((shebang-rx (make-regexp "^[[:blank:]]*([[:graph:]]+)(.*)$")))