diff options
| -rw-r--r-- | guix/records.scm | 25 | ||||
| -rwxr-xr-x | guix/scripts/substitute-binary.scm | 19 | ||||
| -rw-r--r-- | tests/records.scm | 17 |
3 files changed, 43 insertions, 18 deletions
diff --git a/guix/records.scm b/guix/records.scm index 54e1c17752..64581f1be2 100644 --- a/guix/records.scm +++ b/guix/records.scm @@ -21,9 +21,12 @@ #:use-module (srfi srfi-9) #:use-module (srfi srfi-26) #:use-module (ice-9 match) + #:use-module (ice-9 regex) + #:use-module (ice-9 rdelim) #:export (define-record-type* alist->record - object->fields)) + object->fields + recutils->alist)) ;;; Commentary: ;;; @@ -211,4 +214,24 @@ PORT, according to FIELDS. FIELDS must be a list of field name/getter pairs." (format port "~a: ~a~%" field (get object)) (loop rest))))) +(define %recutils-field-rx + (make-regexp "^([[:graph:]]+): (.*)$")) + +(define (recutils->alist port) + "Read a recutils-style record from PORT and return it as a list of key/value +pairs. Stop upon an empty line (after consuming it) or EOF." + (let loop ((line (read-line port)) + (result '())) + (cond ((or (eof-object? line) (string-null? line)) + (reverse result)) + ((regexp-exec %recutils-field-rx line) + => + (lambda (match) + (loop (read-line port) + (alist-cons (match:substring match 1) + (match:substring match 2) + result)))) + (else + (error "unmatched line" line))))) + ;;; records.scm ends here diff --git a/guix/scripts/substitute-binary.scm b/guix/scripts/substitute-binary.scm index 24e5d68c4f..fb2eb4dbe8 100755 --- a/guix/scripts/substitute-binary.scm +++ b/guix/scripts/substitute-binary.scm @@ -102,23 +102,8 @@ output port, and PROC's result is returned." (define (fields->alist port) "Read recutils-style record from PORT and return them as a list of key/value pairs." - (define field-rx - (make-regexp "^([[:graph:]]+): (.*)$")) - - (let loop ((line (read-line port)) - (result '())) - (cond ((eof-object? line) - (reverse result)) - ((with-mutex %regexp-exec-mutex - (regexp-exec field-rx line)) - => - (lambda (match) - (loop (read-line port) - (alist-cons (match:substring match 1) - (match:substring match 2) - result)))) - (else - (error "unmatched line" line))))) + (with-mutex %regexp-exec-mutex + (recutils->alist port))) (define %fetch-timeout ;; Number of seconds after which networking is considered "slow". diff --git a/tests/records.scm b/tests/records.scm index 9e524b670c..470644451c 100644 --- a/tests/records.scm +++ b/tests/records.scm @@ -131,6 +131,23 @@ (parameterize ((mark (cons 'a 'b))) (eq? (foo-baz y) (mark)))))))) +(test-equal "recutils->alist" + '((("Name" . "foo") + ("Version" . "0.1") + ("Synopsis" . "foo bar") + ("Something_else" . "chbouib")) + (("Name" . "bar") + ("Version" . "1.5"))) + (let ((p (open-input-string "Name: foo +Version: 0.1 +Synopsis: foo bar +Something_else: chbouib + +Name: bar +Version: 1.5"))) + (list (recutils->alist p) + (recutils->alist p)))) + (test-end) |