diff --git a/member-file.scm b/member-file.scm index 24560cf..78f8f0e 100644 --- a/member-file.scm +++ b/member-file.scm @@ -49,7 +49,8 @@ ;; Specification of known keys for various types of parsing (define known-keys '(nick mail phone name born joined destroyed - mail2 ID email suspended tel)) ;; Unknown keys + ;; mail2 ID email suspended tel ;; Unknown keys + )) (define start/stop-keys '(student suspend)) (define multi-keys '(card desfire credit)) diff --git a/members-base.scm b/members-base.scm index 2577e0a..981ae2a 100644 --- a/members-base.scm +++ b/members-base.scm @@ -120,37 +120,34 @@ ;; Returns dictionary containing only records with either 4-digit ;; name or one of its aliases being 4-digit. (define (files-dictionary-filter-4digit-symbols d) - (let loop ((keys (dict-keys d)) - (res (make-dict))) - (if (null? keys) - res - (let* ((key (car keys)) - (val (dict-ref d key))) - (loop (cdr keys) - (if (list-contains-4digit-symbol? (cons key val)) - (dict-set res key val) - res)))))) + (dict-filter + (lambda (k v) + (list-contains-4digit-symbol? (cons k v))) + d)) ;; Returns a dictionary containing file-name, symlinks, id and info ;; keys. The info key contains whatever load-member-file from the ;; member-file module returns. The id key contains whatever is the ;; first 4-digit symbol in (cons fname aliases) list. - (define (members-base-load-member mdir fname aliases) + (define (members-base-load-member mdir fname symlinks) (let* ((mr0 (make-dict)) (mr-fn (dict-set mr0 'file-name fname)) - (mr-sl (dict-set mr-fn 'symlinks aliases))) + (mr-sl (dict-set mr-fn 'symlinks symlinks))) (dict-set mr-sl 'info (load-member-file (make-pathname mdir fname))))) + ;; Loads members database (define (load-members dn) - ;; get the directory contents (let ((fss (files-dictionary-filter-4digit-symbols (files+symlinks->files-dictionary (get-files+symlinks dn))))) - (void)) - ;; load member files - 1) + (dict-map + (lambda (symfn symlinks) + (members-base-load-member dn + (symbol->string symfn) + symlinks)) + fss))) (define (members-base-tests!) (run-tests