lzlib: Add 'make-lzip-input-port/compressed'.

* guix/lzlib.scm (lzwrite!, make-lzip-input-port/compressed): New
procedures.
* tests/lzlib.scm ("make-lzip-input-port/compressed"): New test.
* guix/tests.scm (%seed): Export.
This commit is contained in:
Ludovic Courtès 2019-05-23 21:35:47 +02:00
parent e13354a7ca
commit 2a991f3ae4
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 82 additions and 0 deletions

View file

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Pierre Neidhardt <mail@ambrevar.xyz>
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -23,9 +24,11 @@ (define-module (guix lzlib)
#:use-module (ice-9 match)
#:use-module (system foreign)
#:use-module (guix config)
#:use-module (srfi srfi-11)
#:export (lzlib-available?
make-lzip-input-port
make-lzip-output-port
make-lzip-input-port/compressed
call-with-lzip-input-port
call-with-lzip-output-port
%default-member-length-limit
@ -515,6 +518,24 @@ (define* (lzread! decoder file-port bv
(loop rd)))
read))
(define (lzwrite! encoder source source-offset source-count
target target-offset target-count)
"Write up to SOURCE-COUNT bytes from SOURCE to ENCODER, and read up to
TARGET-COUNT bytes into TARGET at TARGET-OFFSET. Return two values: the
number of bytes read from SOURCE, and the number of bytes written to TARGET,
possibly zero."
(define read
(if (> (lz-compress-write-size encoder) 0)
(match (lz-compress-write encoder source source-offset source-count)
(0 (lz-compress-finish encoder) 0)
(n n))
0))
(define written
(lz-compress-read encoder target target-offset target-count))
(values read written))
(define* (lzwrite encoder bv lz-port
#:optional (start 0) (count (bytevector-length bv)))
"Write up to COUNT bytes from BV at offset START into LZ-PORT. Return
@ -597,6 +618,56 @@ (define (write! bv start count)
(lz-compress-close encoder)
(close-port port))))
(define* (make-lzip-input-port/compressed port
#:key
(level %default-compression-level))
"Return an input port that compresses data read from PORT, with the given LEVEL.
PORT is automatically closed when the resulting port is closed."
(define encoder (apply lz-compress-open
(car (assoc-ref %compression-levels level))))
(define input-buffer (make-bytevector 8192))
(define input-len 0)
(define input-offset 0)
(define input-eof? #f)
(define (read! bv start count)
(cond
(input-eof?
(match (lz-compress-read encoder bv start count)
(0 (if (lz-compress-finished? encoder)
0
(read! bv start count)))
(n n)))
((= input-offset input-len)
(match (get-bytevector-n! port input-buffer 0
(bytevector-length input-buffer))
((? eof-object?)
(set! input-eof? #t)
(lz-compress-finish encoder))
(count
(set! input-offset 0)
(set! input-len count)))
(read! bv start count))
(else
(let-values (((read written)
(lzwrite! encoder
input-buffer input-offset
(- input-len input-offset)
bv start count)))
(set! input-offset (+ input-offset read))
;; Make sure we don't return zero except on EOF.
(if (= 0 written)
(read! bv start count)
written)))))
(make-custom-binary-input-port "lzip-input/compressed"
read! #f #f
(lambda ()
(close-port port))))
(define* (call-with-lzip-input-port port proc)
"Call PROC with a port that wraps PORT and decompresses data read from it.
PORT is closed upon completion."

View file

@ -33,6 +33,7 @@ (define-module (guix tests)
#:use-module (web uri)
#:export (open-connection-for-tests
with-external-store
%seed
random-text
random-bytevector
file=?

View file

@ -108,4 +108,14 @@ (define (compress-and-decompress data)
(test-assert* "Bytevector of size relative to Lzip internal buffers (1MiB+1)"
(compress-and-decompress (random-bytevector (1+ (* 1024 1024)))))
(test-assert "make-lzip-input-port/compressed"
(let* ((len (pk 'len (+ 10 (random 4000 %seed))))
(data (random-bytevector len))
(compressed (make-lzip-input-port/compressed
(open-bytevector-input-port data)))
(result (call-with-lzip-input-port compressed
get-bytevector-all)))
(pk (bytevector-length result) (bytevector-length data))
(bytevector=? result data)))
(test-end)