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:
		
							parent
							
								
									0f09955213
								
							
						
					
					
						commit
						a18b4d085b
					
				
					 1 changed files with 13 additions and 5 deletions
				
			
		| 
						 | 
					@ -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:]]+)(.*)$")))
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Reference in a new issue