From a18b4d085bf7d39cb089f9f67d6089516ebb345a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 20 Dec 2012 01:34:42 +0100 Subject: utils: Add a `progress' parameter to `dump-port'. * guix/build/utils.scm (dump-port): Add a `progress' keyword parameter. Call it after each transfer. --- guix/build/utils.scm | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) (limited to 'guix/build/utils.scm') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index 99a43cfebd..0de7392620 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -371,17 +371,25 @@ (define (substitute-one-file file-name) ;;; 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 -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 (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) - (begin + (let ((total (+ total 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 (let ((shebang-rx (make-regexp "^[[:blank:]]*([[:graph:]]+)(.*)$"))) -- cgit v1.2.3