download: Measure and display the throughput.

* guix/build/download.scm (duration->seconds, throughput->string): New
  procedures.
  (progress-proc): Measure and display the throughput.
master
Ludovic Courtès 2015-02-27 15:00:38 +01:00
parent e7620dc995
commit 9fbe6f1920
1 changed files with 54 additions and 14 deletions

View File

@ -26,6 +26,7 @@
#:use-module (rnrs io ports)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
@ -46,24 +47,59 @@
;; Size of the HTTP receive buffer.
65536)
(define (duration->seconds duration)
"Return the number of seconds represented by DURATION, a 'time-duration'
object, as an inexact number."
(+ (time-second duration)
(/ (time-nanosecond duration) 1e9)))
(define (throughput->string throughput)
"Given THROUGHPUT, measured in bytes per second, return a string
representing it in a human-readable way."
(if (> throughput 3e6)
(format #f "~,2f MiB/s" (/ throughput (expt 2. 20)))
(format #f "~,0f KiB/s" (/ throughput 1024.0))))
(define* (progress-proc file size #:optional (log-port (current-output-port)))
"Return a procedure to show the progress of FILE's download, which is
SIZE byte long. The returned procedure is suitable for use as an
argument to `dump-port'. The progress report is written to LOG-PORT."
(if (number? size)
(lambda (transferred cont)
(let ((% (* 100.0 (/ transferred size))))
(display #\cr log-port)
(format log-port "~a\t~5,1f% of ~,1f KiB"
file % (/ size 1024.0))
(flush-output-port log-port)
(cont)))
(lambda (transferred cont)
(display #\cr log-port)
(format log-port "~a\t~6,1f KiB transferred"
file (/ transferred 1024.0))
(flush-output-port log-port)
(cont))))
(let ((start-time #f))
(let-syntax ((with-elapsed-time
(syntax-rules ()
((_ elapsed body ...)
(let* ((now (current-time time-monotonic))
(elapsed (and start-time
(duration->seconds
(time-difference now
start-time)))))
(unless start-time
(set! start-time now))
body ...)))))
(if (number? size)
(lambda (transferred cont)
(with-elapsed-time elapsed
(let ((% (* 100.0 (/ transferred size)))
(throughput (if elapsed
(/ transferred elapsed)
0)))
(display #\cr log-port)
(format log-port "~a\t~5,1f% of ~,1f KiB (~a)"
file % (/ size 1024.0)
(throughput->string throughput))
(flush-output-port log-port)
(cont))))
(lambda (transferred cont)
(with-elapsed-time elapsed
(let ((throughput (if elapsed
(/ transferred elapsed)
0)))
(display #\cr log-port)
(format log-port "~a\t~6,1f KiB transferred (~a)"
file (/ transferred 1024.0)
(throughput->string throughput))
(flush-output-port log-port)
(cont))))))))
(define* (uri-abbreviation uri #:optional (max-length 42))
"If URI's string representation is larger than MAX-LENGTH, return an
@ -427,4 +463,8 @@ on success."
file url)
#f))))
;;; Local Variables:
;;; eval: (put 'with-elapsed-time 'scheme-indent-function 1)
;;; End:
;;; download.scm ends here