[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
07/08: download: Measure and display the throughput.
From: |
Ludovic Courtès |
Subject: |
07/08: download: Measure and display the throughput. |
Date: |
Fri, 27 Feb 2015 14:09:08 +0000 |
civodul pushed a commit to branch core-updates
in repository guix.
commit 9fbe6f1920f0c16be3d1e7a216c164837e31f0fe
Author: Ludovic Courtès <address@hidden>
Date: Fri Feb 27 15:00:38 2015 +0100
download: Measure and display the throughput.
* guix/build/download.scm (duration->seconds, throughput->string): New
procedures.
(progress-proc): Measure and display the throughput.
---
guix/build/download.scm | 68 +++++++++++++++++++++++++++++++++++++---------
1 files changed, 54 insertions(+), 14 deletions(-)
diff --git a/guix/build/download.scm b/guix/build/download.scm
index c439f6b..6c94fa0 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -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
- branch core-updates updated (50915d2 -> c9727aa), Ludovic Courtès, 2015/02/27
- 01/08: gnu: gettext: Set encoding to ISO-8859-1 when modifying files., Ludovic Courtès, 2015/02/27
- 04/08: build-system/gnu: Set $LC_ALL (or similar) to the chosen locale., Ludovic Courtès, 2015/02/27
- 05/08: utils: Call the progress-report proc when 'dump-port' starts., Ludovic Courtès, 2015/02/27
- 02/08: gnu: Remove now unneeded 'unpack' phases for unzip., Ludovic Courtès, 2015/02/27
- 06/08: download: Abstract the receive buffer size., Ludovic Courtès, 2015/02/27
- 08/08: download: Comment on lack of progress report with chunked encoding., Ludovic Courtès, 2015/02/27
- 03/08: gnu: Remove now unneeded 'localedef' invocations., Ludovic Courtès, 2015/02/27
- 07/08: download: Measure and display the throughput.,
Ludovic Courtès <=