ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 23:46:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

utils: Call the progress-report proc when 'dump-port' starts.

Browse source 
* guix/build/utils.scm (dump-port): Add call to PROGRESS at the
  beginning.
This commit is contained in:
Ludovic Courtès 2015-02-27 14:56:01 +01:00
parent 251e8b2ee8
commit 2c1fb35377
1 changed files with 12 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
guix/build/utils.scm
View file

@ -588,22 +588,27 @@ (define (substitute-one-file file-name)
(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. 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."
"Read as much data as possible from IN and write it to OUT, using chunks of
BUFFER-SIZE bytes. Call PROGRESS at the beginning and 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 ((total 0)
(bytes (get-bytevector-n! in buffer 0 buffer-size)))
(define (loop total bytes)
(or (eof-object? bytes)
(let ((total (+ total bytes)))
(put-bytevector out buffer 0 bytes)
(progress total
(lambda ()
(loop total
(get-bytevector-n! in buffer 0 buffer-size))))))))
(get-bytevector-n! in buffer 0 buffer-size)))))))
;; Make sure PROGRESS is called when we start so that it can measure
;; throughput.
(progress 0
(lambda ()
(loop 0 (get-bytevector-n! in buffer 0 buffer-size)))))
(define (set-file-time file stat)
"Set the atime/mtime of FILE to that specified by STAT."