aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-07-10 16:54:17 +0200
committerLudovic Courtès <ludo@gnu.org>2013-07-10 17:01:08 +0200
commitfdc1bf659d9834fce6c78d31680b580eab3f4235 (patch)
tree647c4dc2bee902cffd64099db95b3fb57fe2986d
parentc0edcc3c1926497919e6eefed32dbe5fdc55d045 (diff)
downloadguix-fdc1bf659d9834fce6c78d31680b580eab3f4235.tar
guix-fdc1bf659d9834fce6c78d31680b580eab3f4235.tar.gz
records: Add `recutils->alist' for public consumption.
* guix/records.scm (%recutils-field-rx): New variable. (recutils->alist): New procedure, formerly known as `fields->alist'. * guix/scripts/substitute-binary.scm (fields->alist): Use it. * tests/records.scm ("recutils->alist"): New test.
-rw-r--r--guix/records.scm25
-rwxr-xr-xguix/scripts/substitute-binary.scm19
-rw-r--r--tests/records.scm17
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)